source: trunk/gsdl/cgi-bin/webpage_buildcol.pl@ 817

Last change on this file since 817 was 724, checked in by davidb, 25 years ago

Perl CGI scripts to help in webpage based collection building.
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 9.3 KB
Line 
1#!/usr/local/bin/perl5 -w
2
3###########################################################################
4#
5# webpage_buildcol.pl --
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) 1999 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 program is a webpage wrapper to the import.pl and buildcol.pl
29# processes
30# Note while it is in the cgi-bin directory, its arguments are supplied as
31# the more traditional command line argument. The program is executed by
32# an already running cgi program.
33
34use Fcntl ':flock';
35use File::Basename;
36
37my $args;
38
39BEGIN
40{
41 my $va_pair;
42 foreach $va_pair (@ARGV)
43 {
44 if ($va_pair =~ m/^(\w+)=(\"?)(.*)(\"?)$/)
45 {
46 my ($variable,$assignment) = ($1,$3);
47 $args->{$variable} = $assignment;
48
49 $ENV{'GSDLHOME'} = $assignment if ($variable eq "gsdlhome");
50 $ENV{'GSDLOS'} = $assignment if ($variable eq "gsdlos");
51 }
52 }
53
54 if (defined($ENV{'GSDLHOME'}))
55 {
56 if (!defined($ENV{'GSDLOS'}))
57 {
58 $ENV{'GSDLOS'} = $^O; # special perl variable set to OS
59 ##### Need to check to see what this is set to
60 ##### under Windows
61 }
62
63 $ENV{'PATH'} .= ":$ENV{'GSDLHOME'}/bin/script";
64 $ENV{'PATH'} .= ":$ENV{'GSDLHOME'}/bin/$ENV{'GSDLOS'}";
65
66 unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
67 unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
68 }
69 else
70 {
71 print STDERR "Environment variable GSDLHOME not set\n";
72 exit 1;
73 }
74}
75
76require util;
77require webpageutil;
78require cfgread;
79
80sub communicate_single_line
81{
82 my ($full_tmpname,$text) = @_;
83
84 if (open(TMPOUT,">$full_tmpname"))
85 {
86 if (flock(TMPOUT,LOCK_EX))
87 {
88 print TMPOUT $text;
89 close(TMPOUT);
90 flock(TMPOUT,LOCK_UN);
91 }
92 else
93 {
94 # Problem locking file
95 my $mess = "Unable to lock temporary communication file:";
96 $mess .= " $full_tmpname";
97 print STDERR "$mess\n";
98 return;
99 }
100 }
101 else
102 {
103 my $mess = "Unable to open for writing";
104 $mess .= " communication temporary file: $full_tmpname.";
105 print STDERR "$mess\n";
106 return;
107 }
108}
109
110
111sub do_build
112{
113 my ($full_dirname,$dirname,$args) = @_;
114
115 my $tmpname = $args->{'bc1tmpname'};
116 my $full_tmpname = &util::filename_cat($ENV{'GSDLHOME'},"tmp",$tmpname);
117 my $cfg_filename = &util::filename_cat($full_dirname,"etc","collect.cfg");
118 my $full_importname = &util::filename_cat($full_dirname,"import");
119
120 my $log_filename = &util::filename_cat($ENV{'GSDLHOME'},"log","$dirname.bld");
121 if (!open (LOGOUT, ">$log_filename"))
122 {
123 my $mess = "Error: Unable to open log file '$log_filename'";
124 communicate_single_line($full_tmpname,$mess);
125 return "failure";
126 }
127
128 my $copy_data = $args->{'bc1copydata'};
129 my $do_import = $args->{'bc1doimport'};
130 my $do_build = $args->{'bc1dobuild'};
131
132 my $building_cfg_text
133 = &cfgread::read_cfg_file($cfg_filename,undef,undef,"^building");
134 my $copy_dir = $building_cfg_text->{'building'}->{'copydir'};
135 my $input_dir = $building_cfg_text->{'building'}->{'inputdir'};
136
137 if ($copy_data eq "true")
138 {
139 if ($copy_dir =~ m/^yes$/i)
140 {
141 my $download_cmd = "";
142 my $file_or_url = $building_cfg_text->{'building'}->{'fileorurl'};
143
144 if ($file_or_url =~ m/^url$/i)
145 {
146 # run urlcopy.pl to download files
147 $download_cmd = "urlcopy.pl ";
148 my @urls = split("\n",$input_dir);
149 my $u;
150 foreach $u (@urls)
151 {
152 $u =~ s/^\s+//;
153 $u =~ s/\s+$//;
154 $download_cmd .= "\"$u\" ";
155 }
156 }
157 else
158 {
159 # run filecopy.pl to download files
160 $input_dir =~ s/^\s+//;
161 $input_dir =~ s/\s+$//;
162 $download_cmd = "filecopy.pl $input_dir";
163 }
164
165 $download_cmd .= " $dirname";
166
167 # execute download command and monitor the output generated
168 if(!open(DOWNLOADOUT,"$download_cmd 2>&1 |"))
169 {
170 my $mess = "Error: Unable to open pipe to command '$download_cmd'";
171 communicate_single_line($full_tmpname,$mess);
172 close(LOGOUT);
173 return "failure";
174 }
175 while (defined($line=<DOWNLOADOUT>))
176 {
177 print LOGOUT $line;
178 chop $line;
179 if ($line =~ m/^Error:/)
180 {
181 communicate_single_line($full_tmpname,"$line");
182 close(DOWNLOADOUT);
183 close(LOGOUT);
184 return "failure";
185 }
186 communicate_single_line($full_tmpname,"Copying data ...<br>$line");
187 }
188
189 close(DOWNLOADOUT);
190 }
191 }
192
193 if ($copy_dir =~ /^no$/i)
194 {
195 # link it
196 my $tail_dir = &File::Basename::basename($input_dir);
197 my $sym_dirname = &util::filename_cat($full_importname,$tail_dir);
198
199 &util::rm($sym_dirname) if (-e $sym_dirname);
200
201 if (&util::soft_link($input_dir,$sym_dirname))
202 {
203 my $mess = "Source data linked to $input_dir";
204 communicate_single_line($full_tmpname,$mess);
205 }
206 else
207 {
208 my $mess = "Error: unable to make symbolic link to source:";
209 $mess .= " $input_dir";
210 communicate_single_line($full_tmpname,$mess);
211 close(LOGOUT);
212 return "failure";
213 }
214 }
215
216 if ($do_import eq "true")
217 {
218 # Import operation
219 my $import_cmd = "import.pl -removeold $dirname";
220
221 if(!open(IMPORTOUT,"$import_cmd 2>&1 |"))
222 {
223 my $mess = "Error: Unable to open pipe to command '$import_cmd'";
224 communicate_single_line($full_tmpname,$mess);
225 close(LOGOUT);
226 return "failure";
227 }
228 while (defined($line=<IMPORTOUT>))
229 {
230 print LOGOUT $line;
231 chop $line;
232 if ($line =~ m/^Error:/)
233 {
234 communicate_single_line($full_tmpname,"$line");
235 close(IMPORTOUT);
236 close(LOGOUT);
237 return "failure";
238 }
239 communicate_single_line($full_tmpname,"Caching data ...<br>$line");
240 }
241
242 close(IMPORTOUT);
243 }
244
245 if ($do_build eq "true")
246 {
247 # Build operation
248 my $build_cmd = "";
249 if ($do_import eq "true")
250 {
251 $build_cmd = "buildcol.pl $dirname";
252 }
253 else
254 {
255 my $full_archivename = &util::filename_cat($full_dirname,"archives");
256
257 $build_cmd = "buildcol.pl";
258 $build_cmd .= " -archivedir $full_importname";
259 $build_cmd .= " -cachedir $full_archivename";
260 $build_cmd .= " $dirname";
261 }
262
263 if(!open(BUILDOUT,"$build_cmd 2>&1 |"))
264 {
265 my $mess = "Error: Unable to open pipe to command '$build_cmd'";
266 communicate_single_line($full_tmpname,$mess);
267 close(LOGOUT);
268 return "failure";
269 }
270 while (defined($line=<BUILDOUT>))
271 {
272 print LOGOUT $line;
273 chop $line;
274 if ($line =~ m/^Error:/)
275 {
276 communicate_single_line($full_tmpname,"$line");
277 close(BUILDOUT);
278 close(LOGOUT);
279 return "failure";
280 }
281 communicate_single_line($full_tmpname,"Creating indexes ...<br>$line");
282 }
283
284 close(BUILDOUT);
285
286 # Make collection live
287 #--
288 # rm index
289 my $full_indexname = &util::filename_cat($full_dirname,"index");
290 &util::rm_r($full_indexname);
291
292 # move building
293 my $full_buildingname = &util::filename_cat($full_dirname,"building");
294 &util::mv($full_buildingname,$full_indexname);
295
296 my $full_imagesrc = &util::filename_cat($full_dirname,"building_images","imgsrc");
297 if (-e $full_imagesrc)
298 {
299 my $full_imagedst = &util::filename_cat($full_dirname,"index","imgsrc");
300 &util::soft_link($full_imagesrc,$full_imagedst);
301 }
302
303 # Recreate 'building' directory ready for next build
304 &util::mk_dir($full_buildingname);
305 }
306
307 communicate_single_line($full_tmpname,"Done");
308 close(LOGOUT);
309 return "success";
310}
311
312
313sub main
314{
315 # get arguments
316 my $dirname = $args->{'bc1dirname'};
317 if (!defined($dirname))
318 {
319 my $mess = "Directory name for collection missing.";
320 print STDERR "$mess\n";
321 return;
322 }
323
324 my $tmpname = $args->{'bc1tmpname'};
325 if (!defined($tmpname))
326 {
327 my $mess = "Temporary name for building communication missing.";
328 print STDERR "$mess\n";
329 return;
330 }
331
332 my $full_tmpname
333 = &util::filename_cat($ENV{'GSDLHOME'},"tmp",$tmpname);
334
335 communicate_single_line($full_tmpname,"Preparing to build.");
336
337 # Put lock on config file before any building is done as safe
338 # guard against any concurrent operations on this collection.
339 #--
340
341 my $full_dirname
342 = &util::filename_cat($ENV{'GSDLHOME'},"collect",$dirname);
343 my $cfg_filename
344 = &util::filename_cat($full_dirname,"etc","collect.cfg");
345
346 if (open(CFGIN,"<$cfg_filename"))
347 {
348 if (flock(CFGIN,LOCK_EX))
349 {
350 # do requested stages for building
351 my $result = do_build($full_dirname,$dirname,$args);
352 flock(CFGIN,LOCK_UN);
353 close(CFGIN);
354 return if ($result ne "success");
355 }
356 else
357 {
358 # Problem locking file
359 my $mess = "Unable to lock configuration file: $cfg_filename";
360 print STDERR "$mess\n";
361 return;
362 }
363 }
364
365# my $mess_url = "$args->{'httpbuild'}&bca=mess&bc1dirname=$dirname";
366# print "Location: $mess_url&head=_headdone_&mess=_messdonebuildcol_\n\n";
367# print "done\n"; # in tmp file
368}
369
370&main();
371
372
373
374
375
Note: See TracBrowser for help on using the repository browser.