source: main/trunk/greenstone2/bin/script/build@ 22589

Last change on this file since 22589 was 22589, checked in by kjdon, 14 years ago

at the end of import it checks for existence of archiveinf-src.gdb to see if imoprting was successful. Need to get infodbtype from collect.cfg so that we look for the right filename extension for this file, as may not always be gdb.
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 25.4 KB
Line 
1#!/usr/bin/perl -w
2
3###########################################################################
4#
5# build --
6# A component of the Greenstone digital library software
7# from the New Zealand Digital Library Project at the
8# University of Waikato, New Zealand.
9#
10# Copyright (C) 2000 New Zealand Digital Library Project
11#
12# This program is free software; you can redistribute it and/or modify
13# it under the terms of the GNU General Public License as published by
14# the Free Software Foundation; either version 2 of the License, or
15# (at your option) any later version.
16#
17# This program is distributed in the hope that it will be useful,
18# but WITHOUT ANY WARRANTY; without even the implied warranty of
19# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20# GNU General Public License for more details.
21#
22# You should have received a copy of the GNU General Public License
23# along with this program; if not, write to the Free Software
24# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
25#
26###########################################################################
27
28# This perl script may be called directly or by running build.bat on
29# windows (build.bat is in bin\windows)
30
31# Note that this script has grown over time and now has many options for
32# use when called from within the collector. If it appears to
33# over-complicate things a little, that's why.
34
35package build;
36
37use strict;
38no strict 'refs';
39
40use FileHandle;
41use File::Copy;
42
43BEGIN {
44
45 die "GSDLHOME not set - did you remember to source setup.bash (unix) or " .
46 "run setup.bat (windows)?\n" unless defined $ENV{'GSDLHOME'};
47 die "GSDLOS not set - did you remember to source setup.bash (unix) or " .
48 "run setup.bat (windows)?\n" unless defined $ENV{'GSDLOS'};
49 unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
50
51 STDOUT->autoflush(1);
52 STDERR->autoflush(1);
53}
54
55use lib qq($ENV{'GSDLHOME'}/perllib/cpan);
56use Mail::Sendmail;
57use parsargv;
58use util;
59use cfgread;
60use colcfg;
61use dbutil;
62
63# set up path - this allows for paths not to be supplied to system calls
64# and overcomes problems when GSDLHOME contains spaces (double quoting
65# the call doesn't work on win2k and probably other variants of winnt)
66my $path_separator = ":";
67$path_separator = ";" if $ENV{'GSDLOS'} =~ /^windows$/;
68$ENV{'PATH'} = &util::filename_cat($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'}) .
69 $path_separator . &util::filename_cat($ENV{'GSDLHOME'}, "bin", "script") .
70 $path_separator . $ENV{'PATH'};
71
72# all the input option variables
73my ($optionfile, $indextype, $append, $manifest, $remove_archives, $remove_import, $buildtype, $infodbtype, $maxdocs, @download, $collectdir, $site, $dontinstall, $save_archives, $out, $make_writable, $log_events, $event_log_file, $email_events, $mail_server, $statsfile, $event_header);
74
75&parse_args (\@ARGV);
76
77my ($collection) = @ARGV;
78
79if (!defined $collection || $collection !~ /\w/) {
80 print STDERR "You must specify a collection to build\n";
81 &print_usage();
82 die "\n";
83}
84
85if ($optionfile =~ /\w/) {
86 open (OPTIONS, $optionfile) || die "Couldn't open $optionfile\n";
87 my $line = [];
88 my $options = [];
89 while (defined ($line = &cfgread::read_cfg_line ('build::OPTIONS'))) {
90 push (@$options, @$line);
91 }
92 close OPTIONS;
93 &parse_args ($options);
94}
95
96if ($maxdocs == -1) {
97 $maxdocs = "";
98} else {
99 $maxdocs = "-maxdocs $maxdocs";
100}
101
102my $cdir = $collectdir;
103my $gs_mode;
104if (defined $site && $site =~ /\w/)
105{
106 die "GSDL3HOME not set." unless $ENV{'GSDL3HOME'};
107 $cdir = &util::filename_cat ($ENV{'GSDL3HOME'}, "sites", $site, "collect") unless $collectdir =~ /\w/;
108 $gs_mode = "gs3";
109}
110else
111{
112 $cdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect") unless $collectdir =~ /\w/;
113 $gs_mode = "gs2";
114}
115
116my $importdir = &util::filename_cat ($cdir, $collection, "import");
117my $archivedir = &util::filename_cat ($cdir, $collection, "archives");
118my $buildingdir = &util::filename_cat ($cdir, $collection, "building");
119my $indexdir = &util::filename_cat ($cdir, $collection, "index");
120my $etcdir = &util::filename_cat ($cdir, $collection, "etc");
121my $bindir = &util::filename_cat ($ENV{'GSDLHOME'}, "bin");
122
123my $use_out = 0;
124my $outfile = $out;
125if ($out !~ /^(STDERR|STDOUT)$/i) {
126 open (OUT, ">$out") || die "Couldn't open output file $out\n";
127 $out = "OUT";
128
129 # delete any existing .final file
130 &util::rm ("$outfile.final") if -e "$outfile.final";
131
132 $use_out = 1;
133}
134$out->autoflush(1);
135
136# delete any .kill file left laying around from a previously aborted build
137if (-e &util::filename_cat ($cdir, $collection, ".kill")) {
138 &util::rm (&util::filename_cat ($cdir, $collection, ".kill"));
139}
140
141# get maintainer email address from main.cfg
142my $maintainer = "NULL";
143my $main_cfg = &util::filename_cat ($ENV{'GSDLHOME'}, "etc", "main.cfg");
144my $cfgdata = &cfgread::read_cfg_file ($main_cfg, "maintainer");
145if (defined $cfgdata->{'maintainer'} && $cfgdata->{'maintainer'} =~ /\w/) {
146 $maintainer = $cfgdata->{'maintainer'};
147}
148# if maintainer is "NULL" email_events should be disabled
149if ($maintainer =~ /^NULL$/i) {
150 $email_events = "";
151}
152
153&main();
154
155if ($use_out) {
156 close OUT;
157
158 # if we've created a build log we'll copy it to the collection's etc
159 # directory
160 my ($final_etcdir);
161 if ($dontinstall) {
162 $final_etcdir = &util::filename_cat($collectdir, "etc", "build.log");
163 } else {
164 $final_etcdir = &util::filename_cat($ENV{'GSDLHOME'}, "collect", $collection, "etc", "build.log");
165 }
166
167 &util::cp($outfile, $final_etcdir);
168}
169
170sub print_usage {
171 print STDOUT "\n";
172 print STDOUT "build: Builds a Greenstone collection (i.e. runs import.pl and buildcol.pl\n";
173 print STDOUT " then copies the resulting indexes to the correct place).\n\n";
174 print STDOUT " usage: $0 [options] collection-name\n\n";
175 print STDOUT " options:\n";
176 print STDOUT " -optionfile file Get options from file, useful on systems where\n";
177 print STDOUT " long command lines may cause problems\n";
178 print STDOUT " -indextype mg|mgpp|lucene \n";
179 print STDERR " Specify the type of indexer used in this collection\n";
180 print STDERR " If -append is used then -indextype is needed to \n";
181 print STDERR " determine how to run buildcol.pl as well as update\n";
182 print STDERR " 'building' and 'index' according.\n";
183 print STDOUT " -append Add new files to existing collection\n";
184 print STDOUT " -manifest Use manifest.xml file to determine which files to process.\n";
185 print STDOUT " -remove_archives Remove archives directory after successfully\n";
186 print STDOUT " building the collection.\n";
187 print STDOUT " -remove_import Remove import directory after successfully\n";
188 print STDOUT " importing the collection.\n";
189 print STDOUT " -buildtype build|import If 'build' attempt to build directly\n";
190 print STDOUT " from archives directory (bypassing import\n";
191 print STDOUT " stage). Defaults to 'import'\n";
192 print STDOUT " -maxdocs number Maximum number of documents to build\n";
193 print STDOUT " -download directory Directory (or file) to get import documents from.\n";
194 print STDOUT " There may be multiple download directories and they\n";
195 print STDOUT " may be of type http://, ftp://, or file://\n";
196 print STDOUT " Note that any existing import directory will be\n";
197 print STDOUT " deleted to make way for the downloaded data if\n";
198 print STDOUT " a -download option is supplied\n";
199 print STDOUT " -collectdir directory Collection directory (defaults to " .
200 &util::filename_cat($ENV{'GSDLHOME'}). "collect for Greenstone2;\n";
201 print STDOUT" for Greenstone3 use -site option and then collectdir default will be\n";
202 print STDOUT " set to the collect folder within that site.)\n";
203 print STDOUT " -site Specify the site within a Greenstone3 installation to use.\n";
204 print STDOUT " -dontinstall Only applicable if -collectdir is set to something\n";
205 print STDOUT " other than the default. -dontinstall will suppress\n";
206 print STDOUT " the default behaviour which is to install the\n";
207 print STDOUT " collection to the gsdl/collect directory once it has\n";
208 print STDOUT " been built.\n";
209 print STDOUT " -save_archives Create a copy of the existing archives directory\n";
210 print STDOUT " called archives.org\n";
211 print STDOUT " -out Filename or handle to print output status to.\n";
212 print STDOUT " The default is STDERR\n";
213 print STDOUT " -statsfile name Filename or handle to print import statistics to.\n";
214 print STDOUT " The default is STDERR\n";
215 print STDOUT " -make_writable If set build will make the collection and any\n";
216 print STDOUT " temporary files it created globally writable after\n";
217 print STDOUT " it finishes\n";
218 print STDOUT " -log_events Log important events (collection built successfully\n";
219 print STDOUT " etc.) to event_log_file\n";
220 print STDOUT " -event_log_file file File to append important events to (defaults to\n";
221 print STDOUT " " . &util::filename_cat ($ENV{'GSDLHOME'}, "etc", "events.txt") . "\n";
222 print STDOUT " -email_events addr Comma separated list of email addresses to mail\n";
223 print STDOUT " details of important collection building events\n";
224 print STDOUT " -mail_server server The outgoing (SMTP) mail server to be used by\n";
225 print STDOUT " email_events. email_events will be disabled if\n";
226 print STDOUT " mail_server isn't set\n";
227 print STDOUT " -event_header file File containing a header to go on any event\n";
228 print STDOUT " messages. If not specified build will create a\n";
229 print STDOUT " generic header\n\n";
230 print STDOUT " [Type \"build | more\" if this help text scrolled off your screen]";
231 print STDOUT "\n" unless $ENV{'GSDLOS'} =~ /^windows$/i;
232}
233
234sub main {
235
236 if ($save_archives && -d $archivedir) {
237 print $out "caching original archives to ${archivedir}.org\n";
238 &util::cp_r ($archivedir, "${archivedir}.org");
239 }
240
241 # do the download thing if we have any -download options
242 if (scalar (@download)) {
243 # remove any existing import data
244 if (&has_content ($importdir)) {
245 print $out "build: WARNING: removing contents of $importdir\n";
246 &util::rm_r ($importdir);
247 }
248
249 foreach my $download_dir (@download) {
250
251 # remove any leading or trailing whitespace from filenames (just in case)
252 $download_dir =~ s/^\s+//;
253 $download_dir =~ s/\s+$//;
254
255 if ($download_dir =~ /^(http|ftp):\/\//) {
256 # use wget to mirror http or ftp urls
257 # options used are:
258 # -P = the directory to download documents to
259 # -np = don't ascend to parent directories. this means that only documents
260 # that live in the same directory or below on the same server as
261 # the given url will be downloaded
262 # -nv = not too verbose
263 # -r = recursively mirror
264 # -N = use time-stamping to see if an up-to-date local copy of each
265 # file already exists. this may be useful if wget fails and
266 # is restarted
267 # -l inf = infinite recursion depth
268 # -R "*\?*" = don't download cgi based urls
269 # -o = the output file to write download status to (only used if the -out
270 # option was given to build)
271
272 my $download_cmd = "perl -S gsWget.pl -P \"$importdir\" -np -nv";
273 $download_cmd .= " -r -N -l inf -R \"*\\?*\"";
274 $download_cmd .= " -o \"$outfile.download\"" if $use_out;
275 $download_cmd .= " \"$download_dir\"";
276 system ($download_cmd);
277
278 # note that wget obeys the robot rules. this means that it will have
279 # downloaded a robots.txt file if one was present. since it's unlikely
280 # anyone really wants to include it in a collection we'll delete it.
281 # robots.txt shouldn't be more than two directories deep (I think it will
282 # always be exactly two deep but will look for it in the top directory too)
283 # so that's as far as we'll go looking for it.
284 if (opendir (DIR, $importdir)) {
285 my @files = readdir DIR;
286 closedir DIR;
287 foreach my $file (@files) {
288 next if $file =~ /^\.\.?$/;
289 if ($file =~ /^robots.txt$/i) {
290 &util::rm (&util::filename_cat ($importdir, $file));
291 last;
292 } else {
293 $file = &util::filename_cat ($importdir, $file);
294 if (-d $file) {
295 if (opendir (DIR, $file)) {
296 my @files2 = readdir DIR;
297 closedir DIR;
298 foreach my $file2 (@files2) {
299 if ($file2 =~ /^robots.txt$/i) {
300 &util::rm (&util::filename_cat ($file, $file2));
301 last;
302 }
303 }
304 }
305 }
306 }
307 }
308 }
309
310 # if using output directory append the file download output to it
311 &append_file ($out, "$outfile.download");
312
313 } else {
314 # we assume anything not beginning with http:// or ftp://
315 # is a file or directory on the local file system.
316 $download_dir =~ s/^file:(\/\/)?//;
317 $download_dir =~ s/^\s+//; # may be whitespace between "file://" and the rest
318
319 if (-e $download_dir) {
320 # copy download_dir and all it contains to the import directory
321 my $download_cmd = "perl -S filecopy.pl";
322 $download_cmd .= " -collectdir \"$collectdir\"" if $collectdir =~ /\w/;
323 $download_cmd .= " -site \"$site\"" if $site =~ /\w/;
324 $download_cmd .= " -out \"$outfile.download\"" if $use_out;
325 $download_cmd .= " \"" . $download_dir . "\" " . $collection;
326
327 my $download_status = system ($download_cmd);
328 if ($download_status > 0)
329 {
330 die "Failed to execute: $download_cmd\n";
331 }
332
333
334 # if using output directory append the file download output to it
335 &append_file ($out, "$outfile.download");
336 } else {
337 print $out "WARNING: '$download_dir' does not exist\n";
338 }
339 }
340 }
341 }
342
343 `echo $importdir ; ls $importdir `;
344
345 my $col_cfg_file;
346 if ($gs_mode eq "gs3") {
347 $col_cfg_file = &util::filename_cat($etcdir, "collectionConfig.xml");
348 } else {
349 $col_cfg_file = &util::filename_cat($etcdir, "collect.cfg");
350 }
351
352 my $collect_cfg = &colcfg::read_collection_cfg ($col_cfg_file, $gs_mode);
353 # get the database type for this collection from its configuration file (may be undefined)
354 $infodbtype = $collect_cfg->{'infodbtype'} || &dbutil::get_default_infodb_type();
355
356 my $archiveinf_doc_file_path = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archivedir);
357 if (-e $archiveinf_doc_file_path) {
358 if (&has_content ($importdir)) {
359 if ($buildtype eq "build") {
360 &gsdl_build();
361 } else {
362 &gsdl_import();
363 &gsdl_build();
364 }
365 } else {
366 # there are archives but no import, build directly from archives
367 print $out "build: no import material was found, building directly\n";
368 print $out " from archives\n";
369 &gsdl_build();
370 }
371 } else {
372 if (&has_content ($importdir)) {
373 if ($buildtype eq "build") {
374 print $out "build: can't build directly from archives as no\n";
375 print $out " imported archives exist (did you forget to\n";
376 print $out " move the contents of $collection/import to\n";
377 print $out " collection/archives?)\n";
378 }
379 &gsdl_import();
380 if (&has_content ($archivedir, "^archiveinf-doc\..*\$")) {
381 &gsdl_build();
382 } else {
383 my $msg = "build: ERROR: The collection could not be built as no\n";
384 $msg .= " valid data was imported. Are at least some of\n";
385 $msg .= " the files you imported in a format that can be\n";
386 $msg .= " processed by the specified Greenstone plugins?\n";
387 print $out $msg;
388 &log_event ($msg);
389 &final_out (6) if $use_out;
390 die "\n";
391 }
392 } else {
393 # no import or archives
394 my $msg = "build: ERROR: The collection could not be built as it contains no data.\n";
395 print $out $msg;
396 &log_event ($msg);
397 &final_out (1) if $use_out;
398 die "\n";
399 }
400 }
401
402 if ($collectdir ne "" && !$dontinstall) {
403
404 my $install_collectdir;
405 if (defined $ENV{'GSDL3HOME'})
406 {
407
408 if ((defined $site) && ($site ne ""))
409 {
410 $install_collectdir = &util::filename_cat ($ENV{'GSDL3HOME'}, "sites", $site, "collect");
411 }
412 else
413 {
414 my $msg = "build: ERROR: Need to specify the site within the Greenstone3 installation.";
415 print $out $msg;
416 &log_event ($msg);
417 &final_out (6) if $use_out;
418 die "\n";
419 }
420 }
421 else
422 {
423 $install_collectdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect");
424 }
425
426 if (!&util::filenames_equal ($collectdir, $install_collectdir)) {
427
428 # install collection to gsdl/collect
429 print $out "installing the $collection collection\n";
430 my $newdir = &util::filename_cat ($install_collectdir, $collection);
431 my $olddir = &util::filename_cat ($collectdir, $collection);
432 if (-d $newdir) {
433 my $msg = "build: Could not install collection as $newdir\n" .
434 " already exists. Collection will remain at\n$olddir\n";
435
436 print $out $msg;
437 &log_event ($msg);
438 &final_out (4) if $use_out;
439 die "\n";
440 }
441 if (!&File::Copy::move ($olddir, $newdir)) {
442 my $msg = "build: Failed to install collection to $newdir\n" .
443 " Collection will remain at $olddir\n";
444 print $out $msg;
445 &log_event ($msg);
446 &final_out (5) if $use_out;
447 die "\n";
448 }
449 }
450 }
451
452 &log_event ("The $collection collection was built successfully\n");
453 &final_out (0) if $use_out;
454}
455
456sub gsdl_import {
457
458 print $out "importing the $collection collection\n\n";
459
460 my $import_cmd = "perl -S import.pl";
461 $import_cmd .= " -out \"$outfile.import\"" if $use_out;
462 if ($append) {
463 $import_cmd .= " -keepold";
464 if (not $manifest) {
465 # if we are appending, with no manifest, assume incremental
466 $import_cmd .= " -incremental";
467 }
468 } else {
469 $import_cmd .= " -removeold";
470 }
471
472 $import_cmd .= " -manifest manifest.xml" if ($manifest);
473 $import_cmd .= " -site \"$site\"" if $site =~ /\w/;
474 $import_cmd .= " -collectdir \"$collectdir\"" if $collectdir =~ /\w/;
475 $import_cmd .= " -statsfile \"$statsfile\"" if $statsfile =~ /\w/;
476 $import_cmd .= " $maxdocs $collection";
477
478 system ($import_cmd);
479 # if using output directory append the import output to it
480 &append_file ($out, "$outfile.import");
481
482 my $archiveinf_doc_file_path = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $archivedir);
483
484 if (-e $archiveinf_doc_file_path) {
485 print $out "$collection collection imported successfully\n\n";
486 if ($remove_import) {
487 print $out "removing import directory ($importdir)\n";
488 &util::rm_r ($importdir);
489 }
490 } else {
491 print $out "$archiveinf_doc_file_path not found. archives contents:\n";
492 print $out `ls $archivedir`;
493
494 my $msg = "build: ERROR: import.pl failed\n";
495 print $out "\n$msg";
496 &log_event ($msg);
497 &final_out (2) if $use_out;
498 die "\n";
499 }
500}
501
502sub gsdl_build {
503
504 print $out "building the $collection collection\n\n";
505
506 my $build_cmd = "perl -S buildcol.pl";
507
508 my $removeold = 1;
509 if ($append) {
510 if ($indextype eq "lucene") {
511 $build_cmd .= " -keepold -incremental -builddir $indexdir";
512 $removeold = 0;
513 }
514 else {
515 $build_cmd .= " -removeold";
516 }
517 }
518 else {
519 $build_cmd .= " -removeold";
520 }
521
522 $build_cmd .= " -out \"$outfile.build\"" if $use_out;
523 $build_cmd .= " -site \"$site\"" if $site =~ /\w/;
524 $build_cmd .= " -collectdir \"$collectdir\"" if $collectdir =~ /\w/;
525 $build_cmd .= " $maxdocs $collection";
526 system ($build_cmd);
527 # if using output directory append the buildcol output to it
528 &append_file ($out, "$outfile.build");
529
530 my @db_exts = ( ".ldb", ".bdb", ".gdb", ".db" );
531 my $build_ok = 0;
532 foreach my $db_ext (@db_exts) {
533 if ($removeold && (-e &util::filename_cat ($buildingdir, "text", "$collection$db_ext"))) {
534 $build_ok = 1;
535 last;
536 }
537 if (($removeold==0) && (-e &util::filename_cat ($indexdir, "text", "$collection$db_ext"))) {
538 $build_ok = 1;
539 last;
540 }
541 }
542
543 if ($build_ok) {
544 print $out "$collection collection built successfully\n\n";
545 if ($remove_archives) {
546 print $out "removing archives directory ($archivedir)\n";
547 &util::rm_r ($archivedir);
548 }
549 } else {
550 my $msg = "build: ERROR: buildcol.pl failed\n";
551 print $out "\n$msg";
552 &log_event ($msg);
553 &final_out (3) if $use_out;
554 die "\n";
555 }
556
557 if ($removeold) {
558 # replace old indexes with new ones
559 if (&has_content ($indexdir)) {
560 print $out "removing old indexes\n";
561 &util::rm_r ($indexdir);
562 }
563 rmdir ($indexdir) if -d $indexdir;
564 &File::Copy::move ($buildingdir, $indexdir);
565 }
566 else {
567 # Do nothing. We have built into index dir rather than building dir
568 }
569
570 # remove the cached archives
571 if ($save_archives && -d "${archivedir}.org") {
572 &util::rm_r ("${archivedir}.org");
573 }
574}
575
576# return 1 if $dir directory contains any files or sub-directories (other
577# than those specified in the $ignore regular expression)
578sub has_content {
579 my ($dir, $ignore) = @_;
580
581 if (!-d $dir) {return 0;}
582
583 opendir (DIR, $dir) || return 0;
584 my @files = readdir DIR;
585 closedir DIR;
586
587 foreach my $file (@files) {
588 if ($file !~ /^\.{1,2}$/) {
589 return 1 unless (defined $ignore && $file =~ /$ignore/);
590 }
591 }
592
593 return 0;
594}
595
596sub append_file {
597 my ($handle, $file) = @_;
598
599 open (FILE, $file) || return;
600 undef $/;
601 print $handle <FILE>;
602 $/ = "\n";
603 close FILE;
604 &util::rm ($file);
605}
606
607# creates a file called $outfile.final and writes an output code to it.
608# An output code of 0 specifies that there was no error
609sub final_out {
610 my ($exit_code) = @_;
611
612 if ($use_out && (!-e "$outfile.final")) {
613
614 if (open (FINAL, ">$outfile.final")) {
615 print FINAL $exit_code;
616 close FINAL;
617 }
618 }
619}
620
621sub log_event {
622 my ($msg) = @_;
623
624 return unless ($log_events || $email_events);
625
626 # get the event header
627 my $eheader = "[Build Event]\n";
628 $eheader .= "Date: " . scalar localtime() . "\n";
629 if ($event_header ne "" && open (HEADER, $event_header)) {
630 undef $/;
631 $eheader .= <HEADER>;
632 $/ = "\n";
633 close HEADER;
634 } else {
635 $eheader .= "Collection: $collection\n";
636 $eheader .= "GSDLHOME: $ENV{'GSDLHOME'}\n";
637 $eheader .= "Build Location: $collectdir\n";
638 }
639
640 if ($log_events) {
641 my $fail = 0;
642 # append the event to the event log file
643 if ($event_log_file eq "" || !open (LOG, ">>$event_log_file")) {
644 # log file defaults to $GSDLHOME/etc/events.txt
645 $event_log_file = &util::filename_cat ($ENV{'GSDLHOME'}, "etc", "events.txt");
646 if (!open (LOG, ">>$event_log_file")) {
647 print $out "build: ERROR: Couldn't open event log file $event_log_file\n";
648 $fail = 1;
649 }
650 }
651 if (!$fail) {
652 print LOG $eheader;
653 print LOG $msg;
654 print LOG "\n";
655 close LOG;
656 }
657 }
658
659 if ($email_events) {
660 # if mail_server isn't set email_events does nothing
661 if ($mail_server eq "") {
662 print $out "build: WARNING: mail_server was not set - email_events option was ignored\n";
663 return;
664 }
665
666 my %mail = ('SMTP' => $mail_server,
667 'To' => $email_events,
668 'From' => $maintainer,
669 'Subject' => 'Greenstone Build Event'
670 );
671 $mail{'Message'} = $eheader . $msg;
672
673 if (!sendmail %mail) {
674 print $out "build: ERROR sending mail to $email_events\n";
675 print $out "'$Mail::Sendmail::error'\n";
676 }
677 }
678}
679
680
681sub parse_args {
682 my ($argref) = @_;
683
684 if (!parsargv::parse($argref,
685 'optionfile/.*/', \$optionfile,
686 'indextype/^(mg|mgpp|lucene)$/mg', \$indextype,
687 'append', \$append,
688 'manifest', \$manifest,
689 'remove_archives', \$remove_archives,
690 'remove_import', \$remove_import,
691 'buildtype/^(build|import)$/import', \$buildtype,
692 'maxdocs/^\-?\d+/-1', \$maxdocs,
693 'download/.+', \@download,
694 'collectdir/.*/', \$collectdir,
695 'site/.*/', \$site,
696 'dontinstall', \$dontinstall,
697 'save_archives', \$save_archives,
698 'out/.*/STDERR', \$out,
699 'make_writable', \$make_writable,
700 'log_events', \$log_events,
701 'event_log_file/.*/', \$event_log_file,
702 'email_events/.*/', \$email_events,
703 'mail_server/.*/', \$mail_server,
704 'statsfile/.*/STDERR', \$statsfile,
705 'event_header/.*/', \$event_header)) {
706
707 &print_usage();
708 die "\n";
709 }
710}
711
712
713END {
714
715 if ($make_writable) {
716 # chmod a+rw new collection
717 my $installed_collection = &util::filename_cat($ENV{'GSDLHOME'}, "collect", $collection);
718 &recursive_chmod($installed_collection);
719
720 # chmod a+rw anything we've left laying about in the tmp directory
721 if (($collectdir ne "") &&
722 (!&util::filenames_equal ($collectdir, &util::filename_cat($ENV{'GSDLHOME'}, "collect")))) {
723 &recursive_chmod($collectdir);
724 }
725 }
726
727 # this will produce a .final file if one doesn't exist yet - that
728 # should only happen if there's been an error somewhere in the perl
729 # code
730 &final_out(7);
731
732 sub recursive_chmod {
733 my ($dir) = @_;
734 return unless -d $dir;
735
736 chmod (0777, $dir);
737
738 opendir (DIR, $dir) || die;
739 my @files = readdir DIR;
740 closedir DIR;
741
742 foreach my $file (@files) {
743 next if $file =~ /^\.\.?$/;
744 $file = &util::filename_cat($dir, $file);
745 if (-d $file) {
746 &recursive_chmod ($file);
747 } else {
748 chmod (0777, $file);
749 }
750 }
751 }
752}
Note: See TracBrowser for help on using the repository browser.