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

Last change on this file since 12640 was 12640, checked in by mdewsnip, 16 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
File size: 6.1 KB
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 repository browser.