root/trunk/gsdl/bin/script/pluginfo.pl @ 12640

Revision 12640, 6.1 KB (checked in by mdewsnip, 14 years ago)

Now returns valid XML instead of an error when -listall and -describeall is specified and the directory doesn't exist (usually collection-specific).

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
Line 
1#!/usr/bin/perl -w
2
3###########################################################################
4#
5# pluginfo.pl --
6# A component of the Greenstone digital library software
7# from the New Zealand Digital Library Project at the
8# University of Waikato, New Zealand.
9#
10# Copyright (C) 1999 New Zealand Digital Library Project
11#
12# This program is free software; you can redistribute it and/or modify
13# it under the terms of the GNU General Public License as published by
14# the Free Software Foundation; either version 2 of the License, or
15# (at your option) any later version.
16#
17# This program is distributed in the hope that it will be useful,
18# but WITHOUT ANY WARRANTY; without even the implied warranty of
19# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
20# GNU General Public License for more details.
21#
22# You should have received a copy of the GNU General Public License
23# along with this program; if not, write to the Free Software
24# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
25#
26###########################################################################
27
28# This program will print info about a plugin
29
30use strict;
31no strict 'subs'; # allow barewords (eg STDERR) as function arguments
32
33BEGIN {
34    die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
35    die "GSDLOS not set\n" unless defined $ENV{'GSDLOS'};
36    unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
37    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
38    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/plugins");
39}
40
41use plugin;
42use util;
43use gsprintf;
44use printusage;
45use parse2;
46
47my $arguments =
48    [ { 'name' => "collection",
49    'desc' => "{pluginfo.collection}",
50    'type' => "string",
51    'reqd' => "no" },
52      { 'name' => "xml",
53    'desc' => "{scripts.xml}",
54    'type' => "flag",
55    'reqd' => "no" },
56      { 'name' => "listall",
57    'desc' => "{scripts.listall}",
58    'type' => "flag",
59    'reqd' => "no" },
60      { 'name' => "describeall",
61    'desc' => "{scripts.describeall}",
62    'type' => "flag",
63    'reqd' => "no" },
64      { 'name' => "language",
65    'desc' => "{scripts.language}",
66    'type' => "string",
67    'reqd' => "no" } ];
68
69my $options = { 'name' => "pluginfo.pl",
70        'desc' => "{pluginfo.desc}",
71        'args' => $arguments };
72
73sub gsprintf
74{
75    return &gsprintf::gsprintf(@_);
76}
77
78
79sub main {
80    my $collection = "";
81    my $xml = 0;
82    my $listall = 0;
83    my $describeall = 0;
84    my ($language, $encoding);
85
86    my $hashParsingResult = {};
87    # general options available to all plugins
88    my $unparsed_args = parse2::parse(\@ARGV,$arguments,$hashParsingResult,"allow_extra_options");
89    # parse returns -1 if an error occurred
90    if ($unparsed_args == -1) {
91   
92    PrintUsage::print_txt_usage($options, "{pluginfo.params}");
93    die "\n";
94    }
95   
96    foreach my $strVariable (keys %$hashParsingResult)
97    {
98    my $value = $hashParsingResult->{$strVariable};
99    # test to make sure the variable name is 'safe'
100    if ($strVariable !~ /^\w+$/) {
101        die "variable name '$strVariable' isn't safe!";
102    }
103    eval "\$$strVariable = \$value";
104    }
105
106    # if language wasn't specified, see if it is set in the environment
107    # (LC_ALL or LANG)
108    if (!$language && ($_=$ENV{'LC_ALL'} or $_=$ENV{'LANG'})) {
109    m/^([^\.]+)\.?(.*)/;
110    $language=$1;
111    $encoding=$2; # might be undef...
112# gsprintf::load_language* thinks "fr" is completely different to "fr_FR"...
113    $language =~ s/_.*$//;
114    }
115
116    # If $language has been set, load the appropriate resource bundle
117    # (Otherwise, the default resource bundle will be loaded automatically)
118    if ($language) {
119    gsprintf::load_language_specific_resource_bundle($language);
120    if ($encoding) {
121        $encoding =~ tr/-/_/;
122        $encoding = lc($encoding);
123        $encoding =~ s/utf_8/utf8/; # special
124        $gsprintf::specialoutputencoding=$encoding;
125    }
126    }
127
128    # If there is not exactly 1 argument left (plugin name), then the arguments were wrong
129    # If the user specified -h, then we output the usage also
130    if((@ARGV && $ARGV[0] =~ /^\-+h/) )
131    {
132    PrintUsage::print_txt_usage($options, "{pluginfo.params}"); 
133        die "\n";
134    }
135
136    # If there is not exactly 1 argument left (plugin name), then the arguments were wrong (apart from if we had listall or describeall set)
137    if ($listall == 0 && $describeall ==0 && $unparsed_args == 0) {
138    gsprintf(STDERR, "{pluginfo.no_plugin_name}\n\n");
139    PrintUsage::print_txt_usage($options, "{pluginfo.params}", 1);
140    die "\n";
141    }
142
143    # we had some arguments that we weren't expecting
144    if ($unparsed_args > 1) {
145    pop(@ARGV); # assume that the last arg is the plugin name
146    gsprintf(STDERR, "{common.invalid_options}\n\n", join (',', @ARGV));
147    PrintUsage::print_txt_usage($options, "{pluginfo.params}", 1);
148    die "\n";
149    }
150   
151    my $plugin = shift (@ARGV);
152    if (defined $plugin) {
153    $plugin =~ s/\.pm$//; # allow xxxPlug.pm as the argument
154    }
155
156    if ($collection ne "") {
157    $ENV{'GSDLCOLLECTDIR'} = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $collection);
158    } else {
159    $ENV{'GSDLCOLLECTDIR'} = $ENV{'GSDLHOME'};
160    }
161
162    if ($listall || $describeall) {
163    my $plugins_dir = &util::filename_cat($ENV{'GSDLCOLLECTDIR'}, "perllib", "plugins");
164    my @plugin_list = ();
165    if (opendir (INDIR, $plugins_dir)) {
166        @plugin_list = grep (/Plug\.pm$/, readdir (INDIR));
167        closedir (INDIR);
168    }
169
170    print STDERR "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
171    print STDERR "<PluginList length=\"" . scalar(@plugin_list) . "\">\n";
172    foreach my $plugin (@plugin_list) {
173        $plugin =~ s/\.pm$//;
174        my $plugobj = &plugin::load_plugin_for_info ($plugin);
175        if ($describeall) {
176        $plugobj->print_xml_usage(0);
177        }
178        else {
179        $plugobj->print_xml_usage(0, 1);
180        }
181    }
182    print STDERR "</PluginList>\n";
183    }
184    else {
185    &print_single_plugin($plugin, $xml, 1);
186    }
187}
188
189
190sub print_single_plugin {
191    my ($plugin, $xml, $header) = @_;
192    my $plugobj = &plugin::load_plugin_for_info ($plugin);
193    if ($xml) {
194    $plugobj->print_xml_usage($header);
195    }
196    else {
197    gsprintf(STDERR, "\n{pluginfo.passing_options}\n\n");
198    gsprintf(STDERR, "{pluginfo.option_types}:\n\n");
199    gsprintf(STDERR, "{pluginfo.specific_options}\n\n");
200    gsprintf(STDERR, "{pluginfo.general_options}\n\n");
201    gsprintf(STDERR, "$plugin {pluginfo.info}:\n\n");
202   
203    $plugobj->print_txt_usage();
204    }
205   
206}
207
208&main ();
Note: See TracBrowser for help on using the browser.