#!/usr/bin/perl -w

###########################################################################
#
# downloadinfo.pl -- prints out information about a download module
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the 
# University of Waikato, New Zealand.
#
# Copyright (C) 2006 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.
#
###########################################################################


use strict;
no strict 'subs'; # allow barewords (eg STDERR) as function arguments

BEGIN {
    die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
    die "GSDLOS not set\n" unless defined $ENV{'GSDLOS'};
    unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/downloaders");
}

use download;
use util;
use gsprintf;
use printusage;
use parse2;

my $arguments =
    [ { 'name' => "collect",
	'desc' => "{downloadinfo.collect}",
	'type' => "string",
	'reqd' => "no" },
      { 'name' => "xml",
	'desc' => "{scripts.xml}",
	'type' => "flag",
	'reqd' => "no"},
      { 'name' => "listall",
	'desc' => "{scripts.listall}",
	'type' => "flag",
	'reqd' => "no" },
      { 'name' => "describeall",
	'desc' => "{scripts.describeall}",
	'type' => "flag",
	'reqd' => "no" },
      { 'name' => "language",
	'desc' => "{scripts.language}",
	'type' => "string",
	'reqd' => "no" } ];

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

sub gsprintf
{
    return &gsprintf::gsprintf(@_);
}


sub main {
	
    my $collect = "";
    my $xml = 0;
    my $listall = 0;
    my $describeall = 0;
    my ($language, $encoding);
    my $hashParsingResult = {};
    my $unparsed_args = parse2::parse(\@ARGV,$arguments,$hashParsingResult,"allow_extra_options");

    foreach my $strVariable (keys %$hashParsingResult)
    {
	my $value = $hashParsingResult->{$strVariable};
	# test to make sure the variable name is 'safe'
	if ($strVariable !~ /^\w+$/) {
 	    die "variable name '$strVariable' isn't safe!";
	}
	eval "\$$strVariable = \$value";
    }
    
    # if language wasn't specified, see if it is set in the environment
    # (LC_ALL or LANG)
    if (!$language && ($_=$ENV{'LC_ALL'} or $_=$ENV{'LANG'})) {
	m/^([^\.]+)\.?(.*)/;
	$language=$1;
	$encoding=$2; # might be undef...
# gsprintf::load_language* thinks "fr" is completely different to "fr_FR"...
	$language =~ s/_.*$//;
    }

    # If $language has been set, load the appropriate resource bundle
    # (Otherwise, the default resource bundle will be loaded automatically)
    if ($language) {
	gsprintf::load_language_specific_resource_bundle($language);
	if ($encoding) {
	    $encoding =~ tr/-/_/;
	    $encoding = lc($encoding);
	    $encoding =~ s/utf_8/utf8/; # special
	    $gsprintf::specialoutputencoding=$encoding;
	}
    }
    
    # If there are more than one argument left after parsing, it mean user input too many arguments.
    # Error occoured  will return 0
    if( $unparsed_args > 1 or (@ARGV && $ARGV[0] =~ /^\-+h/) )
    {
	PrintUsage::print_txt_usage($options, "{pluginfo.params}");
	die "\n";
    }
    
    my $download_name = shift (@ARGV);
    if (defined $download_name) {
	$download_name =~ s/\.pm$//; # allow xxx.pm as the argument
    }
    if (($listall == 0 && $describeall ==0) && (!defined $download_name || $download_name eq "")) {
	gsprintf(STDERR, "{downloadinfo.no_download_name}\n\n");
	PrintUsage::print_txt_usage($options, "{downloadinfo.params}", 1);
	die "\n";
    }

    if ($collect ne "") {
	$ENV{'GSDLCOLLECTDIR'} = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $collect);
    } else {
	$ENV{'GSDLCOLLECTDIR'} = $ENV{'GSDLHOME'};
    }

    if ($listall) {
	my $download_dir = &util::filename_cat($ENV{'GSDLCOLLECTDIR'},"perllib","downloaders");
	
	if (!opendir (INDIR, $download_dir)) {
	    print STDERR "downloadinfo.pl: could not open directory $download_dir\n";
	} 
	else {
	    my @download_list = grep (/Download\.pm$/, readdir (INDIR));
	    closedir (INDIR);
	    
	    if ($xml) {
		my $intNumDownloads = scalar(@download_list);
		
		print STDERR "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
		print STDERR "<!DOCTYPE DownloadList [\n";
		print STDERR "  <!ELEMENT DownloadList (DownloadName*)>\n";
		print STDERR "  <!ELEMENT DownloadName   (#PCDATA)>\n";
		print STDERR "  <!ATTLIST DownloadList\n";
		print STDERR "            length CDATA #REQUIRED>\n";
		    print STDERR "]>\n";
		
		print STDERR "<DownloadList length=\"$intNumDownloads\">\n";
		map { print STDERR "  <DownloadName>$_</DownloadName>\n"; } @download_list;
		print STDERR "</DownloadList>\n";
	    }
	    else {
		print STDERR join(" ",@download_list), "\n";
	    }
	}
    }

    elsif ($describeall) {
	my $download_dir = &util::filename_cat($ENV{'GSDLCOLLECTDIR'},"perllib","downloaders");
	my @download_list;
	if (!opendir (INDIR, $download_dir)) {
	    print STDERR "downloadinfo.pl: could not open directory $download_dir\n";
	} else {
	    @download_list = grep (/Download\.pm$/, readdir (INDIR));
	    closedir (INDIR);
	}
	#sort (@download_list);
	if ($xml) {
	    my $num_download = scalar(@download_list);
	    &PrintUsage::print_xml_header("download", 1);
	    print STDERR "<DownloadInfoList length=\"$num_download\">\n";
	}
	foreach my $pl (@download_list) {
	    $pl =~ s/\.pm$//;
	    &print_single_download($pl, $xml, 0);
	}
	if ($xml) {
	    print STDERR "</DownloadInfoList>\n";
	}
    }

    else {
	&print_single_download($download_name, $xml, 1);
    }
}

sub print_single_download {
    my ($download, $xml, $header) = @_;
    my @options  = ("-gsdlinfo");
    my $downloadobj = &download::load_download ($download, \@options );
    if ($xml) {
	$downloadobj->print_xml_usage($header);
    }
    else {
	gsprintf(STDERR, "{downloadinfo.option_types}:\n\n");
	gsprintf(STDERR, "{downloadinfo.specific_options}\n\n");
	gsprintf(STDERR, "{downloadinfo.general_options}\n\n");
	gsprintf(STDERR, "$download {common.info}:\n\n");
	
	$downloadobj->print_txt_usage();
    }
    
}

&main ();
