#!/usr/local/bin/perl5 -w ########################################################################### # # webpage_buildcol.pl -- # A component of the Greenstone digital library software # from the New Zealand Digital Library Project at the # University of Waikato, New Zealand. # # Copyright (C) 1999 New Zealand Digital Library Project # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # ########################################################################### # This program is a webpage wrapper to the import.pl and buildcol.pl # processes # Note while it is in the cgi-bin directory, its arguments are supplied as # the more traditional command line argument. The program is executed by # an already running cgi program. use Fcntl ':flock'; use File::Basename; my $args; BEGIN { my $va_pair; foreach $va_pair (@ARGV) { if ($va_pair =~ m/^(\w+)=(\"?)(.*)(\"?)$/) { my ($variable,$assignment) = ($1,$3); $args->{$variable} = $assignment; $ENV{'GSDLHOME'} = $assignment if ($variable eq "gsdlhome"); $ENV{'GSDLOS'} = $assignment if ($variable eq "gsdlos"); } } if (defined($ENV{'GSDLHOME'})) { if (!defined($ENV{'GSDLOS'})) { $ENV{'GSDLOS'} = $^O; # special perl variable set to OS ##### Need to check to see what this is set to ##### under Windows } $ENV{'PATH'} .= ":$ENV{'GSDLHOME'}/bin/script"; $ENV{'PATH'} .= ":$ENV{'GSDLHOME'}/bin/$ENV{'GSDLOS'}"; unshift (@INC, "$ENV{'GSDLHOME'}/perllib"); unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan"); } else { print STDERR "Environment variable GSDLHOME not set\n"; exit 1; } } require util; require webpageutil; require cfgread; sub communicate_single_line { my ($full_tmpname,$text) = @_; if (open(TMPOUT,">$full_tmpname")) { if (flock(TMPOUT,LOCK_EX)) { print TMPOUT $text; close(TMPOUT); flock(TMPOUT,LOCK_UN); } else { # Problem locking file my $mess = "Unable to lock temporary communication file:"; $mess .= " $full_tmpname"; print STDERR "$mess\n"; return; } } else { my $mess = "Unable to open for writing"; $mess .= " communication temporary file: $full_tmpname."; print STDERR "$mess\n"; return; } } sub do_build { my ($full_dirname,$dirname,$args) = @_; my $tmpname = $args->{'bc1tmpname'}; my $full_tmpname = &util::filename_cat($ENV{'GSDLHOME'},"tmp",$tmpname); my $cfg_filename = &util::filename_cat($full_dirname,"etc","collect.cfg"); my $full_importname = &util::filename_cat($full_dirname,"import"); my $log_filename = &util::filename_cat($ENV{'GSDLHOME'},"log","$dirname.bld"); if (!open (LOGOUT, ">$log_filename")) { my $mess = "Error: Unable to open log file '$log_filename'"; print LOGOUT "$mess\n"; communicate_single_line($full_tmpname,$mess); return "failure"; } my $copy_data = $args->{'bc1copydata'}; my $do_import = $args->{'bc1doimport'}; my $do_build = $args->{'bc1dobuild'}; my $building_cfg_text = &cfgread::read_cfg_file($cfg_filename,undef,undef,"^building"); my $copy_dir = $building_cfg_text->{'building'}->{'copydir'}; my $input_dir = $building_cfg_text->{'building'}->{'inputdir'}; if ($copy_data eq "true") { if ($copy_dir =~ m/^yes$/i) { my $download_cmd = ""; my $file_or_url = $building_cfg_text->{'building'}->{'fileorurl'}; if ($file_or_url =~ m/^url$/i) { # run urlcopy.pl to download files $download_cmd = "urlcopy.pl "; my @urls = split("\n",$input_dir); my $u; foreach $u (@urls) { $u =~ s/^\s+//; $u =~ s/\s+$//; $download_cmd .= "\"$u\" "; } } else { # run filecopy.pl to download files $input_dir =~ s/^\s+//; $input_dir =~ s/\s+$//; $download_cmd = "filecopy.pl $input_dir"; } $download_cmd .= " $dirname"; # execute download command and monitor the output generated if(!open(DOWNLOADOUT,"$download_cmd 2>&1 |")) { my $mess = "Error: Unable to open pipe to command '$download_cmd'"; print LOGOUT "$mess\n"; communicate_single_line($full_tmpname,$mess); close(LOGOUT); return "failure"; } while (defined($line=)) { print LOGOUT $line; chop $line; if ($line =~ m/^Error:/) { print LOGOUT "$line"; communicate_single_line($full_tmpname,"$line"); close(DOWNLOADOUT); close(LOGOUT); return "failure"; } communicate_single_line($full_tmpname,"Copying data ...
$line"); } close(DOWNLOADOUT); } } if ($copy_dir =~ /^no$/i) { # link it my $tail_dir = &File::Basename::basename($input_dir); my $sym_dirname = &util::filename_cat($full_importname,$tail_dir); &util::rm_r($sym_dirname) if (-e $sym_dirname); if (&util::soft_link($input_dir,$sym_dirname)) { my $mess = "Source data linked to $input_dir"; communicate_single_line($full_tmpname,$mess); } else { my $mess = "Error: unable to make symbolic link to source:"; $mess .= " $input_dir"; print LOGOUT "$mess\n"; communicate_single_line($full_tmpname,$mess); close(LOGOUT); return "failure"; } } if ($do_import eq "true") { # Import operation my $import_cmd = "import.pl -removeold $dirname"; if(!open(IMPORTOUT,"$import_cmd 2>&1 |")) { my $mess = "Error: Unable to open pipe to command '$import_cmd'"; print LOGOUT "$mess\n"; communicate_single_line($full_tmpname,$mess); close(LOGOUT); return "failure"; } while (defined($line=)) { print LOGOUT $line; chop $line; if ($line =~ m/^Error:/) { print LOGOUT "$line"; communicate_single_line($full_tmpname,"$line"); close(IMPORTOUT); close(LOGOUT); return "failure"; } communicate_single_line($full_tmpname,"Caching data ...
$line"); } close(IMPORTOUT); } if ($do_build eq "true") { my $full_archivename = &util::filename_cat($full_dirname,"archives"); # Build operation my $build_cmd = ""; if (($do_import eq "true") || (($do_import eq "false") && (-e $full_archivename))) { $build_cmd = "buildcol.pl $dirname"; } else { $build_cmd = "buildcol.pl"; $build_cmd .= " -archivedir $full_importname"; $build_cmd .= " -cachedir $full_archivename"; $build_cmd .= " $dirname"; } if(!open(BUILDOUT,"$build_cmd 2>&1 |")) { my $mess = "Error: Unable to open pipe to command '$build_cmd'"; print LOGOUT "$mess\n"; communicate_single_line($full_tmpname,$mess); close(LOGOUT); return "failure"; } while (defined($line=)) { print LOGOUT $line; chop $line; if ($line =~ m/^Error:/) { print LOGOUT "$line"; communicate_single_line($full_tmpname,"$line"); close(BUILDOUT); close(LOGOUT); return "failure"; } communicate_single_line($full_tmpname,"Creating indexes ...
$line"); } close(BUILDOUT); # Make collection live #-- # rm index my $full_indexname = &util::filename_cat($full_dirname,"index"); &util::rm_r($full_indexname); # move building my $full_buildingname = &util::filename_cat($full_dirname,"building"); &util::mv($full_buildingname,$full_indexname); my $full_imagesrc = &util::filename_cat($full_dirname,"building_images","imgsrc"); if (-e $full_imagesrc) { my $full_imagedst = &util::filename_cat($full_dirname,"index","imgsrc"); &util::soft_link($full_imagesrc,$full_imagedst); } # Recreate 'building' directory ready for next build &util::mk_dir($full_buildingname); } communicate_single_line($full_tmpname,"Done"); close(LOGOUT); return "success"; } sub main { # get arguments my $dirname = $args->{'bc1dirname'}; if (!defined($dirname)) { my $mess = "Directory name for collection missing."; print STDERR "$mess\n"; return; } my $tmpname = $args->{'bc1tmpname'}; if (!defined($tmpname)) { my $mess = "Temporary name for building communication missing."; print STDERR "$mess\n"; return; } my $full_tmpname = &util::filename_cat($ENV{'GSDLHOME'},"tmp",$tmpname); communicate_single_line($full_tmpname,"Preparing to build."); # Put lock on config file before any building is done as safe # guard against any concurrent operations on this collection. #-- my $full_dirname = &util::filename_cat($ENV{'GSDLHOME'},"collect",$dirname); my $cfg_filename = &util::filename_cat($full_dirname,"etc","collect.cfg"); if (open(CFGIN,"<$cfg_filename")) { if (flock(CFGIN,LOCK_EX)) { # do requested stages for building my $result = do_build($full_dirname,$dirname,$args); flock(CFGIN,LOCK_UN); close(CFGIN); return if ($result ne "success"); } else { # Problem locking file my $mess = "Unable to lock configuration file: $cfg_filename"; print STDERR "$mess\n"; return; } } # my $mess_url = "$args->{'httpbuild'}&bca=mess&bc1dirname=$dirname"; # print "Location: $mess_url&head=_headdone_&mess=_messdonebuildcol_\n\n"; # print "done\n"; # in tmp file } &main();