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

Revision 14942, 6.4 KB (checked in by davidb, 12 years ago)

Modification to support extensions. BEGIN block now adds perllib/ perllib/cpan to @INC for each extension.

  • 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    if (defined $ENV{'GSDLEXTS'}) {
41    my @extensions = split(/:/,$ENV{'GSDLEXTS'});
42    foreach my $e (@extensions) {
43        my $ext_prefix = "$ENV{'GSDLHOME'}/ext/$e";
44
45        unshift (@INC, "$ext_prefix/perllib");
46        unshift (@INC, "$ext_prefix/perllib/cpan");
47    }
48    }
49}
50
51use plugin;
52use util;
53use gsprintf;
54use printusage;
55use parse2;
56
57my $arguments =
58    [ { 'name' => "collection",
59    'desc' => "{pluginfo.collection}",
60    'type' => "string",
61    'reqd' => "no" },
62      { 'name' => "xml",
63    'desc' => "{scripts.xml}",
64    'type' => "flag",
65    'reqd' => "no" },
66      { 'name' => "listall",
67    'desc' => "{scripts.listall}",
68    'type' => "flag",
69    'reqd' => "no" },
70      { 'name' => "describeall",
71    'desc' => "{scripts.describeall}",
72    'type' => "flag",
73    'reqd' => "no" },
74      { 'name' => "language",
75    'desc' => "{scripts.language}",
76    'type' => "string",
77    'reqd' => "no" } ];
78
79my $options = { 'name' => "pluginfo.pl",
80        'desc' => "{pluginfo.desc}",
81        'args' => $arguments };
82
83sub gsprintf
84{
85    return &gsprintf::gsprintf(@_);
86}
87
88
89sub main {
90    my $collection = "";
91    my $xml = 0;
92    my $listall = 0;
93    my $describeall = 0;
94    my ($language, $encoding);
95
96    my $hashParsingResult = {};
97    # general options available to all plugins
98    my $unparsed_args = parse2::parse(\@ARGV,$arguments,$hashParsingResult,"allow_extra_options");
99    # parse returns -1 if an error occurred
100    if ($unparsed_args == -1) {
101   
102    PrintUsage::print_txt_usage($options, "{pluginfo.params}");
103    die "\n";
104    }
105   
106    foreach my $strVariable (keys %$hashParsingResult)
107    {
108    my $value = $hashParsingResult->{$strVariable};
109    # test to make sure the variable name is 'safe'
110    if ($strVariable !~ /^\w+$/) {
111        die "variable name '$strVariable' isn't safe!";
112    }
113    eval "\$$strVariable = \$value";
114    }
115
116    # if language wasn't specified, see if it is set in the environment
117    # (LC_ALL or LANG)
118    if (!$language && ($_=$ENV{'LC_ALL'} or $_=$ENV{'LANG'})) {
119    m/^([^\.]+)\.?(.*)/;
120    $language=$1;
121    $encoding=$2; # might be undef...
122# gsprintf::load_language* thinks "fr" is completely different to "fr_FR"...
123    $language =~ s/_.*$//;
124    }
125
126    # If $language has been set, load the appropriate resource bundle
127    # (Otherwise, the default resource bundle will be loaded automatically)
128    if ($language) {
129    gsprintf::load_language_specific_resource_bundle($language);
130    if ($encoding) {
131        $encoding =~ tr/-/_/;
132        $encoding = lc($encoding);
133        $encoding =~ s/utf_8/utf8/; # special
134        $gsprintf::specialoutputencoding=$encoding;
135    }
136    }
137
138    # If there is not exactly 1 argument left (plugin name), then the arguments were wrong
139    # If the user specified -h, then we output the usage also
140    if((@ARGV && $ARGV[0] =~ /^\-+h/) )
141    {
142    PrintUsage::print_txt_usage($options, "{pluginfo.params}"); 
143        die "\n";
144    }
145
146    # If there is not exactly 1 argument left (plugin name), then the arguments were wrong (apart from if we had listall or describeall set)
147    if ($listall == 0 && $describeall ==0 && $unparsed_args == 0) {
148    gsprintf(STDERR, "{pluginfo.no_plugin_name}\n\n");
149    PrintUsage::print_txt_usage($options, "{pluginfo.params}", 1);
150    die "\n";
151    }
152
153    # we had some arguments that we weren't expecting
154    if ($unparsed_args > 1) {
155    pop(@ARGV); # assume that the last arg is the plugin name
156    gsprintf(STDERR, "{common.invalid_options}\n\n", join (',', @ARGV));
157    PrintUsage::print_txt_usage($options, "{pluginfo.params}", 1);
158    die "\n";
159    }
160   
161    my $plugin = shift (@ARGV);
162    if (defined $plugin) {
163    $plugin =~ s/\.pm$//; # allow xxxPlug.pm as the argument
164    }
165
166    if ($collection ne "") {
167    $ENV{'GSDLCOLLECTDIR'} = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $collection);
168    } else {
169    $ENV{'GSDLCOLLECTDIR'} = $ENV{'GSDLHOME'};
170    }
171
172    if ($listall || $describeall) {
173    my $plugins_dir = &util::filename_cat($ENV{'GSDLCOLLECTDIR'}, "perllib", "plugins");
174    my @plugin_list = ();
175    if (opendir (INDIR, $plugins_dir)) {
176        @plugin_list = grep (/Plug\.pm$/, readdir (INDIR));
177        closedir (INDIR);
178    }
179
180    print STDERR "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
181    print STDERR "<PluginList length=\"" . scalar(@plugin_list) . "\">\n";
182    foreach my $plugin (@plugin_list) {
183        $plugin =~ s/\.pm$//;
184        my $plugobj = &plugin::load_plugin_for_info ($plugin);
185        if ($describeall) {
186        $plugobj->print_xml_usage(0);
187        }
188        else {
189        $plugobj->print_xml_usage(0, 1);
190        }
191    }
192    print STDERR "</PluginList>\n";
193    }
194    else {
195    &print_single_plugin($plugin, $xml, 1);
196    }
197}
198
199
200sub print_single_plugin {
201    my ($plugin, $xml, $header) = @_;
202    my $plugobj = &plugin::load_plugin_for_info ($plugin);
203    if ($xml) {
204    $plugobj->print_xml_usage($header);
205    }
206    else {
207    gsprintf(STDERR, "\n{pluginfo.passing_options}\n\n");
208    gsprintf(STDERR, "{pluginfo.option_types}:\n\n");
209    gsprintf(STDERR, "{pluginfo.specific_options}\n\n");
210    gsprintf(STDERR, "{pluginfo.general_options}\n\n");
211    gsprintf(STDERR, "$plugin {pluginfo.info}:\n\n");
212   
213    $plugobj->print_txt_usage();
214    }
215   
216}
217
218&main ();
Note: See TracBrowser for help on using the browser.