#!/usr/bin/perl -w
###########################################################################
#
# mkcol.pl --
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the
# University of Waikato, New Zealand.
#
# Copyright (C) 1999 New Zealand Digital Library Project
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
###########################################################################
# This program will setup a new collection from a model one. It does this by
# copying the model, moving files to have the correct names, and replacing
# text within the files to match the parameters.
package mkcol;
BEGIN {
die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
die "GSDLOS not set\n" unless defined $ENV{'GSDLOS'};
unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
}
use parsargv;
use util;
use cfgread;
use printusage;
my $arguments =
[ { 'name' => "creator",
'desc' => "The collection creator's e-mail address.",
'type' => "string",
'reqd' => "yes" },
{ 'name' => "optionfile",
'desc' => "Get options from file, useful on systems where long command lines may cause problems.",
'type' => "string",
'reqd' => "no" },
{ 'name' => "maintainer",
'desc' => "The collection maintainer's email address (if different from the creator).",
'type' => "string",
'reqd' => "no" },
{ 'name' => "collectdir",
'desc' => "Directory where new collection will be created.",
'type' => "string",
'deft' => &util::filename_cat ($ENV{'GSDLHOME'}, "collect"),
'reqd' => "no" },
{ 'name' => "public",
'desc' => "If this collection has anonymous access (true/false).",
'type' => "string",
'deft' => "true",
'reqd' => "no" },
{ 'name' => "title",
'desc' => "The title of the collection.",
'type' => "string",
'reqd' => "no" },
{ 'name' => "about",
'desc' => "The about text for the collection.",
'type' => "string",
'reqd' => "no" },
{ 'name' => "plugin",
'desc' => "Perl plugin module to use (there may be multiple plugin entries).",
'type' => "string",
'reqd' => "no" },
{ 'name' => "quiet",
'desc' => "Operate quietly.",
'type' => "flag",
'reqd' => "no" } ];
my $options = { 'name' => "mkcol.pl",
'desc' => "PERL script used to create the directory structure for a new Greenstone collection.",
'args' => $arguments };
sub print_xml_usage
{
&PrintUsage::print_xml_header();
print STDERR "\n";
print STDERR " $options->{'name'}\n";
print STDERR " $options->{'desc'}\n";
print STDERR " \n";
if (defined($options->{'args'})) {
&PrintUsage::print_options_xml($options->{'args'});
}
print STDERR " \n";
print STDERR "\n";
}
sub print_txt_usage
{
local $programname = $options->{'name'};
local $programargs = $options->{'args'};
# Find the length of the longest option string
local $descoffset = 0;
if (defined($programargs)) {
$descoffset = &PrintUsage::find_longest_option_string($programargs);
}
# Produce the usage information using the data structure above
print STDERR " usage: $programname [options] collection-name\n\n";
# Display the program options, if there are some
if (defined($programargs)) {
# Calculate the column offset of the option descriptions
local $optiondescoffset = $descoffset + 2; # 2 spaces between options & descriptions
print STDERR " options:\n";
# Display the program options
&PrintUsage::print_options_txt($programargs, $optiondescoffset);
}
}
# sub print_usage {
# print STDOUT "\n";
# print STDOUT "mkcol.pl: Creates the directory structure for a new\n";
# print STDOUT " Greenstone collection.\n\n";
# print STDOUT " usage: $0 -creator email [options] collection-name\n\n";
# print STDOUT " options:\n";
# print STDOUT " -optionfile file Get options from file, useful on systems where\n";
# print STDOUT " long command lines may cause problems\n";
# print STDOUT " -collectdir Directory where new collection will be created.\n";
# print STDOUT " Default is " .
# &util::filename_cat($ENV{'GSDLHOME'}, "collect") . "\n";
# print STDOUT " -maintainer email The collection maintainer's email address (if\n";
# print STDOUT " different from the creator)\n";
# print STDOUT " -public true|false If this collection has anonymous access\n";
# print STDOUT " -title text The title for the collection\n";
# print STDOUT " -about text The about text for the collection\n";
# print STDOUT " -plugin text perl plugin module to use (there may be multiple\n";
# print STDOUT " plugin entries)\n";
# print STDOUT " -quiet Operate quietly\n";
# print STDOUT " Note that -creator must be specified. You can make changes to all\n";
# print STDOUT " options later by editing the collect.cfg configuration file for your\n";
# print STDOUT " new collection (it'll be in the \"etc\" directory).\n\n";
# print STDOUT " [Type \"perl -S mkcol.pl | more\" if this help text scrolled off your screen]";
# print STDOUT "\n" unless $ENV{'GSDLOS'} =~ /^windows$/i;
# }
sub traverse_dir
{
my ($modeldir, $coldir) = @_;
my ($newfile, @filetext);
if (!(-e $coldir)) {
my $store_umask = umask(0002);
my $mkdir_ok = mkdir ($coldir, 0777);
umask($store_umask);
if (!$mkdir_ok)
{
die "$!";
}
}
opendir(DIR, $modeldir) || die "Can't read $modeldir";
my @files = grep(!/^(\.\.?|CVS)$/, readdir(DIR));
closedir(DIR);
foreach $file (@files)
{
my $thisfile = &util::filename_cat ($modeldir, $file);
if (-d $thisfile) {
my $colfiledir = &util::filename_cat ($coldir, $file);
traverse_dir ($thisfile, $colfiledir);
} else {
my $destfile = $file;
$destfile =~ s/^modelcol/$collection/;
$destfile =~ s/^MODELCOL/$capcollection/;
print STDOUT " doing replacements for $destfile\n" unless $quiet;
$destfile = &util::filename_cat ($coldir, $destfile);
open (INFILE, $thisfile) ||
die "ERROR: Can't read file $thisfile";
open (OUTFILE, ">$destfile") ||
die "ERROR: Can't create file $destfile";
while (defined ($line = )) {
$line =~ s/\*\*collection\*\*/$collection/g;
$line =~ s/\*\*COLLECTION\*\*/$capcollection/g;
$line =~ s/\*\*creator\*\*/$creator/g;
$line =~ s/\*\*maintainer\*\*/$maintainer/g;
$line =~ s/\*\*public\*\*/$public/g;
$line =~ s/\*\*title\*\*/$title/g;
$line =~ s/\*\*about\*\*/$about/g;
$line =~ s/\*\*plugins\*\*/$pluginstring/g;
print OUTFILE $line;
}
close (OUTFILE);
close (INFILE);
}
}
}
# get and check options
sub parse_args {
my ($argref) = @_;
if (!&parsargv::parse($argref,
'optionfile/.*/', \$optionfile,
'collectdir/.*/', \$collectdir,
'creator/\w+\@[\w\.]+/', \$creator,
'maintainer/\w+\@[\w\.]+/', \$maintainer,
'public/true|false/true', \$public,
'title/.+/', \$title,
'about/.+/', \$about,
'plugin/.+', \@plugin,
'quiet', \$quiet,
q^xml^, \$xml
)) {
&print_txt_usage();
die "\n";
}
}
sub main {
&parse_args (\@ARGV);
if ($xml) {
&print_xml_usage();
die "\n";
}
if ($optionfile =~ /\w/) {
open (OPTIONS, $optionfile) || die "Couldn't open $optionfile\n";
my $line = [];
my $options = [];
while (defined ($line = &cfgread::read_cfg_line ('mkcol::OPTIONS'))) {
push (@$options, @$line);
}
close OPTIONS;
&parse_args ($options);
}
# load default plugins if none were on command line
if (!scalar(@plugin)) {
@plugin = (ZIPPlug,GAPlug,TEXTPlug,HTMLPlug,EMAILPlug,
PDFPlug,RTFPlug,WordPlug,PSPlug,ArcPlug,RecPlug);
}
# get and check the collection name
($collection) = @ARGV;
if (!defined($collection)) {
print STDOUT "ERROR: no collection name was specified\n";
&print_txt_usage();
die "\n";
}
if (length($collection) > 8) {
print STDOUT "ERROR: The collection name must be less than 8 characters\n";
print STDOUT " so compatibility with earlier filesystems can be\n";
print STDOUT " maintained.\n";
die "\n";
}
if ($collection eq "modelcol") {
print STDOUT "ERROR: No collection can be named modelcol as this is the\n";
print STDOUT " name of the model collection.\n";
die "\n";
}
if ($collection eq "CVS") {
print STDOUT "ERROR: No collection can be named CVS as this may interfere\n";
print STDOUT " with directories created by the CVS versioning system\n";
die "\n";
}
if (!defined($creator) || $creator eq "") {
print STDOUT "ERROR: The creator was not defined. This variable is\n";
print STDOUT " needed to recognise duplicate collection names.\n";
die "\n";
}
if (!defined($maintainer) || $maintainer eq "") {
$maintainer = $creator;
}
$public = "true" unless defined $public;
if (!defined($title) || $title eq "") {
$title = $collection;
}
# get capitalised version of the collection
$capcollection = $collection;
$capcollection =~ tr/a-z/A-Z/;
# get the strings to include.
$pluginstring = "";
foreach $plugin (@plugin) {
$pluginstring .= "plugin $plugin\n";
}
$mdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", "modelcol");
if (defined $collectdir && $collectdir =~ /\w/) {
if (!-d $collectdir) {
print STDOUT "ERROR: $collectdir doesn't exist\n";
die "\n";
}
$cdir = &util::filename_cat ($collectdir, $collection);
} else {
$cdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $collection);
}
# make sure the model collection exists
die "ERROR: Cannot find the model collection $mdir" unless (-d $mdir);
# make sure this collection does not already exist
if (-e $cdir) {
print STDOUT "ERROR: This collection already exists\n";
die "\n";
}
# start creating the collection
print STDOUT "\nCreating the collection $collection...\n" unless $quiet;
&traverse_dir ($mdir, $cdir);
print STDOUT "\nThe new collection was created successfully at\n" unless $quiet;
print STDOUT "$cdir\n" unless $quiet;
}
&main ();