#!perl -w

###########################################################################
#
# webpage_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 is a webpage wrapper to the mkcol.pl process

package webpage_mkcol;

use CGI;
use GSDLHOME;
use gflock;

require util;
require webpageutil;

sub parse_cgiargs
{
    # get arguments
    my $cgi = new CGI;
    my %args = ();
    
    open (FILE, '>d:\gsdl\logout.txt') || die;

    foreach $p ($cgi->param()) 
    { 
	$args{$p} = $cgi->param($p);

	print FILE "webpage_mkcol.pl - $p -> $args{$p}\n";
    }

    close FILE;
    return \%args;
}


sub get_unique_dirname
{
    my ($args) = @_;

    my $dirname = "";

    my $fullname = $args->{'bc1fullname'};
    my $in_gsdl_area = $args->{'bc1ingsdlarea'};
    my $copy_dir = $args->{'bc1copydir'};

    # if inputdir is in gsdl area then need to extract existing dirname
    if (($in_gsdl_area eq "yes") && (($copy_dir eq "no")))
    {
	my $inputdir = $args->{'bc1inputdir'};
	my $dirsep_re = &util::get_re_dirsep();
	my @id_split = split(/$dirsep_re/,$inputdir);
	while (@id_split>0)
	{
	    $dirname = pop(@id_split);
	    last if ($dirname =~ m/(import|building)/i);
	}
	$dirname = pop(@id_split);

	# check to see if config file already exists
	my $cfg_filename
	    = &util::filename_cat($ENV{'GSDLHOME'},"collect",$dirname,
				 "etc","collect.cfg");
	if (-e $cfg_filename)
	{
	    &webpageutil::error_location($args,"_messconfigexists_");
	    return "";
	}	
    }
    else
    {
	# clean up input for heuristic that derives directory name for a
	# new collection
	$fullname =~ s/\s+/ /g;
	$fullname =~ tr/[A-Z]/[a-z]/;
	my @fn_split = split(" ",$fullname);
	map { $_ =~ s/\W//g } @fn_split; # remove any non-word characters
	
	my $no_words = scalar(@fn_split);
	if ($no_words == 0)
	{
	    &webpageutil::error_location($args,"_messnofn_");
	    return "";
	}
	
	my $use_words = ($no_words<=6) ? $no_words : 6;
	my $substr_len = int(6/$use_words);
	
	my $i;
	for ($i=0; $i<$use_words; $i++)
	{
	    $dirname .= substr($fn_split[$i],0,$substr_len);
	}
	
	# check to see if dirname is unique
	my $fulldirname 
	    = &util::filename_cat($ENV{'GSDLHOME'},"collect",$dirname);
	if (-e $fulldirname)
	{
	    my $version = 0;
	    do
	    {
		$version++;
		$fulldirname 
		    = &util::filename_cat($ENV{'GSDLHOME'},"collect",
					  "${dirname}v$version");

	    } while (-e $fulldirname);

	    $dirname = "${dirname}v$version";
	}
    }

    return $dirname;
}


sub main
{
    # get arguments
    my $args = parse_cgiargs();
    
    # get unique dirname
    my $unique_dirname = get_unique_dirname($args);
    if ($unique_dirname ne "")
    {
	my $fullname      = $args->{'bc1fullname'};
	my $contact_email = $args->{'bc1contactemail'};		
	my $about_desc    = $args->{'bc1aboutdesc'};
	my $src_format    = $args->{'bc1srcformat'};
	my $file_or_url   = $args->{'bc1fileorurl'};
	my $input_dir     = $args->{'bc1inputdir'};
	my $copy_dir      = $args->{'bc1copydir'};
	my $in_gsdl_area  = $args->{'bc1ingsdlarea'};
	my $acronyms      = $args->{'bc1acronyms'};

	my $cmd = "perl ";
	$cmd .= &util::filename_cat($ENV{'GSDLHOME'}, "bin", "script", "mkcol.pl");
	$cmd .= " -title   \"$fullname\"";
	$cmd .= " -creator $contact_email";
	$cmd .= " -about   \"$about_desc\"";
	$cmd .= " -plugin  \"GMLPlug\"";
	$cmd .= " -plugin  \"${src_format}Plug\"";
	$cmd .= " -plugin  \"ArcPlug\"";
	$cmd .= " -plugin  \"RecPlug\"";
###	$cmd .= " -refine  \"$refine_plugs\"";
	$cmd .= " $unique_dirname";

	my $status = system($cmd);
	$status /= 256;

	if ($status == 0)
	{
	    # append copydir, file_or_url and input_dir to end of collect.cfg
	    # we'll also append DocumentUseHTML if processing HTML docs
	    my $cfg_filename 
		= &util::filename_cat($ENV{'GSDLHOME'},"collect",$unique_dirname,
				      "etc","collect.cfg");
	    if (open(CFGAPP,">>$cfg_filename"))
	    {
		if (&gflock::lock (webpage_mkcol::CFGAPP)) {
		    print CFGAPP "\n";

		    if ($src_format eq "HTML") {
			print CFGAPP "format\tDocumentUseHTML\ttrue\n\n";
		    }

		    print CFGAPP "building\tfileorurl\t$file_or_url\n";
		    print CFGAPP "building\tinputdir\t$input_dir\n";
		    print CFGAPP "building\tcopydir\t\t$copy_dir\n";
		    print CFGAPP "building\tingsdlarea\t$in_gsdl_area\n";
		    &gflock::unlock (webpage_mkcol::CFGAPP);
		    close(CFGAPP);
		}
		else
		{
		    # problem locking file
		    my $mess = "Unable to lock collection";
		    $mess .= " configuration file: $cfg_filename";
		    &webpageutil::error_location($args,$mess);
		    close(CFGAPP);
		    return;
		}
	    }
	    else
	    {
		# problem
		my $mess = "Unable to append to collection";
		$mess .= " configuration file: $cfg_filename";
		&webpageutil::error_location($args,$mess);
		return;
	    }
	}
	else
	{
	    my $mess = "An error was encountered: error status = $status";
	    &webpageutil::error_location($args,$mess);
	    return;
	}
    }
    else
    {
	my $mess = "No unique directory name specified for collection";
	&webpageutil::error_location($args,$mess);
	return;
    }

    my $mess_url = "$args->{'httpbuild'}&bca=mess&bc1dirname=$unique_dirname";
    print "Location: $mess_url&head=_headdone_&mess=_messdonenewcol_\n\n";

}

&main();