source: main/trunk/greenstone2/perllib/cgiactions/buildaction.pm@ 24192

Last change on this file since 24192 was 24192, checked in by ak19, 13 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 *
File size: 11.4 KB
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 repository browser.