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

Last change on this file since 27758 was 27758, checked in by ak19, 11 years ago

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