Context Navigation

source: gsdl/trunk/bin/script/build@ 19446

Last change on this file since 19446 was 19446, checked in by kjdon, 15 years ago
no longer use archives.inf and .ldb/bdb files as tsts. Now use archiveinf-doc.gdb and .gdb files
Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 24.4 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: