#!/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 gsprintf { return &gsprintf::gsprintf(@_); } 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)) { &PrintUsage::print_txt_usage($language, $options, "{pluginfo.params}", 1); die "\n"; } my $plugin = shift (@ARGV); if (!defined $plugin || $plugin eq "") { &gsprintf(STDERR, "{pluginfo.no_plugin_name}\n\n"); &PrintUsage::print_txt_usage($language, $options, "{pluginfo.params}", 1); 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 { &gsprintf(STDERR, "\n$plugin {pluginfo.info}:\n\n"); &gsprintf(STDERR, "{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"); $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) { &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 ();