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

Revision 17751, 11.2 KB (checked in by kjdon, 11 years ago)

GA changed to GreenstoneXML

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