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

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

The method of locating perl has changed once more: util now defines the fuction get_perl_exec which is used by other scripts to obtain the path to the perl executable they should use.

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