root/main/trunk/greenstone2/bin/script/pluginfo.pl @ 25167

Revision 25167, 9.0 KB (checked in by kjdon, 8 years ago)

load up hte plugins before writing out the xml so that any error messages are not inside the XML output

  • 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/cpan/perl-5.8");
39    unshift (@INC, "$ENV{'GSDLHOME'}/perllib/plugins");
40
41    if (defined $ENV{'GSDLEXTS'}) {
42    my @extensions = split(/:/,$ENV{'GSDLEXTS'});
43    foreach my $e (@extensions) {
44        my $ext_prefix = "$ENV{'GSDLHOME'}/ext/$e";
45
46        unshift (@INC, "$ext_prefix/perllib");
47        unshift (@INC, "$ext_prefix/perllib/cpan");
48        unshift (@INC, "$ext_prefix/perllib/plugins");
49    }
50    }
51    if (defined $ENV{'GSDL3EXTS'}) {
52    my @extensions = split(/:/,$ENV{'GSDL3EXTS'});
53    foreach my $e (@extensions) {
54        my $ext_prefix = "$ENV{'GSDL3SRCHOME'}/ext/$e";
55
56        unshift (@INC, "$ext_prefix/perllib");
57        unshift (@INC, "$ext_prefix/perllib/cpan");
58        unshift (@INC, "$ext_prefix/perllib/plugins");
59    }
60    }
61
62}
63
64use plugin;
65use util;
66use gsprintf;
67use printusage;
68use parse2;
69
70my $arguments =
71    [ { 'name' => "site",
72    'desc' => "{pluginfo.site}",
73    'type' => "string",
74    'reqd' => "no" },
75      { 'name' => "collection",
76    'desc' => "{pluginfo.collection}",
77    'type' => "string",
78    'reqd' => "no" },
79      { 'name' => "xml",
80    'desc' => "{scripts.xml}",
81    'type' => "flag",
82    'reqd' => "no" },
83      { 'name' => "listall",
84    'desc' => "{scripts.listall}",
85    'type' => "flag",
86    'reqd' => "no" },
87      { 'name' => "describeall",
88    'desc' => "{scripts.describeall}",
89    'type' => "flag",
90    'reqd' => "no" },
91      { 'name' => "language",
92    'desc' => "{scripts.language}",
93    'type' => "string",
94    'reqd' => "no" } ];
95
96my $options = { 'name' => "pluginfo.pl",
97        'desc' => "{pluginfo.desc}",
98        'args' => $arguments };
99
100sub gsprintf
101{
102    return &gsprintf::gsprintf(@_);
103}
104
105
106sub main {
107    my $site = "";
108    my $collection = "";
109    my $xml = 0;
110    my $listall = 0;
111    my $describeall = 0;
112    my ($language, $encoding);
113
114    my $hashParsingResult = {};
115    # general options available to all plugins
116    my $unparsed_args = parse2::parse(\@ARGV,$arguments,$hashParsingResult,"allow_extra_options");
117    # parse returns -1 if an error occurred
118    if ($unparsed_args == -1) {
119   
120    PrintUsage::print_txt_usage($options, "{pluginfo.params}");
121    die "\n";
122    }
123   
124    foreach my $strVariable (keys %$hashParsingResult)
125    {
126    my $value = $hashParsingResult->{$strVariable};
127    # test to make sure the variable name is 'safe'
128    if ($strVariable !~ /^\w+$/) {
129        die "variable name '$strVariable' isn't safe!";
130    }
131    eval "\$$strVariable = \$value";
132    }
133
134    # if language wasn't specified, see if it is set in the environment
135    # (LC_ALL or LANG)
136    if (!$language && ($_=$ENV{'LC_ALL'} or $_=$ENV{'LANG'})) {
137    m/^([^\.]+)\.?(.*)/;
138    $language=$1;
139    $encoding=$2; # might be undef...
140# gsprintf::load_language* thinks "fr" is completely different to "fr_FR"...
141    $language =~ s/_.*$//;
142    }
143
144    # If $language has been set, load the appropriate resource bundle
145    # (Otherwise, the default resource bundle will be loaded automatically)
146    if ($language) {
147    gsprintf::load_language_specific_resource_bundle($language);
148    if ($encoding) {
149        $encoding =~ tr/-/_/;
150        $encoding = lc($encoding);
151        $encoding =~ s/utf_8/utf8/; # special
152        $gsprintf::specialoutputencoding=$encoding;
153    }
154    }
155
156    # If there is not exactly 1 argument left (plugin name), then the arguments were wrong
157    # If the user specified -h, then we output the usage also
158    if((@ARGV && $ARGV[0] =~ /^\-+h/) )
159    {
160    PrintUsage::print_txt_usage($options, "{pluginfo.params}"); 
161        die "\n";
162    }
163
164    # If there is not exactly 1 argument left (plugin name), then the arguments were wrong (apart from if we had listall or describeall set)
165    if ($listall == 0 && $describeall ==0 && $unparsed_args == 0) {
166    gsprintf(STDERR, "{pluginfo.no_plugin_name}\n\n");
167    PrintUsage::print_txt_usage($options, "{pluginfo.params}", 1);
168    die "\n";
169    }
170
171    # we had some arguments that we weren't expecting
172    if ($unparsed_args > 1) {
173    pop(@ARGV); # assume that the last arg is the plugin name
174    gsprintf(STDERR, "{common.invalid_options}\n\n", join (',', @ARGV));
175    PrintUsage::print_txt_usage($options, "{pluginfo.params}", 1);
176    die "\n";
177    }
178   
179    my $plugin = shift (@ARGV);
180    if (defined $plugin) {
181    $plugin =~ s/\.pm$//; # allow xxxPlugin.pm as the argument
182    }
183
184    if ($site ne "") {
185    # assume Greenstone 3
186    if ($collection ne "") {
187        $ENV{'GSDLCOLLECTDIR'} = &util::filename_cat ($ENV{'GSDL3HOME'}, "sites", $site, "collect", $collection);
188    } else {
189        # Probably more useful to default to GS2 area for plugins
190        $ENV{'GSDLCOLLECTDIR'} = $ENV{'GSDLHOME'};
191    }
192    }
193    else {
194    if ($collection ne "") {
195        $ENV{'GSDLCOLLECTDIR'} = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $collection);
196    } else {
197        $ENV{'GSDLCOLLECTDIR'} = $ENV{'GSDLHOME'};
198    }
199    }
200
201    if ($listall || $describeall) {
202    my $plugins_dir = &util::filename_cat($ENV{'GSDLCOLLECTDIR'}, "perllib", "plugins");
203    my @plugin_list = ();
204    if (opendir (INDIR, $plugins_dir)) {
205        @plugin_list = grep (/Plugin\.pm$/, readdir (INDIR));
206        closedir (INDIR);
207    }
208
209    if ((defined $ENV{'GSDLEXTS'}) && ($collection eq "")) {
210        my @extensions = split(/:/,$ENV{'GSDLEXTS'});
211        foreach my $e (@extensions) {
212        my $ext_prefix = &util::filename_cat($ENV{'GSDLHOME'},"ext",$e);
213        my $ext_plugins_dir = &util::filename_cat($ext_prefix, "perllib", "plugins");
214
215        if (opendir (INDIR, $ext_plugins_dir)) {
216            my @ext_plugin_list = grep (/Plugin\.pm$/, readdir (INDIR));
217            closedir (INDIR);
218
219            push(@plugin_list,@ext_plugin_list);
220        }
221
222        }
223    }
224    if ((defined $ENV{'GSDL3EXTS'}) && ($collection eq "")) {
225        my @extensions = split(/:/,$ENV{'GSDL3EXTS'});
226        foreach my $e (@extensions) {
227        my $ext_prefix = &util::filename_cat($ENV{'GSDL3SRCHOME'},"ext",$e);
228        my $ext_plugins_dir = &util::filename_cat($ext_prefix, "perllib", "plugins");
229
230        if (opendir (INDIR, $ext_plugins_dir)) {
231            my @ext_plugin_list = grep (/Plugin\.pm$/, readdir (INDIR));
232            closedir (INDIR);
233
234            push(@plugin_list,@ext_plugin_list);
235        }
236
237        }
238    }
239
240    # load up the plugins before writing out the xml so that any error
241    # messages are not inside the XML output (can cause parsing to fail)
242    my @plugobj_list;
243    foreach my $plugin (@plugin_list) {
244        $plugin =~ s/\.pm$//;
245        my $plugobj = &plugin::load_plugin_for_info ($plugin);
246        push (@plugobj_list, $plugobj);
247    }
248    print STDERR "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
249    print STDERR "<PluginList length=\"" . scalar(@plugin_list) . "\">\n";
250    foreach my $plugobj (@plugobj_list) {
251        if ($describeall) {
252        $plugobj->print_xml_usage(0);
253        }
254        else {
255        $plugobj->print_xml_usage(0, 1);
256        }
257    }
258    print STDERR "</PluginList>\n";
259
260
261    }
262    else {
263    &print_single_plugin($plugin, $xml, 1);
264    }
265}
266
267
268sub print_single_plugin {
269    my ($plugin, $xml, $header) = @_;
270    my $plugobj = &plugin::load_plugin_for_info ($plugin);
271    if ($xml) {
272    $plugobj->print_xml_usage($header);
273    }
274    else {
275
276    # this causes us to automatically send output to a pager, if one is
277    # set, AND our output is going to a terminal
278    # active state perl on windows doesn't do open(handle, "-|");
279    if ($ENV{'GSDLOS'} !~ /windows/ && -t STDOUT) {
280        my $pager = $ENV{"PAGER"};
281        if (! $pager) {$pager="(less || more)"}
282        my $pid = open(STDIN, "-|"); # this does a fork... see man perlipc(1)
283        if (!defined $pid) {
284        gsprintf(STDERR, "pluginfo.pl - can't fork: $!");
285        } else {
286        if ($pid != 0) { # parent (ie forking) process. child gets 0
287            exec ($pager);
288        }
289        }
290        open(STDERR,">&STDOUT"); # so it's easier to pipe output
291    }
292
293    gsprintf(STDERR, "\n{pluginfo.passing_options}\n\n");
294    gsprintf(STDERR, "{pluginfo.option_types}:\n\n");
295    gsprintf(STDERR, "{pluginfo.specific_options}\n\n");
296    gsprintf(STDERR, "{pluginfo.general_options}\n\n");
297    gsprintf(STDERR, "$plugin {pluginfo.info}:\n\n");
298   
299    $plugobj->print_txt_usage();
300    }
301   
302}
303
304&main ();
Note: See TracBrowser for help on using the browser.