source: main/trunk/greenstone2/bin/script/exportcol.pl@ 26441

Last change on this file since 26441 was 25185, checked in by ak19, 12 years ago

Committing trial fix from a month ago that worked for a GS mailing list member: Setup.exe was an old Windows binary used when running GS off a CDROM. Since this does not work on Win 7 64-bit (registration fails), this is no longer called in the Autorun.inf file. gssetup.exe is called directly instead, instead of getting called by Setup.exe.
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 12.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 [
43 { 'name' => "cdname",
44 'desc' => "{exportcol.cdname}",
45 'type' => "string",
46 'deft' => "Greenstone Collections",
47 'reqd' => "no" },
48 { 'name' => "cddir",
49 'desc' => "{exportcol.cddir}",
50 'type' => "string",
51 'deft' => "exported_collections",
52 'reqd' => "no" },
53 { 'name' => "collectdir",
54 'desc' => "{exportcol.collectdir}",
55 'type' => "string",
56 # parsearg left "" as default
57 #'deft' => &util::filename_cat ($ENV{'GSDLHOME'}, "collect"),
58 'deft' => "",
59 'reqd' => "no",
60 'hiddengli' => "yes" },
61 { 'name' => "noinstall",
62 'desc' => "{exportcol.noinstall}",
63 'type' => "flag",
64 'reqd' => "no" },
65 { 'name' => "language",
66 'desc' => "{scripts.language}",
67 'type' => "string",
68 'reqd' => "no" },
69 { 'name' => "out",
70 'desc' => "{exportcol.out}",
71 'type' => "string",
72 'deft' => "STDERR",
73 'reqd' => "no" },
74 { 'name' => "xml",
75 'desc' => "{scripts.xml}",
76 'type' => "flag",
77 'reqd' => "no",
78 'hiddengli' => "yes" },
79 { 'name' => "gli",
80 'desc' => "",
81 'type' => "flag",
82 'reqd' => "no",
83 'hiddengli' => "yes" },
84
85 ];
86
87my $options = { 'name' => "exportcol.pl",
88 'desc' => "{exportcol.desc}",
89 'args' => $arguments };
90
91sub gsprintf
92{
93 return &gsprintf::gsprintf(@_);
94}
95
96
97&main();
98
99sub main {
100 my ($language, $out, $cdname, $cddir);
101
102 my $noinstall = 0;
103 my $xml = 0;
104 my $gli = 0;
105 # the default/fallback for collect directory if none is provided
106 # (no -collectdir option given) is the standard Greenstone collect directory
107 my $collectdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect");
108
109 my $hashParsingResult = {};
110
111 # parse options
112 my $intArgLeftinAfterParsing = parse2::parse(\@ARGV,$arguments,$hashParsingResult,"allow_extra_options");
113
114 # If parse returns -1 then something has gone wrong
115 if ($intArgLeftinAfterParsing == -1)
116 {
117 &PrintUsage::print_txt_usage($options, "{exportcol.params}");
118 die "\n";
119 }
120
121 foreach my $strVariable (keys %$hashParsingResult)
122 {
123 eval "\$$strVariable = \$hashParsingResult->{\"\$strVariable\"}";
124 }
125
126 # If $language has been specified, load the appropriate resource bundle
127 # (Otherwise, the default resource bundle will be loaded automatically)
128 if ($language && $language =~ /\S/) {
129 &gsprintf::load_language_specific_resource_bundle($language);
130 }
131
132 if ($xml) {
133 &PrintUsage::print_xml_usage($options);
134 print "\n";
135 return;
136 }
137
138 if ($gli) { # the gli wants strings to be in UTF-8
139 &gsprintf::output_strings_in_UTF8;
140 }
141
142 # var collectdir (dir from where selected collections are exported to the CD)
143 # may have been set at this point if it was specified with -collectdir
144
145 # can have more than one collection name,
146 # if the first extra option is -h, then output the help
147 if (scalar(@ARGV) == 0 || (@ARGV && $ARGV[0] =~ /^\-+h/)) {
148 &PrintUsage::print_txt_usage($options, "{exportcol.params}");
149 die "\n";
150 }
151
152 my @coll_list = @ARGV;
153
154 my $close_out = 0;
155 if ($out !~ /^(STDERR|STDOUT)$/i) {
156 open (OUT, ">$out") ||
157 (&gsprintf(STDERR, "{common.cannot_open_output_file}\n", $out) && die);
158 $out = 'main::OUT';
159 $close_out = 1;
160 }
161
162 # first we do a quick check to see if the export coll function has been
163 # installed
164 my $gssetupexe = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "gssetup.exe");
165 if (!-e $gssetupexe) {
166 &gsprintf($out, "{exportcol.fail} {exportcol.export_coll_not_installed}\n");
167 die "\n";
168 }
169
170 # check each collection
171 my @valid_coll_list = ();
172 foreach my $c (@coll_list) {
173 my $colldir = &util::filename_cat ($collectdir, $c);
174 if (! -d $colldir) {
175 &gsprintf($out, "{exportcol.coll_not_found}\n", $c, $colldir);
176 next;
177 }
178 my $colindexdir = &util::filename_cat ($colldir, "index");
179 my $coletcdir = &util::filename_cat ($colldir, "etc");
180 if ((!-d $colindexdir) || (!-d $coletcdir)) {
181 &gsprintf($out, "{exportcol.coll_dirs_not_found}\n", $c);
182 &gsprintf($out, " $colindexdir\n");
183 &gsprintf($out, " $coletcdir\n");
184 next;
185 }
186 # the collection seems ok, we add it to the valid coll list
187 push @valid_coll_list, $c;
188 }
189
190 if (not @valid_coll_list) {
191 # no valid colls left
192 &gsprintf($out, "{exportcol.fail} {exportcol.no_valid_colls}\n");
193 die "\n";
194 }
195
196 # create exported directory
197 my $topdir = &util::filename_cat ($ENV{'GSDLHOME'}, "tmp", $cddir);
198 &util::mk_all_dir ($topdir);
199 if (!-d $topdir) {
200 &gsprintf($out, "{exportcol.fail} {exportcol.couldnt_create_dir}\n", $topdir);
201 die "\n";
202 }
203
204 # we create either a self installing cd, or one that runs off the cd (and
205 # doesn't install anything
206
207 # create all the directories - we assume that if we created the top dir ok,
208 # then all the other mkdirs will go ok
209 my $gsdldir;
210 if ($noinstall) {
211 $gsdldir = $topdir;
212 }
213 else {
214 $gsdldir = &util::filename_cat ($topdir, "gsdl");
215 &util::mk_all_dir ($gsdldir);
216 }
217
218 my $newcollectdir = &util::filename_cat ($gsdldir, "collect");
219 &util::mk_all_dir ($newcollectdir);
220 my $etcdir = &util::filename_cat ($gsdldir, "etc");
221 &util::mk_all_dir ($etcdir);
222
223 #create the config files
224 if (!$noinstall) {
225 # create the install.cfg file
226 my $installcfg = &util::filename_cat ($topdir, "install.cfg");
227 if (!open (INSTALLCFG, ">$installcfg")) {
228 &gsprintf($out, "{exportcol.fail} {exportcol.couldnt_create_file}\n", $installcfg);
229 die "\n";
230 }
231 print INSTALLCFG "CompanyName:New Zealand Digital Library\n";
232 print INSTALLCFG "CollectionName:$cdname\n";
233 print INSTALLCFG "CollectionDirName:$cdname\n";
234 print INSTALLCFG "CollectionVersion:1.0\n";
235 print INSTALLCFG "CollectionVolume:1\n";
236 print INSTALLCFG "ProgramGroupName:Greenstone\n";
237 close INSTALLCFG;
238
239 # create the manifest.cfg file
240 my $manifestcfg = &util::filename_cat ($topdir, "manifest.cfg");
241 if (!open (MANIFESTCFG, ">$manifestcfg")) {
242 &gsprintf($out, "{exportcol.fail} {exportcol.couldnt_create_file}\n", $manifestcfg);
243 die "\n";
244 }
245 print MANIFESTCFG "all:\n";
246 print MANIFESTCFG " {library} {collection}\n\n";
247 print MANIFESTCFG "library:\n";
248 print MANIFESTCFG " server.exe\n\n";
249 print MANIFESTCFG "database:\n";
250 print MANIFESTCFG ' etc ';
251 foreach my $c (@valid_coll_list) {
252 print MANIFESTCFG "collect\\$c\\index\\text\\$c.gdb ";
253 }
254 print MANIFESTCFG "\n\n";
255 print MANIFESTCFG "collection:\n";
256 print MANIFESTCFG " collect etc macros mappings web\n";
257 close MANIFESTCFG;
258
259 }
260
261 #create the autorun.inf file
262 my $autoruninf = &util::filename_cat ($topdir, "Autorun.inf");
263 if (!open (AUTORUNINF, ">$autoruninf")) {
264 &gsprintf($out, "{exportcol.fail} {exportcol.couldnt_create_file}\n", $autoruninf);
265 die "\n";
266 }
267
268 print AUTORUNINF "[autorun]\n";
269 if ($noinstall) {
270 print AUTORUNINF "OPEN=server.exe\n";
271 } else {
272 print AUTORUNINF "OPEN=gssetup.exe\n"; # no longer autorun Setup.exe, since it fails on Win 7 64 bit
273 }
274 close AUTORUNINF;
275
276 # copy the necessary stuff from GSDLHOME
277 my $webdir = &util::filename_cat ($ENV{'GSDLHOME'}, "web");
278 my $macrosdir = &util::filename_cat ($ENV{'GSDLHOME'}, "macros");
279 my $mappingsdir = &util::filename_cat ($ENV{'GSDLHOME'}, "mappings");
280 my $maincfg = &util::filename_cat ($ENV{'GSDLHOME'}, "etc", "main.cfg");
281 my $serverexe = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "server.exe");
282 my $setupexe = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "Setup.exe");
283
284 if ((!-d $webdir) || (!-d $macrosdir) || (!-d $mappingsdir) || (!-e $maincfg) ||
285 (!-e $serverexe) || (!-e $gssetupexe) || (!-e $setupexe)) {
286 &gsprintf($out, "{exportcol.fail} {exportcol.non_exist_files}\n");
287 &gsprintf($out, " $webdir\n");
288 &gsprintf($out, " $macrosdir\n");
289 &gsprintf($out, " $mappingsdir\n");
290 &gsprintf($out, " $maincfg\n");
291 &gsprintf($out, " $serverexe\n");
292 &gsprintf($out, " $gssetupexe\n");
293 &gsprintf($out, " $setupexe\n");
294 die "\n";
295 }
296
297 &util::cp_r_nosvn ($webdir, $gsdldir);
298 &util::cp_r_nosvn ($macrosdir, $gsdldir);
299 &util::cp_r_nosvn ($mappingsdir, $gsdldir);
300 &util::cp ($maincfg, $etcdir);
301 &util::cp ($serverexe, $gsdldir);
302
303 if (!$noinstall) {
304 &util::cp ($gssetupexe, $topdir);
305 &util::cp ($setupexe, $topdir); # unused, since Setup.exe does not work on Win 7 64-bit
306 }
307
308 # now change the home.dm macro file to a simple version
309 my $newmacrodir = &util::filename_cat ($gsdldir, "macros");
310 my $exporthome = &util::filename_cat ($newmacrodir, "exported_home.dm");
311 my $oldhome = &util::filename_cat ($newmacrodir, "home.dm");
312 if (-e $exporthome) {
313 &util::rm($oldhome);
314 &util::mv($exporthome, $oldhome);
315 }
316
317 # copy the collections over
318 foreach my $c (@valid_coll_list) {
319 #old directories
320 my $colldir = &util::filename_cat ($collectdir, $c);
321 my $colindexdir = &util::filename_cat ($colldir, "index");
322 my $coletcdir = &util::filename_cat ($colldir, "etc");
323 my $colmacrosdir = &util::filename_cat ($colldir, "macros");
324 my $colimagesdir = &util::filename_cat ($colldir, "images");
325 my $colscriptdir = &util::filename_cat ($colldir, "script");
326 my $coljavadir = &util::filename_cat ($colldir, "java");
327 my $colstyledir = &util::filename_cat ($colldir, "style");
328 my $colflashdir = &util::filename_cat ($colldir, "flash");
329
330 # new collection directory
331 # $c might be in a group, for now, copy to the top level.
332 my $new_c = $c;
333 $new_c =~ s/^.*[\/\\]//; # remove any folder info
334 my $newcoldir = &util::filename_cat ($newcollectdir, $new_c);
335
336 &util::mk_all_dir ($newcoldir);
337 &util::cp_r_nosvn ($colindexdir, $newcoldir);
338 &util::rename_ldb_or_bdb_file(&util::filename_cat ($newcoldir, "index", "text", $c));
339 &util::cp_r_nosvn ($coletcdir, $newcoldir);
340 &util::cp_r_nosvn ($colmacrosdir, $newcoldir) if (-e $colmacrosdir);
341 &util::cp_r_nosvn ($colimagesdir, $newcoldir) if (-e $colimagesdir);
342 &util::cp_r_nosvn ($colscriptdir, $newcoldir) if (-e $colscriptdir);
343 &util::cp_r_nosvn ($coljavadir, $newcoldir) if (-e $coljavadir);
344 &util::cp_r_nosvn ($colstyledir, $newcoldir) if (-e $colstyledir);
345 &util::cp_r_nosvn ($colflashdir, $newcoldir) if (-e $colflashdir);
346
347 # now we need to check the collect.cfg file to make sure it's public
348 my $collectcfg = &util::filename_cat ($newcoldir, "etc", "collect.cfg");
349 open INFILE, "<$collectcfg";
350 open OUTFILE, ">$collectcfg.tmp";
351 my $line;
352 while ($line = <INFILE>) {
353 if ($line =~ /^\s*public\s+false/) {
354 print OUTFILE "public\ttrue\n";
355 last; # stop matching once we have found the line
356 } else {
357 print OUTFILE "$line";
358 }
359 }
360 # continue with no checking
361 while ($line = <INFILE>) {
362 print OUTFILE "$line";
363 }
364 close INFILE;
365 close OUTFILE;
366 &util::mv("$collectcfg.tmp", $collectcfg);
367 }
368 &gsprintf($out, "{exportcol.success}");
369
370 my $successcolls = "";
371 my $first = 1;
372 foreach my $c (@valid_coll_list) {
373 if ($first) {
374 $first=0;
375 } else {
376 $successcolls .=", ";
377 }
378 $successcolls .= "$c";
379 }
380
381 my $gsdl_home = $ENV{'GSDLHOME'};
382 my $portable_topdir = $topdir;
383 # Disabled this because it isn't currently useful (the GLI applet doesn't do exporting)
384 # It doesn't work on Windows, either
385 # $portable_topdir =~ s/$gsdl_home/\$GSDLHOME/g;
386
387 &gsprintf($out, "{exportcol.output_dir}\n", $successcolls, $portable_topdir);
388 &gsprintf($out, "exportcol.pl succeeded:{exportcol.instructions}\n");
389 close OUT if $close_out;
390}
391
Note: See TracBrowser for help on using the repository browser.