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 |
|
---|
27 | package PrintUsage;
|
---|
28 |
|
---|
29 |
|
---|
30 | use gsprintf;
|
---|
31 |
|
---|
32 |
|
---|
33 | sub 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 |
|
---|
51 | sub 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/</</g;
|
---|
62 | $optiondesc =~ s/>/>/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/</</g;
|
---|
87 | $optionvaluedesc =~ s/>/>/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 |
|
---|
118 | sub 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 |
|
---|
141 | sub 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 |
|
---|
210 | sub 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 |
|
---|
246 | 1;
|
---|