source: main/trunk/greenstone2/perllib/plugins/PrintInfo.pm@ 32783

Last change on this file since 32783 was 32761, checked in by kjdon, 5 years ago

when printing out arg values for some other thing, I noticed that site was getting values of other args. So just resetting in case other args come in between them.
  • Property svn:executable set to *
File size: 9.4 KB
Line 
1###########################################################################
2#
3# PrintInfo - most base plugin
4#
5# A component of the Greenstone digital library software
6# from the New Zealand Digital Library Project at the
7# University of Waikato, New Zealand.
8#
9# Copyright (C) 2008 New Zealand Digital Library Project
10#
11# This program is free software; you can redistribute it and/or modify
12# it under the terms of the GNU General Public License as published by
13# the Free Software Foundation; either version 2 of the License, or
14# (at your option) any later version.
15#
16# This program is distributed in the hope that it will be useful,
17# but WITHOUT ANY WARRANTY; without even the implied warranty of
18# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19# GNU General Public License for more details.
20#
21# You should have received a copy of the GNU General Public License
22# along with this program; if not, write to the Free Software
23# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
24#
25###########################################################################
26
27## Most basic plugin, just handles parsing the arguments and printing out descriptions. Used for plugins and Extractor plugins
28
29package PrintInfo;
30
31BEGIN {
32 die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
33}
34
35eval {require bytes};
36eval "require diagnostics"; # some perl distros (eg mac) don't have this
37
38# suppress the annoying "subroutine redefined" warning that various
39# plugins cause under perl 5.6
40$SIG{__WARN__} = sub {warn($_[0]) unless ($_[0] =~ /Subroutine\s+\S+\sredefined/)};
41
42use strict;
43no strict 'subs';
44
45use gsprintf 'gsprintf';
46use parse2;
47use printusage;
48
49my $arguments = [
50 { 'name' => "gs_version",
51 'desc' => "{PrintInfo.gs_version}",
52 'type' => "string",
53 'reqd' => "no",
54 'hiddengli' => "yes" },
55 { 'name' => "site",
56 'desc' => "{PrintInfo.site}",
57 'type' => "string",
58 'reqd' => "no",
59 'hiddengli' => "yes" }
60
61];
62
63my $options = { 'name' => "PrintInfo",
64 'desc' => "{PrintInfo.desc}",
65 'abstract' => "yes",
66 'inherits' => "no",
67 'args' => $arguments };
68
69# $auxiliary_plugin argument passed in by "on-the-side" plugin helpers such as Extractors and ImageConverter. We don't want parsing of args done by them.
70sub new
71{
72 my $class = shift (@_);
73 my ($pluginlist,$args,$hashArgOptLists, $auxiliary) = @_;
74 my $plugin_name = (defined $pluginlist->[0]) ? $pluginlist->[0] : $class;
75
76 if ($plugin_name eq $class) {
77 push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
78 push(@{$hashArgOptLists->{"OptList"}},$options);
79 }
80 my $self = {};
81 $self->{'outhandle'} = STDERR;
82 $self->{'option_list'} = $hashArgOptLists->{"OptList"};
83 $self->{"info_only"} = 0;
84 $self->{'gs_version'} = "2";
85 # Check if gsdlinfo is in the argument list or not - if it is, don't parse
86 # the args, just return the object.
87 # gsdlinfo must come before gs_version. both are set by plugin.pm
88 # The optional -site <site-name> (present only for GS3 and when not doing gsdlinfo),
89 # if it is there, also appears before gs_version and is also set by plugin.pm
90 my $v=0;
91 foreach my $strArg (@{$args})
92 {
93 if($v eq "-site") {
94 $self->{'site'} = $strArg;
95 $v=0;
96 }
97 elsif($v eq "-gs_version") {
98 $self->{'gs_version'} = $strArg;
99 $v=0;
100 last;
101 }
102 elsif($strArg eq "-gsdlinfo")
103 {
104 $self->{"info_only"} = 1;
105 #return bless $self, $class;
106 }
107 elsif ($strArg eq "-gs_version" || $strArg eq "-site") {
108 $v = $strArg;
109 }
110 }
111
112 if ($self->{"info_only"}) {
113 return bless $self, $class;
114 }
115 if (defined $auxiliary) { # don't parse the args here
116 return bless $self, $class;
117 }
118
119 # now that we are passed printing out info, we do need to add in this class's options so that they are available for parsing.
120 if ($plugin_name ne $class) {
121 push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
122 push(@{$hashArgOptLists->{"OptList"}},$options);
123 }
124
125 if(parse2::parse($args,$hashArgOptLists->{"ArgList"},$self) == -1)
126 {
127 my $classTempClass = bless $self, $class;
128 print STDERR "<BadPlugin p=$plugin_name>\n";
129 &gsprintf(STDERR, "\n{PrintInfo.bad_general_option}\n", $plugin_name);
130 $classTempClass->print_txt_usage(""); # Use default resource bundle
131 die "\n";
132 }
133
134 delete $self->{"info_only"};
135 # else parsing was successful.
136
137 $self->{'plugin_type'} = $plugin_name;
138
139 return bless $self, $class;
140
141}
142
143#sub init {
144#}
145
146sub set_incremental {
147 my $self = shift(@_);
148 my ($incremental_mode) = @_;
149
150 if (!defined $incremental_mode) {
151 $self->{'incremental'} = 0;
152 $self->{'incremental_mode'} = "none";
153 }
154 elsif ($incremental_mode eq "all") {
155 $self->{'incremental'} = 1;
156 $self->{'incremental_mode'} = "all";
157 }
158 else {
159 # none, onlyadd
160 $self->{'incremental'} = 0;
161 $self->{'incremental_mode'} = $incremental_mode;
162 }
163}
164
165sub get_arguments
166{
167 my $self = shift(@_);
168 my $optionlistref = $self->{'option_list'};
169 my @optionlist = @$optionlistref;
170 my $pluginoptions = pop(@$optionlistref);
171 my $pluginarguments = $pluginoptions->{'args'};
172 return $pluginarguments;
173}
174
175
176sub print_xml_usage
177{
178 my $self = shift(@_);
179 my $header = shift(@_);
180 my $high_level_information_only = shift(@_);
181
182 # XML output is always in UTF-8
183 gsprintf::output_strings_in_UTF8;
184
185 if ($header) {
186 &PrintUsage::print_xml_header("plugin");
187 }
188 $self->print_xml($high_level_information_only);
189}
190
191
192sub print_xml
193{
194 my $self = shift(@_);
195 my $high_level_information_only = shift(@_);
196
197 my $optionlistref = $self->{'option_list'};
198 my @optionlist = @$optionlistref;
199 my $pluginoptions = shift(@$optionlistref);
200 return if (!defined($pluginoptions));
201
202 # Find the process and block default expressions in the plugin arguments
203 my $process_exp = "";
204 my $block_exp = "";
205 if (defined($pluginoptions->{'args'})) {
206 foreach my $option (@{$pluginoptions->{'args'}}) {
207 if ($option->{'name'} eq "process_exp") {
208 $process_exp = $option->{'deft'};
209 }
210 if ($option->{'name'} eq "block_exp") {
211 $block_exp = $option->{'deft'};
212 }
213 }
214 }
215
216 gsprintf(STDERR, "<PlugInfo>\n");
217 gsprintf(STDERR, " <Name>$pluginoptions->{'name'}</Name>\n");
218 my $desc = gsprintf::lookup_string($pluginoptions->{'desc'});
219 $desc =~ s/</&amp;lt;/g; # doubly escaped
220 $desc =~ s/>/&amp;gt;/g;
221 gsprintf(STDERR, " <Desc>$desc</Desc>\n");
222 gsprintf(STDERR, " <Abstract>$pluginoptions->{'abstract'}</Abstract>\n");
223 gsprintf(STDERR, " <Inherits>$pluginoptions->{'inherits'}</Inherits>\n");
224 gsprintf(STDERR, " <Processes>$process_exp</Processes>\n");
225 gsprintf(STDERR, " <Blocks>$block_exp</Blocks>\n");
226 gsprintf(STDERR, " <Explodes>" . ($pluginoptions->{'explodes'} || "no") . "</Explodes>\n");
227 # adding new option that works with replace_srcdoc_with_html.pl
228 gsprintf(STDERR, " <SourceReplaceable>" . ($pluginoptions->{'srcreplaceable'} || "no") . "</SourceReplaceable>\n");
229 unless (defined($high_level_information_only)) {
230 gsprintf(STDERR, " <Arguments>\n");
231 if (defined($pluginoptions->{'args'})) {
232 &PrintUsage::print_options_xml($pluginoptions->{'args'});
233 }
234 gsprintf(STDERR, " </Arguments>\n");
235
236 # Recurse up the plugin hierarchy
237 $self->print_xml();
238 }
239 gsprintf(STDERR, "</PlugInfo>\n");
240}
241
242
243sub print_txt_usage
244{
245 my $self = shift(@_);
246 # Print the usage message for a plugin (recursively)
247 my $descoffset = $self->determine_description_offset(0);
248 $self->print_plugin_usage($descoffset, 1);
249}
250
251
252sub determine_description_offset
253{
254 my $self = shift(@_);
255 my $maxoffset = shift(@_);
256
257 my $optionlistref = $self->{'option_list'};
258 my @optionlist = @$optionlistref;
259 my $pluginoptions = shift(@$optionlistref);
260 return $maxoffset if (!defined($pluginoptions));
261
262 # Find the length of the longest option string of this plugin
263 my $pluginargs = $pluginoptions->{'args'};
264 if (defined($pluginargs)) {
265 my $longest = &PrintUsage::find_longest_option_string($pluginargs);
266 if ($longest > $maxoffset) {
267 $maxoffset = $longest;
268 }
269 }
270
271 # Recurse up the plugin hierarchy
272 $maxoffset = $self->determine_description_offset($maxoffset);
273 $self->{'option_list'} = \@optionlist;
274 return $maxoffset;
275}
276
277
278sub print_plugin_usage
279{
280 my $self = shift(@_);
281 my $descoffset = shift(@_);
282 my $isleafclass = shift(@_);
283
284 my $optionlistref = $self->{'option_list'};
285 my @optionlist = @$optionlistref;
286 my $pluginoptions = shift(@$optionlistref);
287 return if (!defined($pluginoptions));
288
289 my $pluginname = $pluginoptions->{'name'};
290 my $pluginargs = $pluginoptions->{'args'};
291 my $plugindesc = $pluginoptions->{'desc'};
292
293 # Produce the usage information using the data structure above
294 if ($isleafclass) {
295 if (defined($plugindesc)) {
296 gsprintf(STDERR, "$plugindesc\n\n");
297 }
298 gsprintf(STDERR, " {common.usage}: plugin $pluginname [{common.options}]\n\n");
299 }
300
301 # Display the plugin options, if there are some
302 if (defined($pluginargs)) {
303 # Calculate the column offset of the option descriptions
304 my $optiondescoffset = $descoffset + 2; # 2 spaces between options & descriptions
305
306 if ($isleafclass) {
307 gsprintf(STDERR, " {common.specific_options}:\n");
308 }
309 else {
310 gsprintf(STDERR, " {common.general_options}:\n", $pluginname);
311 }
312
313 # Display the plugin options
314 &PrintUsage::print_options_txt($pluginargs, $optiondescoffset);
315 }
316
317 # Recurse up the plugin hierarchy
318 $self->print_plugin_usage($descoffset, 0);
319 $self->{'option_list'} = \@optionlist;
320}
321
322
3231;
324
325
Note: See TracBrowser for help on using the repository browser.