source: gsdl/trunk/perllib/plugins/PrintInfo.pm@ 16025

Last change on this file since 16025 was 16025, checked in by kjdon, 13 years ago

added license info

  • Property svn:executable set to *
File size: 7.8 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};
36
37# suppress the annoying "subroutine redefined" warning that various
38# plugins cause under perl 5.6
39$SIG{__WARN__} = sub {warn($_[0]) unless ($_[0] =~ /Subroutine\s+\S+\sredefined/)};
40
41use strict;
42no strict 'subs';
43
44use gsprintf 'gsprintf';
45use parse2;
46use printusage;
47
48my $arguments = [];
49
50my $options = { 'name' => "PrintInfo",
51 'desc' => "{PrintInfo.desc}",
52 'abstract' => "yes",
53 'inherits' => "no",
54 'args' => $arguments };
55
56# $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.
57sub new
58{
59 my $class = shift (@_);
60 my ($pluginlist,$args,$hashArgOptLists, $auxiliary) = @_;
61 my $plugin_name = (defined $pluginlist->[0]) ? $pluginlist->[0] : $class;
62
63 if ($plugin_name eq $class) {
64 push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
65 push(@{$hashArgOptLists->{"OptList"}},$options);
66 }
67 my $self = {};
68 $self->{'outhandle'} = STDERR;
69 $self->{'option_list'} = $hashArgOptLists->{"OptList"};
70 $self->{"info_only"} = 0;
71
72 # Check if gsdlinfo is in the argument list or not - if it is, don't parse
73 # the args, just return the object.
74 foreach my $strArg (@{$args})
75 {
76 if($strArg eq "-gsdlinfo")
77 {
78 $self->{"info_only"} = 1;
79 return bless $self, $class;
80 }
81 }
82
83 if (defined $auxiliary) { # don't parse the args here
84 return bless $self, $class;
85 }
86
87 if(parse2::parse($args,$hashArgOptLists->{"ArgList"},$self) == -1)
88 {
89 my $classTempClass = bless $self, $class;
90 print STDERR "<BadPlugin p=$plugin_name>\n";
91 &gsprintf(STDERR, "\n{PrintInfo.bad_general_option}\n", $plugin_name);
92 $classTempClass->print_txt_usage(""); # Use default resource bundle
93 die "\n";
94 }
95
96 delete $self->{"info_only"};
97 # else parsing was successful.
98
99 $self->{'plugin_type'} = $plugin_name;
100
101 return bless $self, $class;
102
103}
104
105#sub init {
106#}
107
108sub get_arguments
109{
110 my $self = shift(@_);
111 my $optionlistref = $self->{'option_list'};
112 my @optionlist = @$optionlistref;
113 my $pluginoptions = pop(@$optionlistref);
114 my $pluginarguments = $pluginoptions->{'args'};
115 return $pluginarguments;
116}
117
118
119sub print_xml_usage
120{
121 my $self = shift(@_);
122 my $header = shift(@_);
123 my $high_level_information_only = shift(@_);
124
125 # XML output is always in UTF-8
126 gsprintf::output_strings_in_UTF8;
127
128 if ($header) {
129 &PrintUsage::print_xml_header("plugin");
130 }
131 $self->print_xml($high_level_information_only);
132}
133
134
135sub print_xml
136{
137 my $self = shift(@_);
138 my $high_level_information_only = shift(@_);
139
140 my $optionlistref = $self->{'option_list'};
141 my @optionlist = @$optionlistref;
142 my $pluginoptions = shift(@$optionlistref);
143 return if (!defined($pluginoptions));
144
145 # Find the process and block default expressions in the plugin arguments
146 my $process_exp = "";
147 my $block_exp = "";
148 if (defined($pluginoptions->{'args'})) {
149 foreach my $option (@{$pluginoptions->{'args'}}) {
150 if ($option->{'name'} eq "process_exp") {
151 $process_exp = $option->{'deft'};
152 }
153 if ($option->{'name'} eq "block_exp") {
154 $block_exp = $option->{'deft'};
155 }
156 }
157 }
158
159 gsprintf(STDERR, "<PlugInfo>\n");
160 gsprintf(STDERR, " <Name>$pluginoptions->{'name'}</Name>\n");
161 my $desc = gsprintf::lookup_string($pluginoptions->{'desc'});
162 $desc =~ s/</&amp;lt;/g; # doubly escaped
163 $desc =~ s/>/&amp;gt;/g;
164 gsprintf(STDERR, " <Desc>$desc</Desc>\n");
165 gsprintf(STDERR, " <Abstract>$pluginoptions->{'abstract'}</Abstract>\n");
166 gsprintf(STDERR, " <Inherits>$pluginoptions->{'inherits'}</Inherits>\n");
167 gsprintf(STDERR, " <Processes>$process_exp</Processes>\n");
168 gsprintf(STDERR, " <Blocks>$block_exp</Blocks>\n");
169 gsprintf(STDERR, " <Explodes>" . ($pluginoptions->{'explodes'} || "no") . "</Explodes>\n");
170 # adding new option that works with replace_srcdoc_with_html.pl
171 gsprintf(STDERR, " <SourceReplaceable>" . ($pluginoptions->{'srcreplaceable'} || "no") . "</SourceReplaceable>\n");
172 unless (defined($high_level_information_only)) {
173 gsprintf(STDERR, " <Arguments>\n");
174 if (defined($pluginoptions->{'args'})) {
175 &PrintUsage::print_options_xml($pluginoptions->{'args'});
176 }
177 gsprintf(STDERR, " </Arguments>\n");
178
179 # Recurse up the plugin hierarchy
180 $self->print_xml();
181 }
182 gsprintf(STDERR, "</PlugInfo>\n");
183}
184
185
186sub print_txt_usage
187{
188 my $self = shift(@_);
189 # Print the usage message for a plugin (recursively)
190 my $descoffset = $self->determine_description_offset(0);
191 $self->print_plugin_usage($descoffset, 1);
192}
193
194
195sub determine_description_offset
196{
197 my $self = shift(@_);
198 my $maxoffset = shift(@_);
199
200 my $optionlistref = $self->{'option_list'};
201 my @optionlist = @$optionlistref;
202 my $pluginoptions = shift(@$optionlistref);
203 return $maxoffset if (!defined($pluginoptions));
204
205 # Find the length of the longest option string of this plugin
206 my $pluginargs = $pluginoptions->{'args'};
207 if (defined($pluginargs)) {
208 my $longest = &PrintUsage::find_longest_option_string($pluginargs);
209 if ($longest > $maxoffset) {
210 $maxoffset = $longest;
211 }
212 }
213
214 # Recurse up the plugin hierarchy
215 $maxoffset = $self->determine_description_offset($maxoffset);
216 $self->{'option_list'} = \@optionlist;
217 return $maxoffset;
218}
219
220
221sub print_plugin_usage
222{
223 my $self = shift(@_);
224 my $descoffset = shift(@_);
225 my $isleafclass = shift(@_);
226
227 my $optionlistref = $self->{'option_list'};
228 my @optionlist = @$optionlistref;
229 my $pluginoptions = shift(@$optionlistref);
230 return if (!defined($pluginoptions));
231
232 my $pluginname = $pluginoptions->{'name'};
233 my $pluginargs = $pluginoptions->{'args'};
234 my $plugindesc = $pluginoptions->{'desc'};
235
236 # Produce the usage information using the data structure above
237 if ($isleafclass) {
238 if (defined($plugindesc)) {
239 gsprintf(STDERR, "$plugindesc\n\n");
240 }
241 gsprintf(STDERR, " {common.usage}: plugin $pluginname [{common.options}]\n\n");
242 }
243
244 # Display the plugin options, if there are some
245 if (defined($pluginargs)) {
246 # Calculate the column offset of the option descriptions
247 my $optiondescoffset = $descoffset + 2; # 2 spaces between options & descriptions
248
249 if ($isleafclass) {
250 gsprintf(STDERR, " {common.specific_options}:\n");
251 }
252 else {
253 gsprintf(STDERR, " {common.general_options}:\n", $pluginname);
254 }
255
256 # Display the plugin options
257 &PrintUsage::print_options_txt($pluginargs, $optiondescoffset);
258 }
259
260 # Recurse up the plugin hierarchy
261 $self->print_plugin_usage($descoffset, 0);
262 $self->{'option_list'} = \@optionlist;
263}
264
265
2661;
267
268
Note: See TracBrowser for help on using the repository browser.