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

Last change on this file since 14942 was 14942, checked in by davidb, 13 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
File size: 6.4 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 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 repository browser.