root/main/trunk/greenstone2/perllib/cgiactions/buildaction.pm @ 24192

Revision 24192, 11.4 KB (checked in by ak19, 8 years ago)

Sam discovered that using dollar-Config{perlpath} in place of dollar-hat-X is the better way to obtain the path to the perl that is being used. We hope this will not be a relative path on the Mac as dollar-hat-x was on Professor Witten's Mac when we tried it there today.

  • Property svn:executable set to *
Line 
1###########################################################################
2#
3# buildaction.pm --
4# A component of the Greenstone digital library software
5# from the New Zealand Digital Library Project at the
6# University of Waikato, New Zealand.
7#
8# Copyright (C) 2009 New Zealand Digital Library Project
9#
10# This program is free software; you can redistr   te it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either version 2 of the License, or
13# (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23#
24###########################################################################
25
26package buildaction;
27
28use strict;
29
30use JSON;
31
32use cgiactions::baseaction;
33
34use dbutil;
35use ghtml;
36
37use util;
38use Config; # for getting the perlpath in the recommended way
39
40BEGIN {
41#    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan/perl-5.8");
42    require XML::Rules;
43}
44
45
46@buildaction::ISA = ('baseaction');
47
48
49# 'a' for action, and 'c' for collection are also compulsorary, and
50# added in automatically by baseaction
51
52my $action_table =
53{
54    "full-import"          => { 'compulsory-args' => [],
55                'optional-args'   => [] },
56   
57    "full-buildcol"        => { 'compulsory-args' => [],
58                'optional-args'   => [] },
59   
60    "full-rebuild"         => { 'compulsory-args' => [],
61                'optional-args'   => [] },
62   
63   
64    "incremental-import"   => { 'compulsory-args' => [],
65                'optional-args'   => [] },
66
67    "incremental-buildcol" => { 'compulsory-args' => [],
68                'optional-args'   => [] },
69   
70    "incremental-rebuild" => { 'compulsory-args' => [],
71                   'optional-args'   => [] },
72                   
73    "build-by-manifest" => { 'compulsory-args' => [],
74                   'optional-args'   => ["index-files", "reindex-files", "delete-OIDs"] }
75                   
76};
77
78
79sub new
80{
81    my $class = shift (@_);
82    my ($gsdl_cgi,$iis6_mode) = @_;
83
84    my $self = new baseaction($action_table,$gsdl_cgi,$iis6_mode);
85
86    return bless $self, $class;
87}
88
89
90sub run_build_cmd
91{
92    my $self = shift @_;
93    my ($cmd) = @_;
94
95    my $collect   = $self->{'collect'};
96    my $gsdl_cgi  = $self->{'gsdl_cgi'};
97    my $gsdl_home  = $self->{'gsdlhome'};
98
99    my $output = `$cmd 2>&1`;
100    my $status = $?;
101    my $report = undef;
102
103    if ($status == 0) {
104    $report = "Perl build successful: $cmd\n--\n";
105    $report .= "$output\n";
106    }
107    else {
108    $report = "Perl rebuild failed: $cmd\n--\n";
109    $report .= "$output\n";
110    $report .= "Exit status: " . ($status / 256) . "\n";
111##  $report .= $gsdl_cgi->check_perl_home();
112
113#   $report .= "PATH = ". $ENV{'PATH'}. "\n";
114    }
115
116    return($status,$report);
117}
118
119sub full_import
120{
121    my $self = shift @_;
122
123    my $username  = $self->{'username'};
124    my $collect   = $self->{'collect'};
125    my $gsdl_cgi  = $self->{'gsdl_cgi'};
126    my $gsdl_home  = $self->{'gsdlhome'};
127
128    # Authenticate user if it is enabled
129    if ($baseaction::authentication_enabled) {
130    # Ensure the user is allowed to edit this collection
131    &authenticate_user($gsdl_cgi, $username, $collect);
132    }
133   
134    # Obtain the collect dir
135    my $collect_dir = &util::filename_cat($gsdl_home, "collect");
136
137    # Make sure the collection isn't locked by someone else
138    $self->lock_collection($username, $collect);
139
140    my $bin_script = &util::filename_cat($gsdl_home,"bin","script");
141    my $cmd = "\"$Config{perlpath}\" -S full-import.pl \"$collect\"";
142
143    my ($status,$report) = $self->run_build_cmd($cmd);
144   
145    # Release the lock once it is done
146    $self->unlock_collection($username, $collect);
147
148    if ($status==0) {
149    $gsdl_cgi->generate_ok_message($report);
150    }
151    else {
152    $gsdl_cgi->generate_error($report);
153    }
154
155}
156
157
158sub full_buildcol
159{
160    my $self = shift @_;
161
162    my $username  = $self->{'username'};
163    my $collect   = $self->{'collect'};
164    my $gsdl_cgi  = $self->{'gsdl_cgi'};
165    my $gsdl_home  = $self->{'gsdlhome'};
166
167    # Authenticate user if it is enabled
168    if ($baseaction::authentication_enabled) {
169    # Ensure the user is allowed to edit this collection
170    &authenticate_user($gsdl_cgi, $username, $collect);
171    }
172   
173    # Obtain the collect dir
174    my $collect_dir = &util::filename_cat($gsdl_home, "collect");
175
176    # Make sure the collection isn't locked by someone else
177    $self->lock_collection($username, $collect);
178
179    my $bin_script = &util::filename_cat($gsdl_home,"bin","script");
180    my $cmd = "\"$Config{perlpath}\" -S full-buildcol.pl \"$collect\"";
181
182    my ($status,$report) = $self->run_build_cmd($cmd);
183   
184    # Release the lock once it is done
185    $self->unlock_collection($username, $collect);
186
187    if ($status==0) {
188    $gsdl_cgi->generate_ok_message($report);
189    }
190    else {
191    $gsdl_cgi->generate_error($report);
192    }
193}
194
195
196sub full_rebuild
197{
198    my $self = shift @_;
199
200    my $username  = $self->{'username'};
201    my $collect   = $self->{'collect'};
202    my $gsdl_cgi  = $self->{'gsdl_cgi'};
203    my $gsdl_home  = $self->{'gsdlhome'};
204
205    # Authenticate user if it is enabled
206    if ($baseaction::authentication_enabled) {
207    # Ensure the user is allowed to edit this collection
208    &authenticate_user($gsdl_cgi, $username, $collect);
209    }
210   
211    # Obtain the collect dir
212    my $collect_dir = &util::filename_cat($gsdl_home, "collect");
213
214    # Make sure the collection isn't locked by someone else
215    $self->lock_collection($username, $collect);
216   
217    my $bin_script = &util::filename_cat($gsdl_home,"bin","script");
218    my $cmd = "\"$Config{perlpath}\" -S full-rebuild.pl \"$collect\"";
219
220    my ($status,$report) = $self->run_build_cmd($cmd);
221   
222    # Release the lock once it is done
223    $self->unlock_collection($username, $collect);
224
225    if ($status==0) {
226    $gsdl_cgi->generate_ok_message($report);
227    }
228    else {
229    $gsdl_cgi->generate_error($report);
230    }
231}
232
233
234
235sub incremental_import
236{
237    my $self = shift @_;
238
239    my $username  = $self->{'username'};
240    my $collect   = $self->{'collect'};
241    my $gsdl_cgi  = $self->{'gsdl_cgi'};
242    my $gsdl_home  = $self->{'gsdlhome'};
243
244    # Authenticate user if it is enabled
245    if ($baseaction::authentication_enabled) {
246    # Ensure the user is allowed to edit this collection
247    &authenticate_user($gsdl_cgi, $username, $collect);
248    }
249   
250    # Obtain the collect dir
251    my $collect_dir = &util::filename_cat($gsdl_home, "collect");
252
253    # Make sure the collection isn't locked by someone else
254    $self->lock_collection($username, $collect);
255
256
257    my $bin_script = &util::filename_cat($gsdl_home,"bin","script");
258    my $cmd = "\"$Config{perlpath}\" -S incremental-import.pl \"$collect\"";
259
260    my ($status,$report) = $self->run_build_cmd($cmd);
261   
262    # Release the lock once it is done
263    $self->unlock_collection($username, $collect);
264
265    if ($status==0) {
266    $gsdl_cgi->generate_ok_message($report);
267    }
268    else {
269    $gsdl_cgi->generate_error($report);
270    }
271}
272
273
274sub incremental_buildcol
275{
276    my $self = shift @_;
277
278    my $username  = $self->{'username'};
279    my $collect   = $self->{'collect'};
280    my $gsdl_cgi  = $self->{'gsdl_cgi'};
281    my $gsdl_home  = $self->{'gsdlhome'};
282
283    # Authenticate user if it is enabled
284    if ($baseaction::authentication_enabled) {
285    # Ensure the user is allowed to edit this collection
286    &authenticate_user($gsdl_cgi, $username, $collect);
287    }
288   
289    # Obtain the collect dir
290    my $collect_dir = &util::filename_cat($gsdl_home, "collect");
291
292    # Make sure the collection isn't locked by someone else
293    $self->lock_collection($username, $collect);
294
295
296    my $bin_script = &util::filename_cat($gsdl_home,"bin","script");
297    my $cmd = "\"$Config{perlpath}\" -S incremental-buildcol.pl \"$collect\"";
298
299    my ($status,$report) = $self->run_build_cmd($cmd);
300   
301    # Release the lock once it is done
302    $self->unlock_collection($username, $collect);
303
304    if ($status==0) {
305    $gsdl_cgi->generate_ok_message($report);
306    }
307    else {
308    $gsdl_cgi->generate_error($report);
309    }
310}
311
312
313sub incremental_rebuild
314{
315    my $self = shift @_;
316
317    my $username  = $self->{'username'};
318    my $collect   = $self->{'collect'};
319    my $gsdl_cgi  = $self->{'gsdl_cgi'};
320    my $gsdl_home  = $self->{'gsdlhome'};
321
322    # Authenticate user if it is enabled
323    if ($baseaction::authentication_enabled) {
324    # Ensure the user is allowed to edit this collection
325    &authenticate_user($gsdl_cgi, $username, $collect);
326    }
327   
328    # Obtain the collect dir
329    my $collect_dir = &util::filename_cat($gsdl_home, "collect");
330
331    # Make sure the collection isn't locked by someone else
332    $self->lock_collection($username, $collect);
333
334
335    my $bin_script = &util::filename_cat($gsdl_home,"bin","script");
336    my $cmd = "\"$Config{perlpath}\" -S incremental-rebuild.pl \"$collect\"";
337
338    my ($status,$report) = $self->run_build_cmd($cmd);
339   
340    # Release the lock once it is done
341    $self->unlock_collection($username, $collect);
342
343    if ($status==0) {
344    $gsdl_cgi->generate_ok_message($report);
345    }
346    else {
347    $gsdl_cgi->generate_error($report);
348    }
349}
350
351sub build_by_manifest
352{
353    my $self = shift @_;
354
355    my $username  = $self->{'username'};
356    my $collect   = $self->{'collect'};
357    my $gsdl_cgi  = $self->{'gsdl_cgi'};
358    my $gsdl_home  = $self->{'gsdlhome'};
359
360    # Authenticate user if it is enabled
361    if ($baseaction::authentication_enabled) {
362    # Ensure the user is allowed to edit this collection
363    &authenticate_user($gsdl_cgi, $username, $collect);
364    }
365   
366    # Obtain the collect dir
367    my $collect_dir = &util::filename_cat($gsdl_home, "collect");
368
369    # Make sure the collection isn't locked by someone else
370    $self->lock_collection($username, $collect);
371
372    my $if_json_str   = $self->{'index-files'};
373    my $rf_json_str   = $self->{'reindex-files'};
374    my $df_json_str   = $self->{'delete-OIDs'};
375   
376       
377    my $index_files   = (defined $if_json_str) ? decode_json $if_json_str : [];
378    my $reindex_files = (defined $rf_json_str) ? decode_json $rf_json_str : [];
379    my $delete_files  = (defined $df_json_str) ? decode_json $df_json_str : [];
380   
381    my $index_files_xml   = join("\n", map { "    <Filename>$_</Filename>" } @$index_files);
382    my $reindex_files_xml = join("\n", map { "    <Filename>$_</Filename>" } @$reindex_files);
383    my $delete_files_xml  = join("\n", map { "    <OID>$_</OID>" } @$delete_files);
384   
385    my $manifest_filename = &util::get_tmp_filename(".xml");
386    my ($status,$report);
387           
388    if (open(MOUT,">$manifest_filename")) {
389        binmode(MOUT,":utf8");
390        print MOUT <<MOUTRAW;
391<Manifest>
392  <Index>
393$index_files_xml
394  </Index>
395  <Reindex>
396$reindex_files_xml
397  </Reindex>
398  <Delete>
399$delete_files_xml
400  </Delete>
401</Manifest>
402MOUTRAW
403        close(MOUT);
404       
405        ## my $bin_script = &util::filename_cat($gsdl_home,"bin","script");
406        my $cmd = "\"$Config{perlpath}\" -S incremental-rebuild.pl -manifest \"$manifest_filename\" \"$collect\"";
407
408        ($status,$report) = $self->run_build_cmd($cmd);
409       
410        if ($status==0) {
411            &util::rm($manifest_filename);
412        }
413    }
414    else {
415        $status = -1;
416        $report = "Failed to open '$manifest_filename' for output\n$!\n";
417    }
418   
419   
420    # Release the lock once it is done
421    $self->unlock_collection($username, $collect);
422
423    if ($status==0) {
424    $gsdl_cgi->generate_ok_message($report);
425    }
426    else {
427    $gsdl_cgi->generate_error($report);
428    }
429   
430    # incremental-rebuild.pl -manifest manifest.xml \"" + _greenstoneCollectionName  + "\"";
431 }
432
433
434
4351;
Note: See TracBrowser for help on using the browser.