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

Last change on this file since 10350 was 10350, checked in by kjdon, 19 years ago

added a check for defined before removing the .pm

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 6.0 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;
45
46use parse2;
47
48my $arguments =
49 [ { 'name' => "collect",
50 'desc' => "{pluginfo.collect}",
51 'type' => "string",
52 'reqd' => "no" },
53 { 'name' => "xml",
54 'desc' => "{scripts.xml}",
55 'type' => "flag",
56 'reqd' => "no" },
57 { 'name' => "listall",
58 'desc' => "{scripts.listall}",
59 'type' => "flag",
60 'reqd' => "no" },
61 { 'name' => "language",
62 'desc' => "{scripts.language}",
63 'type' => "string",
64 'reqd' => "no" } ];
65
66my $options = { 'name' => "pluginfo.pl",
67 'desc' => "{pluginfo.desc}",
68 'args' => $arguments };
69
70sub gsprintf
71{
72 return &gsprintf::gsprintf(@_);
73}
74
75
76sub main {
77 my $collect = "";
78 my $xml = 0;
79 my $listall = 0;
80
81 my ($language, $encoding);
82
83 my $hashParsingResult = {};
84 my $blnParseFailed = "false";
85 # general options available to all plugins
86 my $intArgLeftinAfterParsing = parse2::parse(\@ARGV,$arguments,$hashParsingResult,"allow_extra_options");
87 # If there are more than one argument left after parsing, it mean user input too many arguments.
88 # Error occoured will return 0
89 if($intArgLeftinAfterParsing > 1)
90 {
91 &PrintUsage::print_txt_usage($options, "{pluginfo.params}");
92 die "\n";
93 }
94
95 foreach my $strVariable (keys %$hashParsingResult)
96 {
97 eval "\$$strVariable = \$hashParsingResult->{\"\$strVariable\"}";
98 }
99
100 # if language wasn't specified, see if it is set in the environment
101 # (LC_ALL or LANG)
102 if (!$language && ($_=$ENV{'LC_ALL'} or $_=$ENV{'LANG'})) {
103 m/^([^\.]+)\.?(.*)/;
104 $language=$1;
105 $encoding=$2; # might be undef...
106# gsprintf::load_language* thinks "fr" is completely different to "fr_FR"...
107 $language =~ s/_.*$//;
108 }
109
110 # If $language has been set, load the appropriate resource bundle
111 # (Otherwise, the default resource bundle will be loaded automatically)
112 if ($language) {
113 gsprintf::load_language_specific_resource_bundle($language);
114 if ($encoding) {
115 $encoding =~ tr/-/_/;
116 $encoding = lc($encoding);
117 $encoding =~ s/utf_8/utf8/; # special
118 $gsprintf::specialoutputencoding=$encoding;
119 }
120 }
121
122 my $plugin = shift (@ARGV);
123 if (defined $plugin) {
124 $plugin =~ s/\.pm$//; # allow xxxPlug.pm as the argument
125 }
126 if (($listall == 0) && (!defined $plugin || $plugin eq "")) {
127 gsprintf(STDERR, "{pluginfo.no_plugin_name}\n\n");
128 PrintUsage::print_txt_usage($options, "{pluginfo.params}", 1);
129 die "\n";
130 }
131
132 if ($collect ne "") {
133 $ENV{'GSDLCOLLECTDIR'} = &util::filename_cat ($ENV{'GSDLHOME'}, "collect", $collect);
134 } else {
135 $ENV{'GSDLCOLLECTDIR'} = $ENV{'GSDLHOME'};
136 }
137
138 if ($listall) {
139 my $plugin_dir = &util::filename_cat($ENV{'GSDLCOLLECTDIR'},"perllib","plugins");
140
141 if (!opendir (INDIR, $plugin_dir)) {
142 print STDERR "pluginfo.pl: could not open directory $plugin_dir\n";
143 } else {
144 my @plugin_list = grep (/Plug\.pm$/, readdir (INDIR));
145 closedir (INDIR);
146
147
148 if ($xml) {
149 my $num_plugins = scalar(@plugin_list);
150
151 print STDERR "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
152 print STDERR "<!DOCTYPE PluginList [\n";
153 print STDERR " <!ELEMENT PluginList (PluginName*)>\n";
154 print STDERR " <!ELEMENT PlugName (#PCDATA)>\n";
155 print STDERR " <!ATTLIST PluginList\n";
156 print STDERR " length CDATA #REQUIRED>\n";
157 print STDERR "]>\n";
158
159 print STDERR "<PluginList length=\"$num_plugins\">\n";
160 map { print STDERR " <PluginName>$_</PluginName>\n"; } @plugin_list;
161 print STDERR "</PluginList>\n";
162
163 }
164 else {
165 print STDERR join(" ",@plugin_list), "\n";
166 }
167 }
168
169 }
170 else {
171
172 my $pluginfo = &plugin::load_plugins ([[$plugin]]);
173 my $plugobj = shift @$pluginfo;
174
175 if ($xml) {
176 $plugobj->print_xml_usage();
177 }
178 else {
179 gsprintf(STDERR, "\n{pluginfo.passing_options}\n\n");
180 gsprintf(STDERR, "{pluginfo.option_types}:\n\n");
181 gsprintf(STDERR, "{pluginfo.specific_options}\n\n");
182 gsprintf(STDERR, "{pluginfo.general_options}\n\n");
183 gsprintf(STDERR, "$plugin {pluginfo.info}:\n\n");
184
185 $plugobj->print_txt_usage();
186 }
187 }
188}
189
190
191# this causes us to automatically send output to a pager, if one is
192# set, AND our output is going to a terminal
193# active state perl on windows doesn't do open(handle, "-|");
194if ($ENV{'GSDLOS'} !~ /windows/ && -t STDOUT) {
195 my $pager = $ENV{"PAGER"};
196 if (! $pager) {$pager="(less || more)"}
197 my $pid = open(STDIN, "-|"); # this does a fork... see man perlipc(1)
198 if (!defined $pid) {
199 gsprintf(STDERR, "pluginfo.pl - can't fork: $!");
200 } else {
201 if ($pid != 0) { # parent (ie forking) process. child gets 0
202 exec ($pager);
203 }
204 }
205 open(STDERR,">&STDOUT"); # so it's easier to pipe output
206}
207
208
209&main ();
Note: See TracBrowser for help on using the repository browser.