root/gsdl/trunk/bin/script/exportcol.pl @ 19791

Revision 19791, 11.7 KB (checked in by kjdon, 10 years ago)

more changes to do with images moved into web. Now just copy over whole web dir, don't need to do anything with images dir, and don't need to handle Phind.jar and GsdlCollageApplet?.jar individually as they are just included in web

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