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

Last change on this file since 6054 was 5606, checked in by mdewsnip, 21 years ago

Move some more strings out to the resource bundles (perllib/strings.rb), in preparation for translation.
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 10.7 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 parsargv;
42use util;
43use cfgread;
44use gsprintf;
45use printusage;
46
47my $arguments =
48 [ { 'name' => "creator",
49 'desc' => "{mkcol.creator}",
50 'type' => "string",
51 'reqd' => "yes" },
52 { 'name' => "optionfile",
53 'desc' => "{mkcol.optionfile}",
54 'type' => "string",
55 'reqd' => "no" },
56 { 'name' => "maintainer",
57 'desc' => "{mkcol.maintainer}",
58 'type' => "string",
59 'reqd' => "no" },
60 { 'name' => "collectdir",
61 'desc' => "{mkcol.collectdir}",
62 'type' => "string",
63 'deft' => &util::filename_cat ($ENV{'GSDLHOME'}, "collect"),
64 'reqd' => "no" },
65 { 'name' => "public",
66 'desc' => "{mkcol.public}",
67 'type' => "string",
68 'deft' => "true",
69 'reqd' => "no" },
70 { 'name' => "title",
71 'desc' => "{mkcol.title}",
72 'type' => "string",
73 'reqd' => "no" },
74 { 'name' => "about",
75 'desc' => "{mkcol.about}",
76 'type' => "string",
77 'reqd' => "no" },
78 { 'name' => "plugin",
79 'desc' => "{mkcol.plugin}",
80 'type' => "string",
81 'reqd' => "no" },
82 { 'name' => "quiet",
83 'desc' => "{mkcol.quiet}",
84 'type' => "flag",
85 'reqd' => "no" },
86 { 'name' => "language",
87 'desc' => "{scripts.language}",
88 'type' => "string",
89 'reqd' => "no" } ];
90
91my $options = { 'name' => "mkcol.pl",
92 'desc' => "{mkcol.desc}",
93 'args' => $arguments };
94
95
96sub print_xml_usage
97{
98 local $language = shift(@_);
99
100 &PrintUsage::print_xml_header();
101
102 print STDERR "<Info>\n";
103 print STDERR " <Name>$options->{'name'}</Name>\n";
104 print STDERR " <Desc>" . &lookup_string($options->{'desc'}) . "</Desc>\n";
105 print STDERR " <Arguments>\n";
106 if (defined($options->{'args'})) {
107 &PrintUsage::print_options_xml($language, $options->{'args'});
108 }
109 print STDERR " </Arguments>\n";
110 print STDERR "</Info>\n";
111}
112
113
114sub print_txt_usage
115{
116 local $language = shift(@_);
117
118 local $programname = $options->{'name'};
119 local $programargs = $options->{'args'};
120
121 # Find the length of the longest option string
122 local $descoffset = 0;
123 if (defined($programargs)) {
124 $descoffset = &PrintUsage::find_longest_option_string($programargs);
125 }
126
127 # Produce the usage information using the data structure above
128 print STDERR " " . &lookup_string("{common.usage}") . ": $programname";
129 print STDERR " " . &lookup_string("{mkcol.params}") . "\n\n";
130
131 # Display the program options, if there are some
132 if (defined($programargs)) {
133 # Calculate the column offset of the option descriptions
134 local $optiondescoffset = $descoffset + 2; # 2 spaces between options & descriptions
135
136 print STDERR " " . &lookup_string("{common.options}") . ":\n";
137
138 # Display the program options
139 &PrintUsage::print_options_txt($language, $programargs, $optiondescoffset);
140 }
141}
142
143
144sub lookup_string
145{
146 return &gsprintf::lookup_string($language, shift(@_));
147}
148
149
150# sub print_usage {
151# print STDOUT "\n";
152# print STDOUT "mkcol.pl: Creates the directory structure for a new\n";
153# print STDOUT " Greenstone collection.\n\n";
154# print STDOUT " usage: $0 -creator email [options] collection-name\n\n";
155# print STDOUT " options:\n";
156# print STDOUT " -optionfile file Get options from file, useful on systems where\n";
157# print STDOUT " long command lines may cause problems\n";
158# print STDOUT " -collectdir Directory where new collection will be created.\n";
159# print STDOUT " Default is " .
160# &util::filename_cat($ENV{'GSDLHOME'}, "collect") . "\n";
161# print STDOUT " -maintainer email The collection maintainer's email address (if\n";
162# print STDOUT " different from the creator)\n";
163# print STDOUT " -public true|false If this collection has anonymous access\n";
164# print STDOUT " -title text The title for the collection\n";
165# print STDOUT " -about text The about text for the collection\n";
166# print STDOUT " -plugin text perl plugin module to use (there may be multiple\n";
167# print STDOUT " plugin entries)\n";
168# print STDOUT " -quiet Operate quietly\n";
169# print STDOUT " Note that -creator must be specified. You can make changes to all\n";
170# print STDOUT " options later by editing the collect.cfg configuration file for your\n";
171# print STDOUT " new collection (it'll be in the \"etc\" directory).\n\n";
172# print STDOUT " [Type \"perl -S mkcol.pl | more\" if this help text scrolled off your screen]";
173# print STDOUT "\n" unless $ENV{'GSDLOS'} =~ /^windows$/i;
174# }
175
176sub traverse_dir
177{
178 my ($modeldir, $coldir) = @_;
179 my ($newfile, @filetext);
180
181 if (!(-e $coldir)) {
182
183 my $store_umask = umask(0002);
184 my $mkdir_ok = mkdir ($coldir, 0777);
185 umask($store_umask);
186
187 if (!$mkdir_ok)
188 {
189 die "$!";
190 }
191 }
192
193 opendir(DIR, $modeldir)
194 || die &lookup_string("{common.cannot_read}") . " $modeldir";
195 my @files = grep(!/^(\.\.?|CVS)$/, readdir(DIR));
196 closedir(DIR);
197
198 foreach $file (@files)
199 {
200 my $thisfile = &util::filename_cat ($modeldir, $file);
201 if (-d $thisfile) {
202 my $colfiledir = &util::filename_cat ($coldir, $file);
203 traverse_dir ($thisfile, $colfiledir);
204
205 } else {
206 my $destfile = $file;
207 $destfile =~ s/^modelcol/$collection/;
208 $destfile =~ s/^MODELCOL/$capcollection/;
209 print STDOUT " " . &lookup_string("{mkcol.doing_replacements}") . " $destfile\n"
210 unless $quiet;
211 $destfile = &util::filename_cat ($coldir, $destfile);
212
213 open (INFILE, $thisfile) ||
214 die &lookup_string("{common.cannot_read_file}") . " $thisfile";
215 open (OUTFILE, ">$destfile") ||
216 die &lookup_string("{common.cannot_create_file}") . " $destfile";
217
218 while (defined ($line = <INFILE>)) {
219 $line =~ s/\*\*collection\*\*/$collection/g;
220 $line =~ s/\*\*COLLECTION\*\*/$capcollection/g;
221 $line =~ s/\*\*creator\*\*/$creator/g;
222 $line =~ s/\*\*maintainer\*\*/$maintainer/g;
223 $line =~ s/\*\*public\*\*/$public/g;
224 $line =~ s/\*\*title\*\*/$title/g;
225 $line =~ s/\*\*about\*\*/$about/g;
226 $line =~ s/\*\*plugins\*\*/$pluginstring/g;
227
228 print OUTFILE $line;
229 }
230
231 close (OUTFILE);
232 close (INFILE);
233 }
234 }
235}
236
237# get and check options
238sub parse_args {
239 my ($argref) = @_;
240 if (!&parsargv::parse($argref,
241 'language/.*/', \$language,
242 'optionfile/.*/', \$optionfile,
243 'collectdir/.*/', \$collectdir,
244 'creator/\w+\@[\w\.]+/', \$creator,
245 'maintainer/\w+\@[\w\.]+/', \$maintainer,
246 'public/true|false/true', \$public,
247 'title/.+/', \$title,
248 'about/.+/', \$about,
249 'plugin/.+', \@plugin,
250 'quiet', \$quiet,
251 q^xml^, \$xml
252 )) {
253 &print_txt_usage($language);
254 die "\n";
255 }
256}
257
258sub main {
259
260 &parse_args (\@ARGV);
261
262 if ($xml) {
263 &print_xml_usage($language);
264 die "\n";
265 }
266
267 if ($optionfile =~ /\w/) {
268 open (OPTIONS, $optionfile) ||
269 die &lookup_string("{common.cannot_open}") . " $optionfile\n";
270 my $line = [];
271 my $options = [];
272 while (defined ($line = &cfgread::read_cfg_line ('mkcol::OPTIONS'))) {
273 push (@$options, @$line);
274 }
275 close OPTIONS;
276 &parse_args ($options);
277 }
278
279 # load default plugins if none were on command line
280 if (!scalar(@plugin)) {
281 @plugin = (ZIPPlug,GAPlug,TEXTPlug,HTMLPlug,EMAILPlug,
282 PDFPlug,RTFPlug,WordPlug,PSPlug,ArcPlug,RecPlug);
283 }
284
285 # get and check the collection name
286 ($collection) = @ARGV;
287 if (!defined($collection)) {
288 print STDOUT &lookup_string("{mkcol.no_colname}") . "\n";
289 &print_txt_usage($language);
290 die "\n";
291 }
292
293 if (length($collection) > 8) {
294 print STDOUT &lookup_string("{mkcol.long_colname}") . "\n";
295 die "\n";
296 }
297
298 if ($collection eq "modelcol") {
299 print STDOUT &lookup_string("{mkcol.bad_name_modelcol}") . "\n";
300 die "\n";
301 }
302
303 if ($collection eq "CVS") {
304 print STDOUT &lookup_string("{mkcol.bad_name_cvs}") . "\n";
305 die "\n";
306 }
307
308 if (!defined($creator) || $creator eq "") {
309 print STDOUT &lookup_string("{mkcol.creator_undefined}") . "\n";
310 die "\n";
311 }
312
313 if (!defined($maintainer) || $maintainer eq "") {
314 $maintainer = $creator;
315 }
316
317 $public = "true" unless defined $public;
318
319 if (!defined($title) || $title eq "") {
320 $title = $collection;
321 }
322
323 # get capitalised version of the collection
324 $capcollection = $collection;
325 $capcollection =~ tr/a-z/A-Z/;
326
327 # get the strings to include.
328 $pluginstring = "";
329 foreach $plugin (@plugin) {
330 $pluginstring .= "plugin $plugin\n";
331 }
332
333 $mdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", "modelcol");
334 if (defined $collectdir && $collectdir =~ /\w/) {
335 if (!-d $collectdir) {
336 print STDOUT &lookup_string("{mkcol.no_collectdir}") . ": $collectdir\n";
337 die "\n";
338 }
339 $cdir = &util::filename_cat ($collectdir, $collection);
340 } else {
341 $cdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $collection);
342 }
343
344 # make sure the model collection exists
345 die &lookup_string("{mkcol.cannot_find_modelcol}") . " $mdir" unless (-d $mdir);
346
347 # make sure this collection does not already exist
348 if (-e $cdir) {
349 print STDOUT &lookup_string("{mkcol.col_already_exists}") . "\n";
350 die "\n";
351 }
352
353 # start creating the collection
354 print STDOUT "\n" . &lookup_string("{mkcol.creating_col}") . " $collection...\n"
355 unless $quiet;
356 &traverse_dir ($mdir, $cdir);
357 print STDOUT "\n" . &lookup_string("{mkcol.success}") . "\n$cdir\n"
358 unless $quiet;
359}
360
361&main ();
Note: See TracBrowser for help on using the repository browser.