source: trunk/gsdl/bin/script/exportcol.pl@ 11178

Last change on this file since 11178 was 11178, checked in by kjdon, 18 years ago

modifications to support bundling netscape, needs the language pack installed, and the nav_ns4 compatibility macros.
  • Property svn:keywords set to Author Date Id Revision
File size: 13.6 KB
Line 
1#!/usr/bin/perl -w
2
3###########################################################################
4#
5# exportcol.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
28BEGIN {
29 die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
30 unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
31}
32
33use strict;
34no strict 'refs'; # allow filehandles to be variables and vice versa
35no strict 'subs'; # allow barewords (eg STDERR) as function arguments
36
37use util;
38use parse2;
39use printusage;
40
41my $arguments =
42 [ { 'name' => "language",
43 'desc' => "{scripts.language}",
44 'type' => "string",
45 'reqd' => "no" },
46 { 'name' => "out",
47 'desc' => "{exportcol.out}",
48 'type' => "string",
49 'deft' => "STDERR",
50 'reqd' => "no" },
51 { 'name' => "nonetscape",
52 'desc' => "{exportcol.nonetscape}",
53 'type' => "flag",
54 'reqd' => "no" },
55 { 'name' => "cdname",
56 'desc' => "{exportcol.cdname}",
57 'type' => "string",
58 'deft' => "Greenstone Collections",
59 'reqd' => "no" },
60 { 'name' => "cddir",
61 'desc' => "{exportcol.cddir}",
62 'type' => "string",
63 'deft' => "exported_collections",
64 'reqd' => "no" },
65 { 'name' => "xml",
66 'desc' => "{scripts.xml}",
67 'type' => "flag",
68 'reqd' => "no",
69 'hiddengli' => "yes" },
70 { 'name' => "gli",
71 'desc' => "",
72 'type' => "flag",
73 'reqd' => "no",
74 'hiddengli' => "yes" },
75
76 ];
77
78my $options = { 'name' => "exportcol.pl",
79 'desc' => "{exportcol.desc}",
80 'args' => $arguments };
81
82sub gsprintf
83{
84 return &gsprintf::gsprintf(@_);
85}
86
87
88&main();
89
90sub main {
91 my ($language, $out, $cdname, $cddir, $gli);
92
93 my $xml = 0;
94 my $nonetscape = 0;
95
96 my $hashParsingResult = {};
97 my $blnParseFailed = "false";
98 # parse options
99 my $intArgLeftinAfterParsing = parse2::parse(\@ARGV,$arguments,$hashParsingResult,"allow_extra_options");
100 # don't care how many args are left - can have multiple collection names
101 foreach my $strVariable (keys %$hashParsingResult)
102 {
103 eval "\$$strVariable = \$hashParsingResult->{\"\$strVariable\"}";
104 }
105
106 # If $language has been specified, load the appropriate resource bundle
107 # (Otherwise, the default resource bundle will be loaded automatically)
108 if ($language && $language =~ /\S/) {
109 &gsprintf::load_language_specific_resource_bundle($language);
110 }
111
112 if ($xml) {
113 &PrintUsage::print_xml_usage($options);
114 print "\n";
115 return;
116 }
117
118 if ($gli) { # the gli wants strings to be in UTF-8
119 &gsprintf::output_strings_in_UTF8;
120 }
121
122 my $use_netscape = ($nonetscape) ? 0 : 1;
123
124 # If $language has been specified, load the appropriate resource bundle
125 # (Otherwise, the default resource bundle will be loaded automatically)
126 if ($language) {
127 &gsprintf::load_language_specific_resource_bundle($language);
128 }
129
130 if ($xml) {
131 &PrintUsage::print_xml_usage($options);
132 die "\n";
133 }
134
135 if ($gli) { # the gli wants strings to be in UTF-8
136 &gsprintf::output_strings_in_UTF8;
137 }
138
139 my @coll_list = @ARGV;
140
141 if (not @coll_list) { # empty list
142 &PrintUsage::print_txt_usage($options, "{exportcol.params}");
143 exit(1);
144 }
145
146 my $close_out = 0;
147 if ($out !~ /^(STDERR|STDOUT)$/i) {
148 open (OUT, ">$out") ||
149 (&gsprintf(STDERR, "{common.cannot_open_output_file}\n", $out) && die);
150 $out = 'main::OUT';
151 $close_out = 1;
152 }
153
154 # first we do a quick check to see if the export coll function has been
155 # installed
156 my $gssetupexe = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "gssetup.exe");
157 if (!-e $gssetupexe) {
158 &gsprintf($out, "{exportcol.fail} {exportcol.export_coll_not_installed}\n");
159 die "\n";
160 }
161
162 # if we want to use netscape, check that the lanugage pack has been installed. What's best to check? for now, use one of the english image files
163 if ($use_netscape) {
164 my $search_image = &util::filename_cat ($ENV{'GSDLHOME'}, "images", "en", "tsrchgr.gif");
165 if (!-e $search_image) {
166 &gsprintf($out, "{exportcol.fail} {exportcol.lang_pack_not_installed}\n");
167 die "\n";
168 }
169 }
170
171 # check each collection
172 my @valid_coll_list = ();
173 foreach my $c (@coll_list) {
174 my $colldir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $c);
175 if (! -d $colldir) {
176 &gsprintf($out, "{exportcol.coll_not_found}\n", $c, $colldir);
177 next;
178 }
179 my $colindexdir = &util::filename_cat ($colldir, "index");
180 my $coletcdir = &util::filename_cat ($colldir, "etc");
181 if ((!-d $colindexdir) || (!-d $coletcdir)) {
182 &gsprintf($out, "{exportcol.coll_dirs_not_found}\n", $c);
183 &gsprintf($out, " $colindexdir\n");
184 &gsprintf($out, " $coletcdir\n");
185 next;
186 }
187 # the collection seems ok, we add it to the valid coll list
188 push @valid_coll_list, $c;
189 }
190
191 if (not @valid_coll_list) {
192 # no valid colls left
193 &gsprintf($out, "{exportcol.fail} {exportcol.no_valid_colls}\n");
194 die "\n";
195 }
196
197 # create exported directory
198 my $topdir = &util::filename_cat ($ENV{'GSDLHOME'}, "tmp", $cddir);
199 &util::mk_all_dir ($topdir);
200 if (!-d $topdir) {
201 &gsprintf($out, "{exportcol.fail} {exportcol.couldnt_create_dir}\n", $topdir);
202 die "\n";
203 }
204
205 # make other directories (we'll assume that if we created topdir
206 # successfully there'll be no problems creating these)
207 my $gsdldir = &util::filename_cat ($topdir, "gsdl");
208 &util::mk_all_dir ($gsdldir);
209 my $collectdir = &util::filename_cat ($gsdldir, "collect");
210 &util::mk_all_dir ($collectdir);
211 my $etcdir = &util::filename_cat ($gsdldir, "etc");
212 &util::mk_all_dir ($etcdir);
213 my $binjavadir = &util::filename_cat ($gsdldir, "bin", "java");
214 &util::mk_all_dir ($binjavadir);
215
216 # create the install.cfg file
217 my $installcfg = &util::filename_cat ($topdir, "install.cfg");
218 if (!open (INSTALLCFG, ">$installcfg")) {
219 &gsprintf($out, "{exportcol.fail} {exportcol.couldnt_create_file}\n", $installcfg);
220 die "\n";
221 }
222 print INSTALLCFG "CompanyName:New Zealand Digital Library\n";
223 print INSTALLCFG "CollectionName:$cdname\n";
224 print INSTALLCFG "CollectionDirName:$cdname\n";
225 print INSTALLCFG "CollectionVersion:1.0\n";
226 print INSTALLCFG "CollectionVolume:1\n";
227 print INSTALLCFG "ProgramGroupName:Greenstone\n";
228 close INSTALLCFG;
229
230 # create the manifest.cfg file
231 my $manifestcfg = &util::filename_cat ($topdir, "manifest.cfg");
232 if (!open (MANIFESTCFG, ">$manifestcfg")) {
233 &gsprintf($out, "{exportcol.fail} {exportcol.couldnt_create_file}\n", $manifestcfg);
234 die "\n";
235 }
236 print MANIFESTCFG "all:\n";
237 print MANIFESTCFG " {library} {collection}\n\n";
238 print MANIFESTCFG "library:\n";
239 print MANIFESTCFG " net32 net16 server.exe\n\n";
240 print MANIFESTCFG "database:\n";
241 print MANIFESTCFG ' etc ';
242 foreach my $c (@valid_coll_list) {
243 print MANIFESTCFG "collect\\$c\\index\\text\\$c.ldb ";
244 }
245 print MANIFESTCFG "\n\n";
246 print MANIFESTCFG "collection:\n";
247 print MANIFESTCFG " collect etc images macros mappings bin\n";
248 close MANIFESTCFG;
249
250 #create the autorun.inf file
251 my $autoruninf = &util::filename_cat ($topdir, "Autorun.inf");
252 if (!open (AUTORUNINF, ">$autoruninf")) {
253 &gsprintf($out, "{exportcol.fail} {exportcol.couldnt_create_file}\n", $autoruninf);
254 die "\n";
255 }
256
257 print AUTORUNINF "[autorun]\n";
258 print AUTORUNINF "OPEN=Setup.exe\n";
259 close AUTORUNINF;
260
261 # copy the necessary stuff from GSDLHOME
262 my $imagesdir = &util::filename_cat ($ENV{'GSDLHOME'}, "images");
263 my $macrosdir = &util::filename_cat ($ENV{'GSDLHOME'}, "macros");
264 my $mappingsdir = &util::filename_cat ($ENV{'GSDLHOME'}, "mappings");
265 my $maincfg = &util::filename_cat ($ENV{'GSDLHOME'}, "etc", "main.cfg");
266 my $serverexe = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "server.exe");
267 #my $gssetupexe = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "gssetup.exe"); - have checked this earlier
268 my $setupexe = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "Setup.exe");
269 my $net32dir = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "net32");
270 my $net16dir = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "net16");
271 my $netscapedir = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "netscape");
272 my $win32sdir = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "Win32s");
273 my $phindjar = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "java", "Phind.jar");
274 my $gsdlcollageappletjar = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "java", "GsdlCollageApplet.jar");
275
276 if ((!-d $imagesdir) || (!-d $macrosdir) || (!-d $mappingsdir) || (!-e $maincfg) ||
277 (!-e $serverexe) || (!-e $gssetupexe) || (!-e $setupexe) || (!-d $net32dir) ||
278 (!-d $net16dir) || ($use_netscape && (!-d $netscapedir)) || (!-d $win32sdir) || (!-e $phindjar) ||
279 (!-e $gsdlcollageappletjar)) {
280 &gsprintf($out, "{exportcol.fail} {exportcol.non_exist_files}\n");
281 &gsprintf($out, " $imagesdir\n");
282 &gsprintf($out, " $macrosdir\n");
283 &gsprintf($out, " $mappingsdir\n");
284 &gsprintf($out, " $maincfg\n");
285 &gsprintf($out, " $serverexe\n");
286 &gsprintf($out, " $gssetupexe\n");
287 &gsprintf($out, " $setupexe\n");
288 &gsprintf($out, " $net32dir\n");
289 &gsprintf($out, " $net16dir\n");
290 &gsprintf($out, " $netscapedir\n") if ($use_netscape);
291 &gsprintf($out, " $win32sdir\n");
292 &gsprintf($out, " $phindjar\n");
293 &gsprintf($out, " $gsdlcollageappletjar\n");
294 die "\n";
295 }
296
297 # images. If not using netscape, copy only the top level, not any subdirs
298 if ($use_netscape) {
299 &util::cp_r ($imagesdir, $gsdldir);
300 } else {
301 &util::cp_r_toplevel ($imagesdir, $gsdldir);
302 }
303 &util::cp_r ($macrosdir, $gsdldir);
304 &util::cp_r ($mappingsdir, $gsdldir);
305 &util::cp ($maincfg, $etcdir);
306 &util::cp ($serverexe, $gsdldir);
307 &util::cp ($gssetupexe, $topdir);
308 &util::cp ($setupexe, $topdir);
309 &util::cp_r ($net32dir, $gsdldir);
310 &util::cp_r ($net16dir, $gsdldir);
311 &util::cp_r ($netscapedir, $topdir) if ($use_netscape);
312 &util::cp_r ($win32sdir, $topdir);
313 &util::cp ($phindjar, $binjavadir);
314 &util::cp ($gsdlcollageappletjar, $binjavadir);
315
316
317 # if we have netscape 4 bundled, then switch to ns4 compat macro file
318 if ($use_netscape) {
319 my $main_cfg_file = &util::filename_cat($etcdir, "main.cfg");
320 open INFILE, "<$main_cfg_file";
321 open OUTFILE, ">$main_cfg_file.tmp";
322 my $line;
323 while ($line = <INFILE>) {
324 if ($line =~ s/nav_css\.dm/nav_ns4\.dm/) {
325 print OUTFILE $line;
326 last; # stop matching once we have found the line
327 } else {
328 print OUTFILE "$line";
329 }
330 }
331 # continue with no checking
332 while ($line = <INFILE>) {
333 print OUTFILE "$line";
334 }
335 close INFILE;
336 close OUTFILE;
337 &util::mv("$main_cfg_file.tmp", $main_cfg_file);
338 }
339
340 # now change the home.dm macro file to a simple version
341 my $newmacrodir = &util::filename_cat ($gsdldir, "macros");
342 my $exporthome = &util::filename_cat ($newmacrodir, "exported_home.dm");
343 my $oldhome = &util::filename_cat ($newmacrodir, "home.dm");
344 if (-e $exporthome) {
345 &util::rm($oldhome);
346 &util::mv($exporthome, $oldhome);
347 }
348
349 # copy the collections over
350 foreach my $c (@valid_coll_list) {
351 #old directories
352 my $colldir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $c);
353 my $colindexdir = &util::filename_cat ($colldir, "index");
354 my $coletcdir = &util::filename_cat ($colldir, "etc");
355 my $colimagesdir = &util::filename_cat ($colldir, "images");
356 my $colmacrosdir = &util::filename_cat ($colldir, "macros");
357 # new coll directory
358 my $newcoldir = &util::filename_cat ($collectdir, $c);
359
360 &util::mk_all_dir ($newcoldir);
361 &util::cp_r ($colindexdir, $newcoldir);
362 &util::cp_r ($coletcdir, $newcoldir);
363 &util::cp_r ($colimagesdir, $newcoldir) if (-e $colimagesdir);
364 &util::cp_r ($colmacrosdir, $newcoldir) if (-e $colmacrosdir);
365
366 # now we need to check the collect.cfg file to make sure it's public
367 my $collectcfg = &util::filename_cat ($newcoldir, "etc", "collect.cfg");
368 open INFILE, "<$collectcfg";
369 open OUTFILE, ">$collectcfg.tmp";
370 my $line;
371 while ($line = <INFILE>) {
372 if ($line =~ /^\s*public\s+false/) {
373 print OUTFILE "public\ttrue\n";
374 last; # stop matching once we have found the line
375 } else {
376 print OUTFILE "$line";
377 }
378 }
379 # continue with no checking
380 while ($line = <INFILE>) {
381 print OUTFILE "$line";
382 }
383 close INFILE;
384 close OUTFILE;
385 &util::mv("$collectcfg.tmp", $collectcfg);
386 }
387 &gsprintf($out, "{exportcol.success}");
388
389 my $successcolls = "";
390 my $first = 1;
391 foreach my $c (@valid_coll_list) {
392 if ($first) {
393 $first=0;
394 } else {
395 $successcolls .=", ";
396 }
397 $successcolls .= "$c";
398 }
399
400 my $gsdl_home = $ENV{'GSDLHOME'};
401 my $portable_topdir = $topdir;
402 # Disabled this because it isn't currently useful (the GLI applet doesn't do exporting)
403 # It doesn't work on Windows, either
404 # $portable_topdir =~ s/$gsdl_home/\$GSDLHOME/g;
405
406 &gsprintf($out, "{exportcol.output_dir}\n", $successcolls, $portable_topdir);
407 &gsprintf($out, "exportcol.pl succeeded:{exportcol.instructions}\n");
408 close OUT if $close_out;
409}
410
Note: See TracBrowser for help on using the repository browser.