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

#!/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

# @revision 09/05/02 Added XML usage information flag - John Thompson

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 parsargv;
use gsprintf;
use printusage;


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

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


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


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 $programname . ": " . &lookup_string($options->{'desc'}) . "\n\n";
    print STDERR " " . &lookup_string("{common.usage}") . ": $programname";
    print STDERR " " . &lookup_string("{pluginfo.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 main {
    my $collect = "";
    my $xml = 0;
    my $language = "";  # Will display in the default language if not set

    if (!parsargv::parse(\@ARGV,
             q^collect/.*/^, \$collect,
             q^xml^, \$xml,
             q^language/.*/^, \$language))
    {
    &print_txt_usage($language);
    die "\n";
    }

    my $plugin = shift (@ARGV);
    if (!defined $plugin || $plugin eq "") {
    print STDERR &lookup_string("{pluginfo.no_plugin_name}") . "\n\n";
    &print_txt_usage($language);
    die "\n";
    }

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

    my $pluginfo = &plugin::load_plugins ([[$plugin]]);
    my $plugobj = shift @$pluginfo;

    if ($xml) {
        $plugobj->print_xml_usage($language);
    }
    else {
    print STDERR "\n$plugin " . &lookup_string("{pluginfo.info}") . ":\n\n";
    print STDERR &lookup_string("{pluginfo.passing_options}") . "\n\n";
    print STDERR &lookup_string("{pluginfo.option_types}") . ":\n\n";
    print STDERR &lookup_string("{pluginfo.specific_options}") . "\n\n";
    print STDERR &lookup_string("{pluginfo.general_options}") . "\n\n";

    $plugobj->print_txt_usage($language);
    }
}


# 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)"}
    $pid = open(STDIN, "-|"); # this does a fork... see man perlipc(1)
    if (!defined $pid) {
    print 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 ();