root/gsdl/trunk/bin/script/mkcol.pl @ 18418

Revision 18418, 11.8 KB (checked in by kjdon, 11 years ago)

a few mods for gs3 mode. added site param so can use that instead of having to type in collectdir. don't copy macros folder for gs3mode. made a few param descriptions come from dictionary

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
Line 
1#!/usr/bin/perl -w
2
3###########################################################################
4#
5# mkcol.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
28
29# This program will setup a new collection from a model one. It does this by
30# copying the model, moving files to have the correct names, and replacing
31# text within the files to match the parameters.
32
33package mkcol;
34
35BEGIN {
36    die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
37    die "GSDLOS not set\n" unless defined $ENV{'GSDLOS'};
38    unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
39}
40
41use parse2;
42use util;
43use cfgread;
44use gsprintf 'gsprintf';
45use printusage;
46
47use strict;
48no strict 'subs'; # allow barewords (eg STDERR) as function arguments
49
50my $public_list =
51    [ { 'name' => "true",
52    'desc' => "{mkcol.public.true}"},
53      { 'name' => "false",
54    'desc' => "{mkcol.public.false}"}
55      ];
56
57my $win31compat_list =
58    [ { 'name' => "true",
59    'desc' => "{mkcol.win31compat.true}"},
60      { 'name' => "false",
61    'desc' => "{mkcol.win31compat.false}"}
62      ];
63
64my $arguments =
65    [ { 'name' => "creator",
66    'desc' => "{mkcol.creator}",
67    'type' => "string",
68    'reqd' => "no" },
69      { 'name' => "optionfile",
70    'desc' => "{mkcol.optionfile}",
71    'type' => "string",
72    'reqd' => "no" },
73      { 'name' => "maintainer",
74    'desc' => "{mkcol.maintainer}",
75    'type' => "string",
76    'reqd' => "no" },
77      { 'name' => "gs3mode",
78    'desc' => "{mkcol.gs3mode}",
79    'type' => "flag",
80    'reqd' => "no" },
81      { 'name' => "group",
82    'desc' => "{mkcol.group}",
83    'type' => "flag",
84    'reqd' => "no" },
85      { 'name' => "collectdir",
86    'desc' => "{mkcol.collectdir}",
87    'type' => "string",
88    'reqd' => "no" }, # For gs3, this collectdir must be provided.
89      { 'name' => "site",
90    'desc' => "{mkcol.site}",
91    'type' => "string",
92    'reqd' => "no" }, # For gs3, this collectdir must be provided.
93      { 'name' => "public",
94    'desc' => "{mkcol.public}",
95    'type' => "enum",
96    'deft' => "true",
97    'list' => $public_list,
98    'reqd' => "no" },
99      { 'name' => "title",
100    'desc' => "{mkcol.title}",
101    'type' => "string",
102    'reqd' => "no" },
103      { 'name' => "about",
104    'desc' => "{mkcol.about}",
105    'type' => "string",
106    'reqd' => "no" },
107      { 'name' => "plugin",
108    'desc' => "{mkcol.plugin}",
109    'type' => "string",
110    'reqd' => "no" },
111      { 'name' => "quiet",
112    'desc' => "{mkcol.quiet}",
113    'type' => "flag",
114    'reqd' => "no" },
115      { 'name' => "language",
116    'desc' => "{scripts.language}",
117    'type' => "string",
118    'reqd' => "no" },
119      { 'name' => "win31compat",
120    'desc' => "{mkcol.win31compat}",
121    'type' => "enum",
122    'deft' => "false",
123    'list' => $win31compat_list,
124    'reqd' => "no" },
125      { 'name' => "gli",
126    'desc' => "",
127    'type' => "flag",
128    'reqd' => "no",
129    'hiddengli' => "yes" },
130      { 'name' => "xml",
131    'desc' => "{scripts.xml}",
132    'type' => "flag",
133    'reqd' => "no",
134    'hiddengli' => "yes" }
135      ];
136
137my $options = { 'name' => "mkcol.pl",
138        'desc' => "{mkcol.desc}",
139        'args' => $arguments };
140
141# options
142my ($creator, $optionfile, $maintainer, $gs3mode, $group, $collectdir, $site,
143    $public,
144    $title, $about, $plugin, $quiet, $language, $win31compat, $gli);
145
146#other variables
147my ($collection, $capcollection,
148    $collection_tail, $capcollection_tail,
149    $pluginstring, @plugin);
150
151&main();
152
153
154sub traverse_dir
155{
156    my ($modeldir, $coldir, $gs3) = @_;
157    my ($newfile, @filetext);
158
159    if (!(-e $coldir)) {
160   
161
162    my $store_umask = umask(0002);
163    my $mkdir_ok = mkdir ($coldir, 0777);
164    umask($store_umask);
165
166    if (!$mkdir_ok)
167    {
168        die "$!";
169    }
170    }
171
172    opendir(DIR, $modeldir) ||
173    (&gsprintf(STDERR, "{common.cannot_read}\n", $modeldir) && die);
174    my @files = grep(!/^(\.\.?|CVS|\.svn)$/, readdir(DIR));
175    closedir(DIR);
176
177    foreach my $file (@files)
178    {
179    # don't want macros folder for gs3mode
180    next if ($gs3mode && $file =~ /^macros$/);
181    my $thisfile = &util::filename_cat ($modeldir, $file);
182
183    if (-d $thisfile) {
184        my $colfiledir = &util::filename_cat ($coldir, $file);
185        traverse_dir ($thisfile, $colfiledir, $gs3);
186
187    } else {
188
189        my $destfile = $file;
190        $destfile =~ s/^modelcol/$collection/;
191        $destfile =~ s/^MODELCOL/$capcollection/;
192
193        # There are three configuration files in modelcol directory:
194        # collect.cfg, group.cfg and collectionConfig.xml.
195        # If it is gs2, copy relevant collect.cfg or group.cfg file; if gs3, copy collectionConfig.xml.
196
197        if ($gs3) {
198        if ($group) {
199            &gsprintf(STDERR,"{common.group_not_valid_in_gs3}\n");
200        }
201        else {
202            next if ($file =~ m/(collect|group)\.cfg/);
203        }
204        }
205        else {
206        # Greenstone 2
207        if ($group) {
208            next if ($file =~ m/collect\.cfg/);
209
210            # If get to here: input file = group.cfg
211            # => want output file = collect.cfg
212            $destfile =~ s/group\.cfg/collect\.cfg/;
213        }
214        else {
215            next if ($file =~ m/group\.cfg/);
216        }
217
218        }
219
220
221        &gsprintf(STDOUT, "{mkcol.doing_replacements}\n", $destfile)
222        unless $quiet;
223        $destfile = &util::filename_cat ($coldir, $destfile);
224
225        open (INFILE, $thisfile) ||
226        (&gsprintf(STDERR, "{common.cannot_read_file}\n", $thisfile) && die);
227        open (OUTFILE, ">$destfile") ||
228        (&gsprintf(STDERR, "{common.cannot_create_file}\n", $destfile) && die);
229
230        while (defined (my $line = <INFILE>)) {
231        $line =~ s/\*\*collection\*\*/$collection_tail/g;
232        $line =~ s/\*\*COLLECTION\*\*/$capcollection_tail/g;
233        $line =~ s/\*\*creator\*\*/$creator/g;
234        $line =~ s/\*\*maintainer\*\*/$maintainer/g;
235        $line =~ s/\*\*public\*\*/$public/g;
236        $line =~ s/\*\*title\*\*/$title/g;
237        $line =~ s/\*\*about\*\*/$about/g;
238        if (!$gs3) {
239           $line =~ s/\*\*plugins\*\*/$pluginstring/g;
240         }
241
242        print OUTFILE $line;
243        }
244       
245        close (OUTFILE);
246        close (INFILE);
247    }
248    }
249}
250
251
252sub main {
253   
254    my $xml = 0;
255   
256
257    my $hashParsingResult = {};
258    my $intArgLeftinAfterParsing = parse2::parse(\@ARGV,$arguments,$hashParsingResult,"allow_extra_options");
259   
260    # If parse returns -1 then something has gone wrong
261    if ($intArgLeftinAfterParsing == -1)
262    {
263    &PrintUsage::print_txt_usage($options, "{mkcol.params}");
264    die "\n";
265    }
266   
267    foreach my $strVariable (keys %$hashParsingResult)
268    {
269    eval "\$$strVariable = \$hashParsingResult->{\"\$strVariable\"}";
270    }
271
272    # If $language has been specified, load the appropriate resource bundle
273    # (Otherwise, the default resource bundle will be loaded automatically)
274    if ($language && $language =~ /\S/) {
275    &gsprintf::load_language_specific_resource_bundle($language);
276    }
277
278    if ($xml) {
279    &PrintUsage::print_xml_usage($options);
280    print "\n";
281    return;
282    }
283
284    if ($gli) { # the gli wants strings to be in UTF-8
285    &gsprintf::output_strings_in_UTF8;
286    }
287
288    # now check that we had exactly one leftover arg, which should be
289    # the collection name. We don't want to do this earlier, cos
290    # -xml arg doesn't need a collection name
291    # Or if the user specified -h, then we output the usage also
292    if ($intArgLeftinAfterParsing != 1 || (@ARGV && $ARGV[0] =~ /^\-+h/))
293    {
294    &PrintUsage::print_txt_usage($options, "{mkcol.params}");
295    die "\n";
296    }
297
298    if ($optionfile =~ /\w/) {
299    open (OPTIONS, $optionfile) ||
300        (&gsprintf(STDERR, "{common.cannot_open}\n", $optionfile) && die);
301    my $line = [];
302    my $options = [];
303    while (defined ($line = &cfgread::read_cfg_line ('mkcol::OPTIONS'))) {
304        push (@$options, @$line);
305    }
306    close OPTIONS;
307    my $optionsParsingResult = {};
308    if (parse2::parse($options,$arguments,$optionsParsingResult) == -1) {
309        &PrintUsage::print_txt_usage($options, "{mkcol.params}");
310        die "\n";
311    }
312       
313    foreach my $strVariable (keys %$optionsParsingResult)
314    {
315        eval "\$$strVariable = \$optionsParsingResult->{\"\$strVariable\"}";
316    }
317    }
318   
319    # load default plugins if none were on command line
320    if (!scalar(@plugin)) {
321    @plugin = (ZIPPlugin,GreenstoneXMLPlugin,TextPlugin,HTMLPlugin,EmailPlugin,
322           PDFPlugin,RTFPlugin,WordPlugin,PostScriptPlugin,PowerPointPlugin,ExcelPlugin,ImagePlugin,ISISPlugin,NulPlugin,MetadataXMLPlugin,ArchivesInfPlugin,DirectoryPlugin);
323    }
324
325    # get and check the collection name
326    ($collection) = @ARGV;
327
328    # get capitalised version of the collection
329    $capcollection = $collection;
330    $capcollection =~ tr/a-z/A-Z/;
331
332    $collection_tail = &util::get_dirsep_tail($collection);
333    $capcollection_tail = &util::get_dirsep_tail($capcollection);
334
335
336    if (!defined($collection)) {
337    &gsprintf(STDOUT, "{mkcol.no_colname}\n");
338    &PrintUsage::print_txt_usage($options, "{mkcol.params}");
339    die "\n";
340    }
341
342    if (($win31compat eq "true") && (length($collection_tail)) > 8) {
343    &gsprintf(STDOUT, "{mkcol.long_colname}\n");
344    die "\n";
345    }
346
347    if ($collection eq "modelcol") {
348    &gsprintf(STDOUT, "{mkcol.bad_name_modelcol}\n");
349    die "\n";
350    }
351
352    if ($collection_tail eq "CVS") {
353    &gsprintf(STDOUT, "{mkcol.bad_name_cvs}\n");
354    die "\n";
355    }
356
357    if ($collection_tail eq ".svn") {
358    &gsprintf(STDOUT, "{mkcol.bad_name_svn}\n");
359    die "\n";
360    }
361
362    if (defined($creator) && (!defined($maintainer) || $maintainer eq "")) {
363    $maintainer = $creator;
364    }
365
366    $public = "true" unless defined $public;
367
368    if (!defined($title) || $title eq "") {
369    $title = $collection_tail;
370    }
371
372
373    # get the strings to include.
374    $pluginstring = "";
375    foreach my $plug (@plugin) {
376    $pluginstring .= "plugin         $plug\n";
377    }
378
379    my $mdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", "modelcol");
380    my $cdir;
381    if (defined $collectdir && $collectdir =~ /\w/) {
382    if (!-d $collectdir) {
383        &gsprintf(STDOUT, "{mkcol.no_collectdir}\n", $collectdir);
384        die "\n";
385    }
386    $cdir = &util::filename_cat ($collectdir, $collection);
387    } else {
388      if (!$gs3mode) {
389    $cdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $collection);
390      }else {
391      if (defined $site && $site =~ /\w/) {
392          die "GSDL3HOME not set\n" unless defined $ENV{'GSDL3HOME'};
393
394          $cdir  = &util::filename_cat($ENV{'GSDL3HOME'}, "sites", $site, "collect");
395          if (!-d $cdir) {
396          &gsprintf(STDOUT, "{mkcol.no_collectdir}\n", $cdir);
397          die "\n";
398          }
399          $cdir = &util::filename_cat ($cdir, $collection);
400      } else {
401        &gsprintf(STDOUT, "{mkcol.no_collectdir_specified}\n");
402        die "\n";
403    }
404      }
405    }
406
407    # make sure the model collection exists
408    (&gsprintf(STDERR, "{mkcol.cannot_find_modelcol}\n", $mdir) && die) unless (-d $mdir);
409
410    # make sure this collection does not already exist
411    if (-e $cdir) {
412    &gsprintf(STDOUT, "{mkcol.col_already_exists}\n");
413    die "\n";
414    }
415
416    # start creating the collection
417    &gsprintf(STDOUT, "\n{mkcol.creating_col}...\n", $collection)
418    unless $quiet;
419
420    &traverse_dir ($mdir, $cdir, $gs3mode);
421    &gsprintf(STDOUT, "\n{mkcol.success}\n", $cdir)
422    unless $quiet;
423}
424
425
Note: See TracBrowser for help on using the browser.