source: trunk/gsdl/bin/script/pluginfo.pl@ 10825

#!/usr/bin/perl -w

###########################################################################
#
# pluginfo.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 print info about a plugin

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/plugins");
}

use plugin;
use util;
use gsprintf;
use printusage;

use parse2;

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

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

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


sub main {
    my $collect = "";
    my $xml = 0;
    my $listall = 0;
    
    my ($language, $encoding);

    my $hashParsingResult = {};
    my $blnParseFailed = "false";
    # general options available to all plugins
    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 $plugin = shift (@ARGV);
    if (defined $plugin) {
    $plugin =~ s/\.pm$//; # allow xxxPlug.pm as the argument
    }
    if (($listall == 0) && (!defined $plugin || $plugin eq "")) {
    gsprintf(STDERR, "{pluginfo.no_plugin_name}\n\n");
    PrintUsage::print_txt_usage($options, "{pluginfo.params}", 1);
    die "\n";
    }

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

    if ($listall) {
    my $plugin_dir = &util::filename_cat($ENV{'GSDLCOLLECTDIR'},"perllib","plugins");
    
    if (!opendir (INDIR, $plugin_dir)) {
        print STDERR "pluginfo.pl: could not open directory $plugin_dir\n";
    } else {
        my @plugin_list = grep (/Plug\.pm$/, readdir (INDIR));
        closedir (INDIR);


        if ($xml) {
        my $num_plugins = scalar(@plugin_list);

        print STDERR "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
        print STDERR "<!DOCTYPE PluginList [\n";
        print STDERR "  <!ELEMENT PluginList (PluginName*)>\n";
        print STDERR "  <!ELEMENT PlugName   (#PCDATA)>\n";
        print STDERR "  <!ATTLIST PluginList\n";
        print STDERR "            length CDATA #REQUIRED>\n";
        print STDERR "]>\n";

        print STDERR "<PluginList length=\"$num_plugins\">\n";
        map { print STDERR "  <PluginName>$_</PluginName>\n"; } @plugin_list;
        print STDERR "</PluginList>\n";

        }
        else {
        print STDERR join(" ",@plugin_list), "\n";
        }
    }

    }
    else {

    #my $pluginfo = &plugin::load_plugins ([[$plugin]]);
    #my $plugobj = shift @$pluginfo;
    my $plugobj = &plugin::load_plugin_for_info ($plugin);
    if ($xml) {
        $plugobj->print_xml_usage();
    }
    else {
        gsprintf(STDERR, "\n{pluginfo.passing_options}\n\n");
        gsprintf(STDERR, "{pluginfo.option_types}:\n\n");
        gsprintf(STDERR, "{pluginfo.specific_options}\n\n");
        gsprintf(STDERR, "{pluginfo.general_options}\n\n");
        gsprintf(STDERR, "$plugin {pluginfo.info}:\n\n");
        
        $plugobj->print_txt_usage();
    }
    }
}


# this causes us to automatically send output to a pager, if one is
# set, AND our output is going to a terminal
# active state perl on windows doesn't do open(handle, "-|");
if ($ENV{'GSDLOS'} !~ /windows/ && -t STDOUT) {
    my $pager = $ENV{"PAGER"};
    if (! $pager) {$pager="(less || more)"}
    my $pid = open(STDIN, "-|"); # this does a fork... see man perlipc(1)
    if (!defined $pid) {
    gsprintf(STDERR, "pluginfo.pl - can't fork: $!");
    } else {
    if ($pid != 0) { # parent (ie forking) process. child gets 0
        exec ($pager);
    }
    }
    open(STDERR,">&STDOUT"); # so it's easier to pipe output
}


&main ();