source: trunk/gsdl/perllib/printusage.pm@ 6940

Last change on this file since 6940 was 6934, checked in by mdewsnip, 20 years ago

Hopefully the last piece of the multilingual output functionality: uses the output encoding specified in the resource bundle. (Most times the output won't be wanted in UTF-8 -- rather an 8-bit encoding such as ISO 8859-1 suitable for terminals).
  • Property svn:keywords set to Author Date Id Revision
File size: 10.0 KB
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;
31
32
33sub gsprintf
34{
35 return &gsprintf::gsprintf(@_);
36}
37
38
39sub print_xml_usage
40{
41 my $options = shift(@_);
42
43 # XML output is always in UTF-8
44 my $currentencoding = &gsprintf::get_output_encoding();
45 &gsprintf::set_output_encoding("UTF-8");
46
47 &print_xml_header();
48
49 &gsprintf(STDERR, "<Info>\n");
50 &gsprintf(STDERR, " <Name>$options->{'name'}</Name>\n");
51 &gsprintf(STDERR, " <Desc>$options->{'desc'}</Desc>\n");
52 &gsprintf(STDERR, " <Arguments>\n");
53 if (defined($options->{'args'})) {
54 &print_options_xml($options->{'args'});
55 }
56 &gsprintf(STDERR, " </Arguments>\n");
57 &gsprintf(STDERR, "</Info>\n");
58
59 # Put the output encoding back to what it was
60 &gsprintf::set_output_encoding($currentencoding);
61}
62
63
64sub print_xml_header
65{
66 &gsprintf(STDERR, "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n");
67 &gsprintf(STDERR, "<!DOCTYPE Info [\n");
68 &gsprintf(STDERR, " <!ELEMENT Info (Name, Desc, Arguments)>\n");
69 &gsprintf(STDERR, " <!ELEMENT Arguments (Option*)>\n");
70 &gsprintf(STDERR, " <!ELEMENT Option (Name, Desc, Type, Required, Range, Default?, List?)>\n");
71 &gsprintf(STDERR, " <!ELEMENT Name (#PCDATA)>\n");
72 &gsprintf(STDERR, " <!ELEMENT Desc (#PCDATA)>\n");
73 &gsprintf(STDERR, " <!ELEMENT Type (#PCDATA)>\n");
74 &gsprintf(STDERR, " <!ELEMENT Required (#PCDATA)>\n");
75 &gsprintf(STDERR, " <!ELEMENT Range (#PCDATA)>\n");
76 &gsprintf(STDERR, " <!ELEMENT Default (#PCDATA)>\n");
77 &gsprintf(STDERR, " <!ELEMENT List (Value*)>\n");
78 &gsprintf(STDERR, " <!ELEMENT Value (Name, Desc?)>\n");
79 &gsprintf(STDERR, " <!ELEMENT HiddenGLI (#PCDATA)>\n");
80 &gsprintf(STDERR, "]>\n\n");
81}
82
83
84sub print_options_xml
85{
86 my $options = shift(@_);
87
88 foreach $option (@$options) {
89 my $optionname = $option->{'name'};
90 my $optiondesc = &gsprintf::lookup_string($option->{'desc'});
91
92 # Escape '<' and '>' characters
93 $optiondesc =~ s/</&lt;/g;
94 $optiondesc =~ s/>/&gt;/g;
95
96 # Display option name, description and type
97 &gsprintf(STDERR, " <Option>\n");
98 &gsprintf(STDERR, " <Name>$optionname</Name>\n");
99 &gsprintf(STDERR, " <Desc>$optiondesc</Desc>\n");
100 &gsprintf(STDERR, " <Type>$option->{'type'}</Type>\n");
101
102 # If the option has a required field, display this
103 if (defined($option->{'reqd'})) {
104 &gsprintf(STDERR, " <Required>$option->{'reqd'}</Required>\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 $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/</&lt;/g;
124 $optionvaluedesc =~ s/>/&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 $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 my $programdesc = shift(@_);
175
176 my $programname = $options->{'name'};
177 my $programargs = $options->{'args'};
178
179 # Find the length of the longest option string
180 my $descoffset = 0;
181 if (defined($programargs)) {
182 $descoffset = &find_longest_option_string($programargs);
183 }
184
185 # Produce the usage information using the data structure above
186 if ($programdesc) {
187 &gsprintf(STDERR, $programname . ": $options->{'desc'}\n\n");
188 }
189 &gsprintf(STDERR, " {common.usage}: $programname $params\n\n");
190
191 # Display the program options, if there are some
192 if (defined($programargs)) {
193 # Calculate the column offset of the option descriptions
194 my $optiondescoffset = $descoffset + 2; # 2 spaces between options & descriptions
195
196 &gsprintf(STDERR, " {common.options}:\n");
197
198 # Display the program options
199 &print_options_txt($programargs, $optiondescoffset);
200 }
201}
202
203
204sub print_options_txt
205{
206 my $options = shift(@_);
207 my $optiondescoffset = shift(@_);
208
209 foreach $option (@$options) {
210 # Display option name
211 my $optionname = $option->{'name'};
212 &gsprintf(STDERR, " -$optionname");
213 my $optionstringlength = length(" -$optionname");
214
215 # Display option type, if the option is not a flag
216 my $optiontype = $option->{'type'};
217 if ($optiontype ne "flag") {
218 &gsprintf(STDERR, " <$optiontype>");
219 $optionstringlength = $optionstringlength + length(" <$optiontype>");
220 }
221
222 # Display the option description
223 my $optiondesc = &gsprintf::lookup_string($option->{'desc'});
224 my $optionreqd = $option->{'reqd'};
225 if (defined($optionreqd) && $optionreqd eq "yes") {
226 $optiondesc = "(" . &gsprintf::lookup_string("{PrintUsage.required}") . ") " . $optiondesc;
227 }
228 &display_text_in_column($optiondesc, $optiondescoffset, $optionstringlength, 80);
229
230 # Show the default value for the option, if there is one
231 my $optiondefault = $option->{'deft'};
232 if (defined($optiondefault)) {
233 &gsprintf(STDERR, " " x $optiondescoffset);
234 &gsprintf(STDERR, "{PrintUsage.default}: $optiondefault\n");
235 }
236
237 # If the option has a list of possible values, display these
238 my $optionvalueslist = $option->{'list'};
239 if (defined($optionvalueslist)) {
240 &gsprintf(STDERR, "\n");
241 foreach $optionvalue (@$optionvalueslist) {
242 my $optionvaluename = $optionvalue->{'name'};
243 &gsprintf(STDERR, " " x $optiondescoffset);
244 &gsprintf(STDERR, "$optionvaluename:");
245
246 my $optionvaluedesc = &gsprintf::lookup_string($optionvalue->{'desc'});
247 &display_text_in_column($optionvaluedesc, $optiondescoffset + 2,
248 $optiondescoffset + length($optionvaluename), 80);
249 }
250 }
251
252 # Special case for 'input_encoding'
253 if ($optionname =~ m/^input_encoding$/i) {
254 my $e = $encodings::encodings;
255 foreach $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) {
256 &gsprintf(STDERR, " " x $optiondescoffset);
257 &gsprintf(STDERR, "$enc:");
258
259 my $encodingdesc = $e->{$enc}->{'name'};
260 &display_text_in_column($encodingdesc, $optiondescoffset + 2,
261 $optiondescoffset + length("$enc:"), 80);
262 }
263 }
264
265 # Add a blank line to separate options
266 &gsprintf(STDERR, "\n");
267 }
268}
269
270
271sub display_text_in_column
272{
273 my ($text, $columnbeg, $firstlineoffset, $columnend) = @_;
274
275 # Spaces are put *before* words, so treat the column beginning as 1 smaller than it is
276 $columnbeg = $columnbeg - 1;
277
278 # Add some padding (if needed) for the first line
279 my $linelength = $columnbeg;
280 if ($firstlineoffset < $columnbeg) {
281 &gsprintf(STDERR, " " x ($columnbeg - $firstlineoffset));
282 }
283 else {
284 $linelength = $firstlineoffset;
285 }
286
287 # Break the text into words, and display one at a time
288 my @words = split(/ /, $text);
289
290 foreach $word (@words) {
291 # If printing this word would exceed the column end, start a new line
292 if (($linelength + length($word)) >= $columnend) {
293 &gsprintf(STDERR, "\n");
294 &gsprintf(STDERR, " " x $columnbeg);
295 $linelength = $columnbeg;
296 }
297
298 # Write the word
299 &gsprintf(STDERR, " $word");
300 $linelength = $linelength + length(" $word");
301 }
302
303 &gsprintf(STDERR, "\n");
304}
305
306
307sub find_longest_option_string
308{
309 my $options = shift(@_);
310
311 my $maxlength = 0;
312 foreach $option (@$options) {
313 my $optionname = $option->{'name'};
314 my $optiontype = $option->{'type'};
315
316 my $optionlength = length(" -$optionname");
317 if ($optiontype ne "flag") {
318 $optionlength = $optionlength + length(" <$optiontype>");
319 }
320
321 # Remember the longest
322 if ($optionlength > $maxlength) {
323 $maxlength = $optionlength;
324 }
325 }
326 return $maxlength;
327}
328
329
3301;
Note: See TracBrowser for help on using the repository browser.