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

Last change on this file since 10339 was 10339, checked in by kjdon, 19 years ago

uses new parse2 arg parsing, added 'use strict'
  • Property svn:keywords set to Author Date Id Revision
File size: 12.5 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 # check each collection
163 my @valid_coll_list = ();
164 foreach my $c (@coll_list) {
165 my $colldir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $c);
166 if (! -d $colldir) {
167 &gsprintf($out, "{exportcol.coll_not_found}\n", $c, $colldir);
168 next;
169 }
170 my $colindexdir = &util::filename_cat ($colldir, "index");
171 my $coletcdir = &util::filename_cat ($colldir, "etc");
172 if ((!-d $colindexdir) || (!-d $coletcdir)) {
173 &gsprintf($out, "{exportcol.coll_dirs_not_found}\n", $c);
174 &gsprintf($out, " $colindexdir\n");
175 &gsprintf($out, " $coletcdir\n");
176 next;
177 }
178 # the collection seems ok, we add it to the valid coll list
179 push @valid_coll_list, $c;
180 }
181
182 if (not @valid_coll_list) {
183 # no valid colls left
184 &gsprintf($out, "{exportcol.fail} {exportcol.no_valid_colls}\n");
185 die "\n";
186 }
187
188 # create exported directory
189 my $topdir = &util::filename_cat ($ENV{'GSDLHOME'}, "tmp", $cddir);
190 &util::mk_all_dir ($topdir);
191 if (!-d $topdir) {
192 &gsprintf($out, "{exportcol.fail} {exportcol.couldnt_create_dir}\n", $topdir);
193 die "\n";
194 }
195
196 # make other directories (we'll assume that if we created topdir
197 # successfully there'll be no problems creating these)
198 my $gsdldir = &util::filename_cat ($topdir, "gsdl");
199 &util::mk_all_dir ($gsdldir);
200 my $collectdir = &util::filename_cat ($gsdldir, "collect");
201 &util::mk_all_dir ($collectdir);
202 my $etcdir = &util::filename_cat ($gsdldir, "etc");
203 &util::mk_all_dir ($etcdir);
204 my $binjavadir = &util::filename_cat ($gsdldir, "bin", "java");
205 &util::mk_all_dir ($binjavadir);
206
207 # create the install.cfg file
208 my $installcfg = &util::filename_cat ($topdir, "install.cfg");
209 if (!open (INSTALLCFG, ">$installcfg")) {
210 &gsprintf($out, "{exportcol.fail} {exportcol.couldnt_create_file}\n", $installcfg);
211 die "\n";
212 }
213 print INSTALLCFG "CompanyName:New Zealand Digital Library\n";
214 print INSTALLCFG "CollectionName:$cdname\n";
215 print INSTALLCFG "CollectionDirName:$cdname\n";
216 print INSTALLCFG "CollectionVersion:1.0\n";
217 print INSTALLCFG "CollectionVolume:1\n";
218 print INSTALLCFG "ProgramGroupName:Greenstone\n";
219 close INSTALLCFG;
220
221 # create the manifest.cfg file
222 my $manifestcfg = &util::filename_cat ($topdir, "manifest.cfg");
223 if (!open (MANIFESTCFG, ">$manifestcfg")) {
224 &gsprintf($out, "{exportcol.fail} {exportcol.couldnt_create_file}\n", $manifestcfg);
225 die "\n";
226 }
227 print MANIFESTCFG "all:\n";
228 print MANIFESTCFG " {library} {collection}\n\n";
229 print MANIFESTCFG "library:\n";
230 print MANIFESTCFG " net32 net16 server.exe\n\n";
231 print MANIFESTCFG "database:\n";
232 print MANIFESTCFG ' etc ';
233 foreach my $c (@valid_coll_list) {
234 print MANIFESTCFG "collect\\$c\\index\\text\\$c.ldb ";
235 }
236 print MANIFESTCFG "\n\n";
237 print MANIFESTCFG "collection:\n";
238 print MANIFESTCFG " collect etc images macros mappings bin\n";
239 close MANIFESTCFG;
240
241 #create the autorun.inf file
242 my $autoruninf = &util::filename_cat ($topdir, "Autorun.inf");
243 if (!open (AUTORUNINF, ">$autoruninf")) {
244 &gsprintf($out, "{exportcol.fail} {exportcol.couldnt_create_file}\n", $autoruninf);
245 die "\n";
246 }
247
248 print AUTORUNINF "[autorun]\n";
249 print AUTORUNINF "OPEN=Setup.exe\n";
250 close AUTORUNINF;
251
252 # copy the necessary stuff from GSDLHOME
253 my $imagesdir = &util::filename_cat ($ENV{'GSDLHOME'}, "images");
254 my $macrosdir = &util::filename_cat ($ENV{'GSDLHOME'}, "macros");
255 my $mappingsdir = &util::filename_cat ($ENV{'GSDLHOME'}, "mappings");
256 my $maincfg = &util::filename_cat ($ENV{'GSDLHOME'}, "etc", "main.cfg");
257 my $serverexe = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "server.exe");
258 #my $gssetupexe = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "gssetup.exe"); - have checked this earlier
259 my $setupexe = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "Setup.exe");
260 my $net32dir = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "net32");
261 my $net16dir = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "net16");
262 my $netscapedir = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "netscape");
263 my $win32sdir = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "Win32s");
264 my $phindjar = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "java", "Phind.jar");
265 my $gsdlcollageappletjar = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "java", "GsdlCollageApplet.jar");
266
267 if ((!-d $imagesdir) || (!-d $macrosdir) || (!-d $mappingsdir) || (!-e $maincfg) ||
268 (!-e $serverexe) || (!-e $gssetupexe) || (!-e $setupexe) || (!-d $net32dir) ||
269 (!-d $net16dir) || ($use_netscape && (!-d $netscapedir)) || (!-d $win32sdir) || (!-e $phindjar) ||
270 (!-e $gsdlcollageappletjar)) {
271 &gsprintf($out, "{exportcol.fail} {exportcol.non_exist_files}\n");
272 &gsprintf($out, " $imagesdir\n");
273 &gsprintf($out, " $macrosdir\n");
274 &gsprintf($out, " $mappingsdir\n");
275 &gsprintf($out, " $maincfg\n");
276 &gsprintf($out, " $serverexe\n");
277 &gsprintf($out, " $gssetupexe\n");
278 &gsprintf($out, " $setupexe\n");
279 &gsprintf($out, " $net32dir\n");
280 &gsprintf($out, " $net16dir\n");
281 &gsprintf($out, " $netscapedir\n") if ($use_netscape);
282 &gsprintf($out, " $win32sdir\n");
283 &gsprintf($out, " $phindjar\n");
284 &gsprintf($out, " $gsdlcollageappletjar\n");
285 die "\n";
286 }
287
288 &util::cp_r ($imagesdir, $gsdldir);
289 &util::cp_r ($macrosdir, $gsdldir);
290 &util::cp_r ($mappingsdir, $gsdldir);
291 &util::cp ($maincfg, $etcdir);
292 &util::cp ($serverexe, $gsdldir);
293 &util::cp ($gssetupexe, $topdir);
294 &util::cp ($setupexe, $topdir);
295 &util::cp_r ($net32dir, $gsdldir);
296 &util::cp_r ($net16dir, $gsdldir);
297 &util::cp_r ($netscapedir, $topdir) if ($use_netscape);
298 &util::cp_r ($win32sdir, $topdir);
299 &util::cp ($phindjar, $binjavadir);
300 &util::cp ($gsdlcollageappletjar, $binjavadir);
301
302 # now change the home.dm macro file to a simple version
303 my $newmacrodir = &util::filename_cat ($gsdldir, "macros");
304 my $exporthome = &util::filename_cat ($newmacrodir, "exported_home.dm");
305 my $oldhome = &util::filename_cat ($newmacrodir, "home.dm");
306 if (-e $exporthome) {
307 &util::rm($oldhome);
308 &util::mv($exporthome, $oldhome);
309 }
310
311 # copy the collections over
312 foreach my $c (@valid_coll_list) {
313 #old directories
314 my $colldir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $c);
315 my $colindexdir = &util::filename_cat ($colldir, "index");
316 my $coletcdir = &util::filename_cat ($colldir, "etc");
317 my $colimagesdir = &util::filename_cat ($colldir, "images");
318 my $colmacrosdir = &util::filename_cat ($colldir, "macros");
319 # new coll directory
320 my $newcoldir = &util::filename_cat ($collectdir, $c);
321
322 &util::mk_all_dir ($newcoldir);
323 &util::cp_r ($colindexdir, $newcoldir);
324 &util::cp_r ($coletcdir, $newcoldir);
325 &util::cp_r ($colimagesdir, $newcoldir) if (-e $colimagesdir);
326 &util::cp_r ($colmacrosdir, $newcoldir) if (-e $colmacrosdir);
327
328 # now we need to check the collect.cfg file to make sure it's public
329 my $collectcfg = &util::filename_cat ($newcoldir, "etc", "collect.cfg");
330 open INFILE, "<$collectcfg";
331 open OUTFILE, ">$collectcfg.tmp";
332 my $line;
333 while ($line = <INFILE>) {
334 if ($line =~ /^\s*public\s+false/) {
335 print OUTFILE "public\ttrue\n";
336 last; # stop matching once we have found the line
337 } else {
338 print OUTFILE "$line";
339 }
340 }
341 # continue with no checking
342 while ($line = <INFILE>) {
343 print OUTFILE "$line";
344 }
345 close INFILE;
346 close OUTFILE;
347 &util::mv("$collectcfg.tmp", $collectcfg);
348 }
349 &gsprintf($out, "{exportcol.success}");
350
351 my $successcolls = "";
352 my $first = 1;
353 foreach my $c (@valid_coll_list) {
354 if ($first) {
355 $first=0;
356 } else {
357 $successcolls .=", ";
358 }
359 $successcolls .= "$c";
360 }
361
362 my $gsdl_home = $ENV{'GSDLHOME'};
363 my $portable_topdir = $topdir;
364 # Disabled this because it isn't currently useful (the GLI applet doesn't do exporting)
365 # It doesn't work on Windows, either
366 # $portable_topdir =~ s/$gsdl_home/\$GSDLHOME/g;
367
368 &gsprintf($out, "{exportcol.output_dir}\n", $successcolls, $portable_topdir);
369 &gsprintf($out, "exportcol.pl succeeded:{exportcol.instructions}\n");
370 close OUT if $close_out;
371}
372
Note: See TracBrowser for help on using the repository browser.