#!/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 gsprintf;
use printusage;

my $arguments =
    [ { 'name' => "creator",
	'desc' => "{mkcol.creator}",
	'type' => "string",
	'reqd' => "yes" },
      { 'name' => "optionfile",
	'desc' => "{mkcol.optionfile}",
	'type' => "string",
	'reqd' => "no" },
      { 'name' => "maintainer",
	'desc' => "{mkcol.maintainer}",
	'type' => "string",
	'reqd' => "no" },
      { 'name' => "collectdir",
	'desc' => "{mkcol.collectdir}",
	'type' => "string",
	'deft' => &util::filename_cat ($ENV{'GSDLHOME'}, "collect"),
	'reqd' => "no" },
      { 'name' => "public",
	'desc' => "{mkcol.public}",
	'type' => "string",
	'deft' => "true",
	'reqd' => "no" },
      { 'name' => "title",
	'desc' => "{mkcol.title}",
	'type' => "string",
	'reqd' => "no" },
      { 'name' => "about",
	'desc' => "{mkcol.about}",
	'type' => "string",
	'reqd' => "no" },
      { 'name' => "plugin",
	'desc' => "{mkcol.plugin}",
	'type' => "string",
	'reqd' => "no" },
      { 'name' => "quiet",
	'desc' => "{mkcol.quiet}",
	'type' => "flag",
	'reqd' => "no" },
      { 'name' => "language",
	'desc' => "{scripts.language}",
	'type' => "string",
	'reqd' => "no" } ];

my $options = { 'name' => "mkcol.pl",
		'desc' => "{mkcol.desc}",
		'args' => $arguments };


sub print_xml_usage
{
    local $language = shift(@_);

    &PrintUsage::print_xml_header();

    print STDERR "<Info>\n";
    print STDERR "  <Name>$options->{'name'}</Name>\n";
    print STDERR "  <Desc>" . &lookup_string($options->{'desc'}) . "</Desc>\n";
    print STDERR "  <Arguments>\n";
    if (defined($options->{'args'})) {
	&PrintUsage::print_options_xml($language, $options->{'args'});
    }
    print STDERR "  </Arguments>\n";
    print STDERR "</Info>\n";
}


sub print_txt_usage
{
    local $language = shift(@_);

    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 " " . &lookup_string("{common.usage}") . ": $programname";
    print STDERR " " . &lookup_string("{mkcol.params}") . "\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 " " . &lookup_string("{common.options}") . ":\n";

	# Display the program options
	&PrintUsage::print_options_txt($language, $programargs, $optiondescoffset);
    }
}


sub lookup_string
{
    return &gsprintf::lookup_string($language, shift(@_));
}


#  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 &lookup_string("{common.cannot_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 "  " . &lookup_string("{mkcol.doing_replacements}") . " $destfile\n"
		unless $quiet;
	    $destfile = &util::filename_cat ($coldir, $destfile);

	    open (INFILE, $thisfile) || 
		die &lookup_string("{common.cannot_read_file}") . " $thisfile";
	    open (OUTFILE, ">$destfile") ||
		die &lookup_string("{common.cannot_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/\*\*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,
			  'language/.*/', \$language,
			  '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($language);
	die "\n";
    }
}

sub main {

    &parse_args (\@ARGV);

    if ($xml) {
	&print_xml_usage($language);
	die "\n";
    }

    if ($optionfile =~ /\w/) {
	open (OPTIONS, $optionfile) ||
	    die &lookup_string("{common.cannot_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 &lookup_string("{mkcol.no_colname}") . "\n";
	&print_txt_usage($language);
	die "\n";
    }

    if (length($collection) > 8) {
	print STDOUT &lookup_string("{mkcol.long_colname}") . "\n";
	die "\n";
    }

    if ($collection eq "modelcol") {
	print STDOUT &lookup_string("{mkcol.bad_name_modelcol}") . "\n";
	die "\n";
    }

    if ($collection eq "CVS") {
	print STDOUT &lookup_string("{mkcol.bad_name_cvs}") . "\n";
	die "\n";
    }

    if (!defined($creator) || $creator eq "") {
	print STDOUT &lookup_string("{mkcol.creator_undefined}") . "\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 &lookup_string("{mkcol.no_collectdir}") . ": $collectdir\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 &lookup_string("{mkcol.cannot_find_modelcol}") . " $mdir" unless (-d $mdir);

    # make sure this collection does not already exist
    if (-e $cdir) {
	print STDOUT &lookup_string("{mkcol.col_already_exists}") . "\n";
	die "\n";
    }

    # start creating the collection
    print STDOUT "\n" . &lookup_string("{mkcol.creating_col}") . " $collection...\n"
	unless $quiet;
    &traverse_dir ($mdir, $cdir);
    print STDOUT "\n" . &lookup_string("{mkcol.success}") . "\n$cdir\n"
	unless $quiet;
}

&main ();
