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

Last change on this file since 6945 was 6945, checked in by mdewsnip, 20 years ago

Updated the resource bundle handling code some more. Strings are first looked for in a language specific resource bundle (if specified). If not found there, the default resource bundle is checked. If still not found, the English resource bundle is checked. These resource bundles are loaded on an as-needed basis.
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 9.6 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' => "no" },
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
95sub gsprintf
96{
97 return &gsprintf::gsprintf(@_);
98}
99
100
101# sub print_usage {
102# print STDOUT "\n";
103# print STDOUT "mkcol.pl: Creates the directory structure for a new\n";
104# print STDOUT " Greenstone collection.\n\n";
105# print STDOUT " usage: $0 -creator email [options] collection-name\n\n";
106# print STDOUT " options:\n";
107# print STDOUT " -optionfile file Get options from file, useful on systems where\n";
108# print STDOUT " long command lines may cause problems\n";
109# print STDOUT " -collectdir Directory where new collection will be created.\n";
110# print STDOUT " Default is " .
111# &util::filename_cat($ENV{'GSDLHOME'}, "collect") . "\n";
112# print STDOUT " -maintainer email The collection maintainer's email address (if\n";
113# print STDOUT " different from the creator)\n";
114# print STDOUT " -public true|false If this collection has anonymous access\n";
115# print STDOUT " -title text The title for the collection\n";
116# print STDOUT " -about text The about text for the collection\n";
117# print STDOUT " -plugin text perl plugin module to use (there may be multiple\n";
118# print STDOUT " plugin entries)\n";
119# print STDOUT " -quiet Operate quietly\n";
120# print STDOUT " Note that -creator must be specified. You can make changes to all\n";
121# print STDOUT " options later by editing the collect.cfg configuration file for your\n";
122# print STDOUT " new collection (it'll be in the \"etc\" directory).\n\n";
123# print STDOUT " [Type \"perl -S mkcol.pl | more\" if this help text scrolled off your screen]";
124# print STDOUT "\n" unless $ENV{'GSDLOS'} =~ /^windows$/i;
125# }
126
127sub traverse_dir
128{
129 my ($modeldir, $coldir) = @_;
130 my ($newfile, @filetext);
131
132 if (!(-e $coldir)) {
133
134 my $store_umask = umask(0002);
135 my $mkdir_ok = mkdir ($coldir, 0777);
136 umask($store_umask);
137
138 if (!$mkdir_ok)
139 {
140 die "$!";
141 }
142 }
143
144 opendir(DIR, $modeldir) ||
145 (&gsprintf(STDERR, "{common.cannot_read}\n", $modeldir) && die);
146 my @files = grep(!/^(\.\.?|CVS)$/, readdir(DIR));
147 closedir(DIR);
148
149 foreach $file (@files)
150 {
151 my $thisfile = &util::filename_cat ($modeldir, $file);
152 if (-d $thisfile) {
153 my $colfiledir = &util::filename_cat ($coldir, $file);
154 traverse_dir ($thisfile, $colfiledir);
155
156 } else {
157 my $destfile = $file;
158 $destfile =~ s/^modelcol/$collection/;
159 $destfile =~ s/^MODELCOL/$capcollection/;
160 &gsprintf(STDOUT, "{mkcol.doing_replacements}\n", $destfile)
161 unless $quiet;
162 $destfile = &util::filename_cat ($coldir, $destfile);
163
164 open (INFILE, $thisfile) ||
165 (&gsprintf(STDERR, "{common.cannot_read_file}\n", $thisfile) && die);
166 open (OUTFILE, ">$destfile") ||
167 (&gsprintf(STDERR, "{common.cannot_create_file}\n", $destfile) && die);
168
169 while (defined ($line = <INFILE>)) {
170 $line =~ s/\*\*collection\*\*/$collection/g;
171 $line =~ s/\*\*COLLECTION\*\*/$capcollection/g;
172 $line =~ s/\*\*creator\*\*/$creator/g;
173 $line =~ s/\*\*maintainer\*\*/$maintainer/g;
174 $line =~ s/\*\*public\*\*/$public/g;
175 $line =~ s/\*\*title\*\*/$title/g;
176 $line =~ s/\*\*about\*\*/$about/g;
177 $line =~ s/\*\*plugins\*\*/$pluginstring/g;
178
179 print OUTFILE $line;
180 }
181
182 close (OUTFILE);
183 close (INFILE);
184 }
185 }
186}
187
188# get and check options
189sub parse_args {
190 my ($argref) = @_;
191 if (!&parsargv::parse($argref,
192 'language/.*/', \$language,
193 'optionfile/.*/', \$optionfile,
194 'collectdir/.*/', \$collectdir,
195 'creator/\w+\@[\w\.]+/', \$creator,
196 'maintainer/\w+\@[\w\.]+/', \$maintainer,
197 'public/true|false/true', \$public,
198 'title/.+/', \$title,
199 'about/.+/', \$about,
200 'plugin/.+', \@plugin,
201 'quiet', \$quiet,
202 q^xml^, \$xml
203 )) {
204 &PrintUsage::print_txt_usage($options, "{mkcol.params}");
205 die "\n";
206 }
207}
208
209sub main {
210
211 &parse_args (\@ARGV);
212
213 # If $language has been specified, load the appropriate resource bundle
214 # (Otherwise, the default resource bundle will be loaded automatically)
215 if ($language) {
216 &gsprintf::load_language_specific_resource_bundle($language);
217 }
218
219 if ($xml) {
220 &PrintUsage::print_xml_usage($options);
221 die "\n";
222 }
223
224 if ($optionfile =~ /\w/) {
225 open (OPTIONS, $optionfile) ||
226 (&gsprintf(STDERR, "{common.cannot_open}\n", $optionfile) && die);
227 my $line = [];
228 my $options = [];
229 while (defined ($line = &cfgread::read_cfg_line ('mkcol::OPTIONS'))) {
230 push (@$options, @$line);
231 }
232 close OPTIONS;
233 &parse_args ($options);
234 }
235
236 # load default plugins if none were on command line
237 if (!scalar(@plugin)) {
238 @plugin = (ZIPPlug,GAPlug,TEXTPlug,HTMLPlug,EMAILPlug,
239 PDFPlug,RTFPlug,WordPlug,PSPlug,ArcPlug,RecPlug);
240 }
241
242 # get and check the collection name
243 ($collection) = @ARGV;
244 if (!defined($collection)) {
245 &gsprintf(STDOUT, "{mkcol.no_colname}\n");
246 &PrintUsage::print_txt_usage($options, "{mkcol.params}");
247 die "\n";
248 }
249
250 if (length($collection) > 8) {
251 &gsprintf(STDOUT, "{mkcol.long_colname}\n");
252 die "\n";
253 }
254
255 if ($collection eq "modelcol") {
256 &gsprintf(STDOUT, "{mkcol.bad_name_modelcol}\n");
257 die "\n";
258 }
259
260 if ($collection eq "CVS") {
261 &gsprintf(STDOUT, "{mkcol.bad_name_cvs}\n");
262 die "\n";
263 }
264
265 # We don't want creator to be required anymore - John Thompson 28-11-2003
266 #if (!defined($creator) || $creator eq "") {
267 # &gsprintf(STDOUT, "{mkcol.creator_undefined}\n");
268 # die "\n";
269 #}
270
271 #Of course thats means we don't want to default maintainer unless a creator is provided
272 if (defined($creator) && (!defined($maintainer) || $maintainer eq "")) {
273 $maintainer = $creator;
274 }
275
276 $public = "true" unless defined $public;
277
278 if (!defined($title) || $title eq "") {
279 $title = $collection;
280 }
281
282 # get capitalised version of the collection
283 $capcollection = $collection;
284 $capcollection =~ tr/a-z/A-Z/;
285
286 # get the strings to include.
287 $pluginstring = "";
288 foreach $plugin (@plugin) {
289 $pluginstring .= "plugin $plugin\n";
290 }
291
292 $mdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", "modelcol");
293 if (defined $collectdir && $collectdir =~ /\w/) {
294 if (!-d $collectdir) {
295 &gsprintf(STDOUT, "{mkcol.no_collectdir}\n", $collectdir);
296 die "\n";
297 }
298 $cdir = &util::filename_cat ($collectdir, $collection);
299 } else {
300 $cdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $collection);
301 }
302
303 # make sure the model collection exists
304 (&gsprintf(STDERR, "{mkcol.cannot_find_modelcol}\n", $mdir) && die) unless (-d $mdir);
305
306 # make sure this collection does not already exist
307 if (-e $cdir) {
308 &gsprintf(STDOUT, "{mkcol.col_already_exists}\n");
309 die "\n";
310 }
311
312 # start creating the collection
313 &gsprintf(STDOUT, "\n{mkcol.creating_col}...\n", $collection)
314 unless $quiet;
315 &traverse_dir ($mdir, $cdir);
316 &gsprintf(STDOUT, "\n{mkcol.success}\n", $cdir)
317 unless $quiet;
318}
319
320&main ();
Note: See TracBrowser for help on using the repository browser.