root/gsdl/trunk/perllib/plugins/PrintInfo.pm @ 16025

Revision 16025, 7.8 KB (checked in by kjdon, 12 years ago)

added license info

  • Property svn:executable set to *
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 browser.