source: tags/gsdl-2_70-distribution-branch-merged/gsdl/bin/script/exportcol.pl@ 11818

Last change on this file since 11818 was 11818, checked in by (none), 18 years ago

This commit was manufactured by cvs2svn to create tag
'gsdl-2_70-distribution-branch-merged'.
  • Property svn:keywords set to Author Date Id Revision
File size: 12.1 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' => "cdname",
52 'desc' => "{exportcol.cdname}",
53 'type' => "string",
54 'deft' => "Greenstone Collections",
55 'reqd' => "no" },
56 { 'name' => "cddir",
57 'desc' => "{exportcol.cddir}",
58 'type' => "string",
59 'deft' => "exported_collections",
60 'reqd' => "no" },
61 { 'name' => "xml",
62 'desc' => "{scripts.xml}",
63 'type' => "flag",
64 'reqd' => "no",
65 'hiddengli' => "yes" },
66 { 'name' => "gli",
67 'desc' => "",
68 'type' => "flag",
69 'reqd' => "no",
70 'hiddengli' => "yes" },
71
72 ];
73
74my $options = { 'name' => "exportcol.pl",
75 'desc' => "{exportcol.desc}",
76 'args' => $arguments };
77
78sub gsprintf
79{
80 return &gsprintf::gsprintf(@_);
81}
82
83
84&main();
85
86sub main {
87 my ($language, $out, $cdname, $cddir, $gli);
88
89 my $xml = 0;
90
91 my $hashParsingResult = {};
92 my $blnParseFailed = "false";
93 # parse options
94 my $intArgLeftinAfterParsing = parse2::parse(\@ARGV,$arguments,$hashParsingResult,"allow_extra_options");
95 # don't care how many args are left - can have multiple collection names
96 foreach my $strVariable (keys %$hashParsingResult)
97 {
98 eval "\$$strVariable = \$hashParsingResult->{\"\$strVariable\"}";
99 }
100
101 # If $language has been specified, load the appropriate resource bundle
102 # (Otherwise, the default resource bundle will be loaded automatically)
103 if ($language && $language =~ /\S/) {
104 &gsprintf::load_language_specific_resource_bundle($language);
105 }
106
107 if ($xml) {
108 &PrintUsage::print_xml_usage($options);
109 print "\n";
110 return;
111 }
112
113 if ($gli) { # the gli wants strings to be in UTF-8
114 &gsprintf::output_strings_in_UTF8;
115 }
116
117 # If $language has been specified, load the appropriate resource bundle
118 # (Otherwise, the default resource bundle will be loaded automatically)
119 if ($language) {
120 &gsprintf::load_language_specific_resource_bundle($language);
121 }
122
123 if ($xml) {
124 &PrintUsage::print_xml_usage($options);
125 die "\n";
126 }
127
128 if ($gli) { # the gli wants strings to be in UTF-8
129 &gsprintf::output_strings_in_UTF8;
130 }
131
132 my @coll_list = @ARGV;
133
134 if (not @coll_list) { # empty list
135 &PrintUsage::print_txt_usage($options, "{exportcol.params}");
136 exit(1);
137 }
138
139 my $close_out = 0;
140 if ($out !~ /^(STDERR|STDOUT)$/i) {
141 open (OUT, ">$out") ||
142 (&gsprintf(STDERR, "{common.cannot_open_output_file}\n", $out) && die);
143 $out = 'main::OUT';
144 $close_out = 1;
145 }
146
147 # first we do a quick check to see if the export coll function has been
148 # installed
149 my $gssetupexe = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "gssetup.exe");
150 if (!-e $gssetupexe) {
151 &gsprintf($out, "{exportcol.fail} {exportcol.export_coll_not_installed}\n");
152 die "\n";
153 }
154
155 # check each collection
156 my @valid_coll_list = ();
157 foreach my $c (@coll_list) {
158 my $colldir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $c);
159 if (! -d $colldir) {
160 &gsprintf($out, "{exportcol.coll_not_found}\n", $c, $colldir);
161 next;
162 }
163 my $colindexdir = &util::filename_cat ($colldir, "index");
164 my $coletcdir = &util::filename_cat ($colldir, "etc");
165 if ((!-d $colindexdir) || (!-d $coletcdir)) {
166 &gsprintf($out, "{exportcol.coll_dirs_not_found}\n", $c);
167 &gsprintf($out, " $colindexdir\n");
168 &gsprintf($out, " $coletcdir\n");
169 next;
170 }
171 # the collection seems ok, we add it to the valid coll list
172 push @valid_coll_list, $c;
173 }
174
175 if (not @valid_coll_list) {
176 # no valid colls left
177 &gsprintf($out, "{exportcol.fail} {exportcol.no_valid_colls}\n");
178 die "\n";
179 }
180
181 # create exported directory
182 my $topdir = &util::filename_cat ($ENV{'GSDLHOME'}, "tmp", $cddir);
183 &util::mk_all_dir ($topdir);
184 if (!-d $topdir) {
185 &gsprintf($out, "{exportcol.fail} {exportcol.couldnt_create_dir}\n", $topdir);
186 die "\n";
187 }
188
189 # make other directories (we'll assume that if we created topdir
190 # successfully there'll be no problems creating these)
191 my $gsdldir = &util::filename_cat ($topdir, "gsdl");
192 &util::mk_all_dir ($gsdldir);
193 my $collectdir = &util::filename_cat ($gsdldir, "collect");
194 &util::mk_all_dir ($collectdir);
195 my $etcdir = &util::filename_cat ($gsdldir, "etc");
196 &util::mk_all_dir ($etcdir);
197 my $binjavadir = &util::filename_cat ($gsdldir, "bin", "java");
198 &util::mk_all_dir ($binjavadir);
199
200 # create the install.cfg file
201 my $installcfg = &util::filename_cat ($topdir, "install.cfg");
202 if (!open (INSTALLCFG, ">$installcfg")) {
203 &gsprintf($out, "{exportcol.fail} {exportcol.couldnt_create_file}\n", $installcfg);
204 die "\n";
205 }
206 print INSTALLCFG "CompanyName:New Zealand Digital Library\n";
207 print INSTALLCFG "CollectionName:$cdname\n";
208 print INSTALLCFG "CollectionDirName:$cdname\n";
209 print INSTALLCFG "CollectionVersion:1.0\n";
210 print INSTALLCFG "CollectionVolume:1\n";
211 print INSTALLCFG "ProgramGroupName:Greenstone\n";
212 close INSTALLCFG;
213
214 # create the manifest.cfg file
215 my $manifestcfg = &util::filename_cat ($topdir, "manifest.cfg");
216 if (!open (MANIFESTCFG, ">$manifestcfg")) {
217 &gsprintf($out, "{exportcol.fail} {exportcol.couldnt_create_file}\n", $manifestcfg);
218 die "\n";
219 }
220 print MANIFESTCFG "all:\n";
221 print MANIFESTCFG " {library} {collection}\n\n";
222 print MANIFESTCFG "library:\n";
223 print MANIFESTCFG " net32 net16 server.exe\n\n";
224 print MANIFESTCFG "database:\n";
225 print MANIFESTCFG ' etc ';
226 foreach my $c (@valid_coll_list) {
227 print MANIFESTCFG "collect\\$c\\index\\text\\$c.ldb ";
228 }
229 print MANIFESTCFG "\n\n";
230 print MANIFESTCFG "collection:\n";
231 print MANIFESTCFG " collect etc images macros mappings bin\n";
232 close MANIFESTCFG;
233
234 #create the autorun.inf file
235 my $autoruninf = &util::filename_cat ($topdir, "Autorun.inf");
236 if (!open (AUTORUNINF, ">$autoruninf")) {
237 &gsprintf($out, "{exportcol.fail} {exportcol.couldnt_create_file}\n", $autoruninf);
238 die "\n";
239 }
240
241 print AUTORUNINF "[autorun]\n";
242 print AUTORUNINF "OPEN=Setup.exe\n";
243 close AUTORUNINF;
244
245 # copy the necessary stuff from GSDLHOME
246 my $imagesdir = &util::filename_cat ($ENV{'GSDLHOME'}, "images");
247 my $macrosdir = &util::filename_cat ($ENV{'GSDLHOME'}, "macros");
248 my $mappingsdir = &util::filename_cat ($ENV{'GSDLHOME'}, "mappings");
249 my $maincfg = &util::filename_cat ($ENV{'GSDLHOME'}, "etc", "main.cfg");
250 my $serverexe = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "server.exe");
251 #my $gssetupexe = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "gssetup.exe"); - have checked this earlier
252 my $setupexe = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "Setup.exe");
253 my $net32dir = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "net32");
254 my $net16dir = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "net16");
255 my $win32sdir = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "windows", "Win32s");
256 my $phindjar = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "java", "Phind.jar");
257 my $gsdlcollageappletjar = &util::filename_cat ($ENV{'GSDLHOME'}, "bin", "java", "GsdlCollageApplet.jar");
258
259 if ((!-d $imagesdir) || (!-d $macrosdir) || (!-d $mappingsdir) || (!-e $maincfg) ||
260 (!-e $serverexe) || (!-e $gssetupexe) || (!-e $setupexe) || (!-d $net32dir) ||
261 (!-d $net16dir) || (!-d $win32sdir) || (!-e $phindjar) ||
262 (!-e $gsdlcollageappletjar)) {
263 &gsprintf($out, "{exportcol.fail} {exportcol.non_exist_files}\n");
264 &gsprintf($out, " $imagesdir\n");
265 &gsprintf($out, " $macrosdir\n");
266 &gsprintf($out, " $mappingsdir\n");
267 &gsprintf($out, " $maincfg\n");
268 &gsprintf($out, " $serverexe\n");
269 &gsprintf($out, " $gssetupexe\n");
270 &gsprintf($out, " $setupexe\n");
271 &gsprintf($out, " $net32dir\n");
272 &gsprintf($out, " $net16dir\n");
273 &gsprintf($out, " $win32sdir\n");
274 &gsprintf($out, " $phindjar\n");
275 &gsprintf($out, " $gsdlcollageappletjar\n");
276 die "\n";
277 }
278
279 &util::cp_r ($imagesdir, $gsdldir);
280 &util::cp_r ($macrosdir, $gsdldir);
281 &util::cp_r ($mappingsdir, $gsdldir);
282 &util::cp ($maincfg, $etcdir);
283 &util::cp ($serverexe, $gsdldir);
284 &util::cp ($gssetupexe, $topdir);
285 &util::cp ($setupexe, $topdir);
286 &util::cp_r ($net32dir, $gsdldir);
287 &util::cp_r ($net16dir, $gsdldir);
288 &util::cp_r ($win32sdir, $topdir);
289 &util::cp ($phindjar, $binjavadir);
290 &util::cp ($gsdlcollageappletjar, $binjavadir);
291
292 # now change the home.dm macro file to a simple version
293 my $newmacrodir = &util::filename_cat ($gsdldir, "macros");
294 my $exporthome = &util::filename_cat ($newmacrodir, "exported_home.dm");
295 my $oldhome = &util::filename_cat ($newmacrodir, "home.dm");
296 if (-e $exporthome) {
297 &util::rm($oldhome);
298 &util::mv($exporthome, $oldhome);
299 }
300
301 # copy the collections over
302 foreach my $c (@valid_coll_list) {
303 #old directories
304 my $colldir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $c);
305 my $colindexdir = &util::filename_cat ($colldir, "index");
306 my $coletcdir = &util::filename_cat ($colldir, "etc");
307 my $colimagesdir = &util::filename_cat ($colldir, "images");
308 my $colmacrosdir = &util::filename_cat ($colldir, "macros");
309 # new coll directory
310 my $newcoldir = &util::filename_cat ($collectdir, $c);
311
312 &util::mk_all_dir ($newcoldir);
313 &util::cp_r ($colindexdir, $newcoldir);
314 &util::cp_r ($coletcdir, $newcoldir);
315 &util::cp_r ($colimagesdir, $newcoldir) if (-e $colimagesdir);
316 &util::cp_r ($colmacrosdir, $newcoldir) if (-e $colmacrosdir);
317
318 # now we need to check the collect.cfg file to make sure it's public
319 my $collectcfg = &util::filename_cat ($newcoldir, "etc", "collect.cfg");
320 open INFILE, "<$collectcfg";
321 open OUTFILE, ">$collectcfg.tmp";
322 my $line;
323 while ($line = <INFILE>) {
324 if ($line =~ /^\s*public\s+false/) {
325 print OUTFILE "public\ttrue\n";
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("$collectcfg.tmp", $collectcfg);
338 }
339 &gsprintf($out, "{exportcol.success}");
340
341 my $successcolls = "";
342 my $first = 1;
343 foreach my $c (@valid_coll_list) {
344 if ($first) {
345 $first=0;
346 } else {
347 $successcolls .=", ";
348 }
349 $successcolls .= "$c";
350 }
351
352 my $gsdl_home = $ENV{'GSDLHOME'};
353 my $portable_topdir = $topdir;
354 # Disabled this because it isn't currently useful (the GLI applet doesn't do exporting)
355 # It doesn't work on Windows, either
356 # $portable_topdir =~ s/$gsdl_home/\$GSDLHOME/g;
357
358 &gsprintf($out, "{exportcol.output_dir}\n", $successcolls, $portable_topdir);
359 &gsprintf($out, "exportcol.pl succeeded:{exportcol.instructions}\n");
360 close OUT if $close_out;
361}
362
Note: See TracBrowser for help on using the repository browser.