source: gsdl/trunk/bin/script/mkcol.pl@ 15019

Last change on this file since 15019 was 15019, checked in by davidb, 14 years ago

mkcol.pl now takes "-group" option to signal that the the collection being formed is to be a "group-level" collection (i.e. one that acts as a container that conveniently groups a further set of collections together).

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 11.1 KB
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/collect\.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 = (ZIPPlug,GAPlug,TEXTPlug,"HTMLPlug -smart_block","EMAILPlug",
315 PDFPlug,RTFPlug,WordPlug,PSPlug,ImagePlug,ISISPlug,NULPlug,MetadataXMLPlug,ArcPlug,RecPlug);
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 repository browser.