root/main/trunk/greenstone2/perllib/printusage.pm @ 21341

Revision 21341, 10.7 KB (checked in by kjdon, 10 years ago)

can add internal => 'true' to plugin/classifier option, and it won't get printed out with pluginfo. use for internal options

  • Property svn:keywords set to Author Date Id Revision
Line 
1###########################################################################
2#
3# printusage.pm --
4# A component of the Greenstone digital library software
5# from the New Zealand Digital Library Project at the
6# University of Waikato, New Zealand.
7#
8# Copyright (C) 1999 New Zealand Digital Library Project
9#
10# This program is free software; you can redistribute it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either version 2 of the License, or
13# (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23#
24###########################################################################
25
26
27package PrintUsage;
28
29
30use gsprintf;
31use strict;
32no strict 'subs'; # allow barewords (eg STDERR) as function arguments
33
34
35sub gsprintf
36{
37    return &gsprintf::gsprintf(@_);
38}
39
40# this is not called by plugins or classifiers, just by scripts
41sub print_xml_usage
42{
43    my $options = shift(@_);
44
45    # XML output is always in UTF-8
46    &gsprintf::output_strings_in_UTF8;
47
48    &print_xml_header("script");
49
50    &gsprintf(STDERR, "<Info>\n");
51    &gsprintf(STDERR, "  <Name>$options->{'name'}</Name>\n");
52    &gsprintf(STDERR, "  <Desc>$options->{'desc'}</Desc>\n");
53    &gsprintf(STDERR, "  <Arguments>\n");
54    if (defined($options->{'args'})) {
55    &print_options_xml($options->{'args'});
56    }
57    &gsprintf(STDERR, "  </Arguments>\n");
58    &gsprintf(STDERR, "</Info>\n");
59}
60
61
62sub print_xml_header
63{
64    &gsprintf(STDERR, "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n");
65}
66
67
68sub print_options_xml
69{
70    my $options = shift(@_);
71
72    foreach my $option (@$options) {
73    next if defined($option->{'internal'});
74   
75    my $optionname = $option->{'name'};
76    my $displayname = $option->{'disp'};
77   
78    my $optiondesc = &gsprintf::lookup_string($option->{'desc'});
79
80    # Escape '<' and '>' characters
81    $optiondesc =~ s/</&amp;lt;/g; # doubly escaped
82    $optiondesc =~ s/>/&amp;gt;/g;
83
84    # Display option name, description and type
85    &gsprintf(STDERR, "    <Option>\n");
86    &gsprintf(STDERR, "      <Name>$optionname</Name>\n");
87    if (defined($option->{'disp'})) {
88        my $displayname = &gsprintf::lookup_string($option->{'disp'});
89        # Escape '<' and '>' characters
90        $displayname =~ s/</&amp;lt;/g; # doubly escaped
91        $displayname =~ s/>/&amp;gt;/g;
92        &gsprintf(STDERR, "      <DisplayName>$displayname</DisplayName>\n");
93    }
94    &gsprintf(STDERR, "      <Desc>$optiondesc</Desc>\n");
95    &gsprintf(STDERR, "      <Type>$option->{'type'}</Type>\n");
96
97    # If the option has a required field, display this
98    if (defined($option->{'reqd'})) {
99        &gsprintf(STDERR, "      <Required>$option->{'reqd'}</Required>\n");
100    }
101
102    # If the option has a charactor length field, display this
103    if (defined($option->{'char_length'})) {
104        &gsprintf(STDERR, "      <CharactorLength>$option->{'char_length'}</CharactorLength>\n");
105    }
106
107    # If the option has a range field, display this
108    if (defined($option->{'range'})) {
109        &gsprintf(STDERR, "      <Range>$option->{'range'}</Range>\n");
110    }
111
112    # If the option has a list of possible values, display these
113    if (defined $option->{'list'}) {
114        &gsprintf(STDERR, "      <List>\n");
115        my $optionvalueslist = $option->{'list'};
116        foreach my $optionvalue (@$optionvalueslist) {
117        &gsprintf(STDERR, "        <Value>\n");
118        &gsprintf(STDERR, "          <Name>$optionvalue->{'name'}</Name>\n");
119        if (defined $optionvalue->{'desc'}) {
120            my $optionvaluedesc = &gsprintf::lookup_string($optionvalue->{'desc'});
121
122            # Escape '<' and '>' characters
123            $optionvaluedesc =~ s/</&amp;lt;/g; #doubly escaped
124            $optionvaluedesc =~ s/>/&amp;gt;/g;
125
126            &gsprintf(STDERR, "          <Desc>$optionvaluedesc</Desc>\n");
127        }
128        &gsprintf(STDERR, "        </Value>\n");
129        }
130
131#       # Special case for 'input_encoding'
132#       if ($optionname =~ m/^input_encoding$/i) {
133#       my $e = $encodings::encodings;
134#       foreach my $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) {
135#           &gsprintf(STDERR, "        <Value>\n");
136#           &gsprintf(STDERR, "          <Name>$enc</Name>\n");
137#           &gsprintf(STDERR, "          <Desc>$e->{$enc}->{'name'}</Desc>\n");
138#           &gsprintf(STDERR, "        </Value>\n");
139#       }
140#       }
141
142        &gsprintf(STDERR, "      </List>\n");
143    }
144
145    # Show the default value for the option, if there is one
146    if (defined $option->{'deft'}) {
147        my $optiondeftvalue = $option->{'deft'};
148
149        # Escape '<' and '>' characters
150        $optiondeftvalue =~ s/</&lt;/g;
151        $optiondeftvalue =~ s/>/&gt;/g;
152
153        &gsprintf(STDERR, "      <Default>$optiondeftvalue</Default>\n");
154    }
155
156    # If the option is noted as being hidden in GLI, add that to the printout
157    if (defined($option->{'hiddengli'})) {
158        &gsprintf(STDERR, "      <HiddenGLI>$option->{'hiddengli'}</HiddenGLI>\n");
159    }
160    # If the argument is not hidden then print out the lowest detail mode it is visible in
161    if (defined($option->{'modegli'})) {
162        &gsprintf(STDERR, "      <ModeGLI>$option->{'modegli'}</ModeGLI>\n");
163    }
164
165    &gsprintf(STDERR, "    </Option>\n");
166    }
167}
168
169
170sub print_txt_usage
171{
172    my $options = shift(@_);
173    my $params = shift(@_);
174
175    # this causes us to automatically send output to a pager, if one is
176    # set, AND our output is going to a terminal
177    # active state perl on windows doesn't do open(handle, "-|");
178    if ($ENV{'GSDLOS'} !~ /windows/ && -t STDOUT) {
179        my $pager = $ENV{"PAGER"};
180    if (! $pager) {$pager="(less || more)"}
181    my $pid = open(STDIN, "-|"); # this does a fork... see man perlipc(1)
182    if (!defined $pid) {
183        gsprintf(STDERR, "pluginfo.pl - can't fork: $!");
184    } else {
185        if ($pid != 0) { # parent (ie forking) process. child gets 0
186        exec ($pager);
187        }
188    }
189    open(STDERR,">&STDOUT"); # so it's easier to pipe output
190    }
191
192
193
194    my $programname = $options->{'name'};
195    my $programargs = $options->{'args'};
196    my $programdesc = $options->{'desc'};
197
198    # Find the length of the longest option string
199    my $descoffset = 0;
200    if (defined($programargs)) {
201    $descoffset = &find_longest_option_string($programargs);
202    }
203
204    # Produce the usage information using the data structure above
205    if (defined($programdesc)) {
206    &gsprintf(STDERR, $programname . ": $options->{'desc'}\n\n");
207    }
208
209    &gsprintf(STDERR, " {common.usage}: $programname $params\n\n");
210
211    # Display the program options, if there are some
212    if (defined($programargs)) {
213    # Calculate the column offset of the option descriptions
214    my $optiondescoffset = $descoffset + 2;  # 2 spaces between options & descriptions
215
216    &gsprintf(STDERR, " {common.options}:\n");
217
218    # Display the program options
219    &print_options_txt($programargs, $optiondescoffset);
220    }
221}
222
223
224sub print_options_txt
225{
226    my $options = shift(@_);
227    my $optiondescoffset = shift(@_);
228
229    foreach my $option (@$options) {
230    next if defined($option->{'internal'});
231
232    # Display option name
233    my $optionname = $option->{'name'};
234    &gsprintf(STDERR, "  -$optionname");
235    my $optionstringlength = length("  -$optionname");
236
237    # Display option type, if the option is not a flag
238    my $optiontype = $option->{'type'};
239    if ($optiontype ne "flag") {
240        &gsprintf(STDERR, " <$optiontype>");
241        $optionstringlength = $optionstringlength + length(" <$optiontype>");
242    }
243
244    # Display the option description   
245    if (defined($option->{'disp'})) {
246        my $optiondisp = &gsprintf::lookup_string($option->{'disp'});
247        &display_text_in_column($optiondisp, $optiondescoffset, $optionstringlength, 80);
248        &gsprintf(STDERR, " " x $optionstringlength);
249    }
250    my $optiondesc = &gsprintf::lookup_string($option->{'desc'});
251    my $optionreqd = $option->{'reqd'};
252    if (defined($optionreqd) && $optionreqd eq "yes") {
253        $optiondesc = "(" . &gsprintf::lookup_string("{PrintUsage.required}") . ") " . $optiondesc;
254    }
255    &display_text_in_column($optiondesc, $optiondescoffset, $optionstringlength, 80);
256
257    # Show the default value for the option, if there is one
258    my $optiondefault = $option->{'deft'};
259    if (defined($optiondefault)) {
260        &gsprintf(STDERR, " " x $optiondescoffset);
261        &gsprintf(STDERR, "{PrintUsage.default}: $optiondefault\n");
262    }
263
264    # If the option has a list of possible values, display these
265    my $optionvalueslist = $option->{'list'};
266    if (defined($optionvalueslist)) {
267        &gsprintf(STDERR, "\n");
268        foreach my $optionvalue (@$optionvalueslist) {
269        my $optionvaluename = $optionvalue->{'name'};
270        &gsprintf(STDERR, " " x $optiondescoffset);
271        &gsprintf(STDERR, "$optionvaluename:");
272
273        my $optionvaluedesc = &gsprintf::lookup_string($optionvalue->{'desc'});
274        &display_text_in_column($optionvaluedesc, $optiondescoffset + 2,
275                    $optiondescoffset + length($optionvaluename), 80);
276        }
277    }
278
279#   # Special case for 'input_encoding'
280#   if ($optionname =~ m/^input_encoding$/i) {
281#       my $e = $encodings::encodings;
282#       foreach my $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) {
283#       &gsprintf(STDERR, " " x $optiondescoffset);
284#       &gsprintf(STDERR, "$enc:");
285#
286#       my $encodingdesc = $e->{$enc}->{'name'};
287#       &display_text_in_column($encodingdesc, $optiondescoffset + 2,
288#                   $optiondescoffset + length("$enc:"), 80);
289#       }
290#   }
291
292    # Add a blank line to separate options
293    &gsprintf(STDERR, "\n");
294    }
295}
296
297
298sub display_text_in_column
299{
300    my ($text, $columnbeg, $firstlineoffset, $columnend) = @_;
301
302    # Spaces are put *before* words, so treat the column beginning as 1 smaller than it is
303    $columnbeg = $columnbeg - 1;
304
305    # Add some padding (if needed) for the first line
306    my $linelength = $columnbeg;
307    if ($firstlineoffset < $columnbeg) {
308    &gsprintf(STDERR, " " x ($columnbeg - $firstlineoffset));
309    }
310    else {
311    $linelength = $firstlineoffset;
312    }
313
314    # Break the text into words, and display one at a time
315    my @words = split(/ /, $text);
316
317    foreach my $word (@words) {
318    # If printing this word would exceed the column end, start a new line
319    if (($linelength + length($word)) >= $columnend) {
320        &gsprintf(STDERR, "\n");
321        &gsprintf(STDERR, " " x $columnbeg);
322        $linelength = $columnbeg;
323    }
324
325    # Write the word
326    &gsprintf(STDERR, " $word");
327    $linelength = $linelength + length(" $word");
328    }
329
330    &gsprintf(STDERR, "\n");
331}
332
333
334sub find_longest_option_string
335{
336    my $options = shift(@_);
337
338    my $maxlength = 0;
339    foreach my $option (@$options) {
340    my $optionname = $option->{'name'};
341    my $optiontype = $option->{'type'};
342
343    my $optionlength = length("  -$optionname");
344    if ($optiontype ne "flag") {
345        $optionlength = $optionlength + length(" <$optiontype>");
346    }
347
348    # Remember the longest
349    if ($optionlength > $maxlength) {
350        $maxlength = $optionlength;
351    }
352    }
353    return $maxlength;
354}
355
356
3571;
Note: See TracBrowser for help on using the browser.