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

#!/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'};
    unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
}

use parsargv;
use util;
use cfgread;

sub print_usage {
    print STDERR "\n  usage: $0 [options] collection-name\n\n";
    print STDERR "  options:\n";
    print STDERR "   -optionfile file    Get options from file, useful on systems where\n";
    print STDERR "                       long command lines may cause problems\n";
    print STDERR "   -collectdir         Directory where new collection will be created.\n";
    print STDERR "                       Default is " . 
    &util::filename_cat($ENV{'GSDLHOME'}, "collect") . "\n";
    print STDERR "   -creator email      Your email address\n";
    print STDERR "   -maintainer email   The collection maintainer's email address (if\n";
    print STDERR "                       different from the creator)\n";
    print STDERR "   -public true|false  If this collection has anonymous access\n";
    print STDERR "   -beta true|false    If this collection is still under development\n";
    print STDERR "   -title text         The title for the collection\n";
    print STDERR "   -about text         The about text for the collection\n";
    print STDERR "   -plugin text        perl plugin module to use (there may be multiple\n";
    print STDERR "                       plugin entries)\n";
    print STDERR "  Note that -creator is the only option to mkcol.pl that is mandatory.\n";
    print STDERR "  You can make changes to all options later by editing the collect.cfg\n";
    print STDERR "  configuration file for your new collection (it'll be in the \"etc\"\n";
    print STDERR "  directory).\n\n";
}

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/;
        $destfile = &util::filename_cat ($coldir, $destfile);

        print STDERR "doing replacements for $thisfile\n";
        open (INFILE, $thisfile) || 
        die "Can't read file $thisfile";
        open (OUTFILE, ">$destfile") ||
        die "Can't create file $destfile";

        while (defined ($line = <INFILE>)) {
        $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/\*\*beta\*\*/$beta/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,
              'beta/true|false/true', \$beta,
              'title/.+/', \$title,
              'about/.+/', \$about,
              'plugin/.+', \@plugin
              )) {
    &print_usage();
    die "\n";
    }
}

sub main {

    &parse_args (\@ARGV);
    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,GMLPlug,TEXTPlug,HTMLPlug,EMAILPlug,ArcPlug,RecPlug);
    }

    # get and check the collection name
    ($collection) = @ARGV;
    if (!defined($collection)) {
    print STDERR "no collection name was specified\n";
    &print_usage();
    die "\n";
    }

    if (length($collection) > 8) {
    print STDERR "The collection name must be less than 8 characters\n";
    print STDERR "so compatibility with earlier filesystems can be\n";
    print STDERR "maintained.\n";
    die "\n";
    }

    if ($collection eq "modelcol") {
    print STDERR "No collection can be named modelcol as this is the\n";
    print STDERR "name of the model collection.\n";
    die "\n";
    }

    if ($collection eq "CVS") {
    print STDERR "No collection can be named CVS as this may interfere\n";
    print STDERR "with directories created by the CVS versioning system\n";
    die "\n";
    }

    if (!defined($creator) || $creator eq "") {
    print STDERR "The creator was not defined. This variable is\n";
    print STDERR "needed to recognise duplicate collection names.\n";
    die "\n";
    }

    if (!defined($maintainer) || $maintainer eq "") {
    $maintainer = $creator;
    }

    $public = "true" unless defined $public;
    $beta = "true" unless defined $beta;

    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 STDERR "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 "Cannot find the model collection $mdir" unless (-d $mdir);

    # make sure this collection does not already exist
    if (-e $cdir) {
    print STDERR "This collection already exists\n";
    die "\n";
    }

    # start creating the collection
    print STDERR "Creating the collection $collection\n";
    &traverse_dir ($mdir, $cdir);
    print STDERR "The new collection is in $cdir.\n";
}

&main ();