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

Last change on this file since 5682 was 5682, checked in by mdewsnip, 21 years ago

Changed to use the gsprintf module, which makes using strings from the resource bundle much easier.

  • Property svn:keywords set to Author Date Id Revision
File size: 7.5 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 print_xml_header
34{
35 print STDERR "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
36 print STDERR "<!DOCTYPE Info [\n";
37 print STDERR " <!ELEMENT Info (Name, Desc, Arguments)>\n";
38 print STDERR " <!ELEMENT Arguments (Option*)>\n";
39 print STDERR " <!ELEMENT Option (Name, Desc, Type, Required, Default?, List?)>\n";
40 print STDERR " <!ELEMENT Name (#PCDATA)>\n";
41 print STDERR " <!ELEMENT Desc (#PCDATA)>\n";
42 print STDERR " <!ELEMENT Type (#PCDATA)>\n";
43 print STDERR " <!ELEMENT Required (#PCDATA)>\n";
44 print STDERR " <!ELEMENT Default (#PCDATA)>\n";
45 print STDERR " <!ELEMENT List (Value*)>\n";
46 print STDERR " <!ELEMENT Value (Name, Desc?)>\n";
47 print STDERR "]>\n\n";
48}
49
50
51sub print_options_xml
52{
53 local $language = shift(@_);
54 local $options = shift(@_);
55
56 foreach $option (@$options) {
57 local $optionname = $option->{'name'};
58 local $optiondesc = &gsprintf::lookup_string($language, $option->{'desc'});
59
60 # Escape '<' and '>' characters
61 $optiondesc =~ s/</&lt;/g;
62 $optiondesc =~ s/>/&gt;/g;
63
64 # Display option name, description and type
65 print STDERR " <Option>\n";
66 print STDERR " <Name>$optionname</Name>\n";
67 print STDERR " <Desc>$optiondesc</Desc>\n";
68 print STDERR " <Type>$option->{'type'}</Type>\n";
69
70 # If the option has a required field, display this
71 if (defined($option->{'reqd'})) {
72 print STDERR " <Required>$option->{'reqd'}</Required>\n";
73 }
74
75 # If the option has a list of possible values, display these
76 if (defined $option->{'list'}) {
77 print STDERR " <List>\n";
78 local $optionvalueslist = $option->{'list'};
79 foreach $optionvalue (@$optionvalueslist) {
80 print STDERR " <Value>\n";
81 print STDERR " <Name>$optionvalue->{'name'}</Name>\n";
82 if (defined $optionvalue->{'desc'}) {
83 local $optionvaluedesc = &gsprintf::lookup_string($language, $optionvalue->{'desc'});
84
85 # Escape '<' and '>' characters
86 $optionvaluedesc =~ s/</&lt;/g;
87 $optionvaluedesc =~ s/>/&gt;/g;
88
89 print STDERR " <Desc>$optionvaluedesc</Desc>\n";
90 }
91 print STDERR " </Value>\n";
92 }
93
94 # Special case for 'input_encoding'
95 if ($optionname =~ m/^input_encoding$/i) {
96 my $e = $encodings::encodings;
97 foreach $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) {
98 print STDERR " <Value>\n";
99 print STDERR " <Name>$enc</Name>\n";
100 print STDERR " <Desc>$e->{$enc}->{'name'}</Desc>\n";
101 print STDERR " </Value>\n";
102 }
103 }
104
105 print STDERR " </List>\n";
106 }
107
108 # Show the default value for the option, if there is one
109 if (defined $option->{'deft'}) {
110 print STDERR " <Default>$option->{'deft'}</Default>\n";
111 }
112
113 print STDERR " </Option>\n";
114 }
115}
116
117
118sub find_longest_option_string
119{
120 local $options = shift(@_);
121
122 local $maxlength = 0;
123 foreach $option (@$options) {
124 local $optionname = $option->{'name'};
125 local $optiontype = $option->{'type'};
126
127 local $optionlength = length(" -$optionname");
128 if ($optiontype ne "flag") {
129 $optionlength = $optionlength + length(" <$optiontype>");
130 }
131
132 # Remember the longest
133 if ($optionlength > $maxlength) {
134 $maxlength = $optionlength;
135 }
136 }
137 return $maxlength;
138}
139
140
141sub print_options_txt
142{
143 local $language = shift(@_);
144 local $options = shift(@_);
145 local $optiondescoffset = shift(@_);
146
147 foreach $option (@$options) {
148 # Display option name
149 local $optionname = $option->{'name'};
150 print STDERR " -$optionname";
151 local $optionstringlength = length(" -$optionname");
152
153 # Display option type, if the option is not a flag
154 local $optiontype = $option->{'type'};
155 if ($optiontype ne "flag") {
156 print STDERR " <$optiontype>";
157 $optionstringlength = $optionstringlength + length(" <$optiontype>");
158 }
159
160 # Display the option description
161 local $optiondesc = &gsprintf::lookup_string($language, $option->{'desc'});
162 local $optionreqd = $option->{'reqd'};
163 if (defined($optionreqd) && $optionreqd eq "yes") {
164 $optiondesc = "(" . &gsprintf::lookup_string($language, "{PrintUsage.required}") . ") " . $optiondesc;
165 }
166 &display_text_in_column($optiondesc, $optiondescoffset, $optionstringlength, 80);
167
168 # Show the default value for the option, if there is one
169 local $optiondefault = $option->{'deft'};
170 if (defined($optiondefault)) {
171 print STDERR " " x $optiondescoffset;
172 print STDERR &gsprintf::lookup_string($language, "{PrintUsage.default}");
173 print STDERR ": " . $optiondefault . "\n";
174 }
175
176 # If the option has a list of possible values, display these
177 local $optionvalueslist = $option->{'list'};
178 if (defined($optionvalueslist)) {
179 print STDERR "\n";
180 foreach $optionvalue (@$optionvalueslist) {
181 local $optionvaluename = $optionvalue->{'name'};
182 print STDERR " " x $optiondescoffset;
183 print STDERR "$optionvaluename:";
184
185 local $optionvaluedesc = &gsprintf::lookup_string($language, $optionvalue->{'desc'});
186 &display_text_in_column($optionvaluedesc, $optiondescoffset + 2,
187 $optiondescoffset + length($optionvaluename), 80);
188 }
189 }
190
191 # Special case for 'input_encoding'
192 if ($optionname =~ m/^input_encoding$/i) {
193 my $e = $encodings::encodings;
194 foreach $enc (sort {$e->{$a}->{'name'} cmp $e->{$b}->{'name'}} keys (%$e)) {
195 print STDERR " " x $optiondescoffset;
196 print STDERR "$enc:";
197
198 local $encodingdesc = $e->{$enc}->{'name'};
199 &display_text_in_column($encodingdesc, $optiondescoffset + 2,
200 $optiondescoffset + length("$enc:"), 80);
201 }
202 }
203
204 # Add a blank line to separate options
205 print STDERR "\n";
206 }
207}
208
209
210sub display_text_in_column
211{
212 local ($text, $columnbeg, $firstlineoffset, $columnend) = @_;
213
214 # Spaces are put *before* words, so treat the column beginning as 1 smaller than it is
215 $columnbeg = $columnbeg - 1;
216
217 # Add some padding (if needed) for the first line
218 local $linelength = $columnbeg;
219 if ($firstlineoffset < $columnbeg) {
220 print STDERR " " x ($columnbeg - $firstlineoffset);
221 }
222 else {
223 $linelength = $firstlineoffset;
224 }
225
226 # Break the text into words, and display one at a time
227 local @words = split(/ /, $text);
228
229 foreach $word (@words) {
230 # If printing this word would exceed the column end, start a new line
231 if (($linelength + length($word)) >= $columnend) {
232 print STDERR "\n";
233 print STDERR " " x $columnbeg;
234 $linelength = $columnbeg;
235 }
236
237 # Write the word
238 print STDERR " $word";
239 $linelength = $linelength + length(" $word");
240 }
241
242 print STDERR "\n";
243}
244
245
2461;
Note: See TracBrowser for help on using the repository browser.