man-page-fileserver-update-20080311
[openafs.git] / doc / xml / AdminReference / pod2refentry
1 #!/usr/bin/perl
2     eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
3         if $running_under_some_shell;
4
5 # Pod::RefEntry -- Convert POD data to DocBook RefEntry
6 #
7 # Copyright 2005, 2006 by Chas Williams <chas@cmf.nrl.navy.mil>
8 #
9 # This program is free software; you can redistribute it and/or modify it
10 # under the same terms as Perl itself.
11 #
12 # based on:
13 #
14 # Pod::PlainText -- Convert POD data to formatted ASCII text.
15 # $Id$
16 #
17 # Copyright 1999-2000 by Russ Allbery <rra@stanford.edu>
18 #
19 # This program is free software; you can redistribute it and/or modify it
20 # under the same terms as Perl itself.
21
22 package Pod::RefEntry;
23
24 require 5.005;
25
26 use Carp qw(carp);
27 use Pod::Select ();
28
29 use strict;
30 use vars qw(@ISA %ESCAPES $VERSION);
31
32 # We inherit from Pod::Select instead of Pod::Parser so that we can be used
33 # by Pod::Usage.
34 @ISA = qw(Pod::Select);
35
36 $VERSION = '0.06';
37
38 # This table is taken near verbatim from Pod::PlainText in Pod::Parser,
39 # which got it near verbatim from the original Pod::Text.  It is therefore
40 # credited to Tom Christiansen, and I'm glad I didn't have to write it.  :)
41 %ESCAPES = (
42     'amp'       =>    '&amp;',      # ampersand
43     'lt'        =>    '&lt;',      # left chevron, less-than
44     'gt'        =>    '&gt;',      # right chevron, greater-than
45     'quot'      =>    '"',      # double quote
46 );
47
48 # Initialize the object.  Must be sure to call our parent initializer.
49 sub initialize {
50     my $self = shift;
51
52     $$self{hlevel}   = 0  unless defined $$self{hlevel};
53     $$self{ltype}    = 0  unless defined $$self{ltype};
54     $$self{lopen}    = 0  unless defined $$self{lopen};
55     $$self{indent}   = 2  unless defined $$self{indent};
56     $$self{width}    = 76 unless defined $$self{width};
57     $$self{refnamediv} = 0;
58
59     $$self{LSTATE}   = [];
60     $$self{MARGIN}   = 0;               # Current left margin in spaces.
61
62     $self->SUPER::initialize;
63 }
64
65 sub begin_pod {
66     my $self = shift;
67
68     $self->output ("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n");
69 }
70
71 sub end_pod {
72     my $self = shift;
73     my $i;
74
75     for($i = 4; $i > 0; --$i) {
76         if ($$self{hlevel} >= $i) {
77             $self->{MARGIN} -= 2;
78             #$self->output ("</refsection>\n");
79             $self->output (sprintf "</refsect%d>\n", $i);
80         };
81     };
82
83     $self->{MARGIN} -= 2;
84     $self->output ("</refentry>\n");
85 }
86
87 # Called for each command paragraph.  Gets the command, the associated
88 # paragraph, the line number, and a Pod::Paragraph object.  Just dispatches
89 # the command to a method named the same as the command.  =cut is handled
90 # internally by Pod::Parser.
91 sub command {
92     my $self = shift;
93     my $command = shift;
94     return if $command eq 'pod';
95     return if ($$self{EXCLUDE} && $command ne 'end');
96     $self->item ("\n") if defined $$self{ITEM};
97     $command = 'cmd_' . $command;
98     $self->$command (@_);
99 }
100
101 # Called for a verbatim paragraph.  Gets the paragraph, the line number, and
102 # a Pod::Paragraph object.  Just output it verbatim, but with tabs converted
103 # to spaces.
104 sub verbatim {
105     my $self = shift;
106     return if $$self{EXCLUDE};
107     $self->item if defined $$self{ITEM};
108     local $_ = shift;
109     return if /^\s*$/;
110     $$self{MARGIN} += 2;
111     s/</&lt;/g;
112     s/>/&gt;/g;
113     s/&/&amp;/g;
114     my $saved = $$self{MARGIN};
115     $$self{MARGIN} = 0;
116     $self->output ("<programlisting>\n");
117     $self->output ($_);
118     $self->output ("</programlisting>\n");
119     $$self{MARGIN} = $saved;
120 }
121
122 sub escapes {
123     (undef, local $_) = @_;
124     s/(&)/\&amp;/g;
125     s/(<)/\&lt;/g;
126     s/(>)/\&gt;/g;
127     $_;
128 }
129
130 # Called for interior sequences.  Gets a Pod::InteriorSequence object
131 # and is expected to return the resulting text.
132 sub sequence {
133     my ($self, $seq) = @_;
134
135     my $cmd_name = $seq->cmd_name;
136
137     $seq->left_delimiter( '' );
138     $seq->right_delimiter( '' );
139     $seq->cmd_name( '' );
140     $_ = $seq->raw_text;
141
142     if ($cmd_name eq 'B') {
143         $_ = sprintf "<emphasis role=\"bold\">%s</emphasis>", $_;
144     } elsif ($cmd_name eq 'C') {
145         $_ = sprintf "<computeroutput>%s</computeroutput>", $_;
146     } elsif ($cmd_name eq 'F') {
147         $_ = sprintf "<replaceable>%s</replaceable>", $_;
148     } elsif ($cmd_name eq 'I') {
149         $_ = sprintf "<emphasis>%s</emphasis>", $_;
150     } elsif ($cmd_name eq 'S') {
151         # perhaps translate ' ' to &nbsp;
152         $_ = sprintf "%s", $_;
153     } elsif ($cmd_name eq 'L') {
154         $_ = $self->seq_l ($seq);
155     } elsif ($cmd_name eq 'E') {
156         if (defined $ESCAPES{$_}) {
157             $_ = $ESCAPES{$_} if defined $ESCAPES{$_};
158         } else {
159             carp "Unknown escape: E<$_>";
160         }
161     } else {
162         carp "\nUnknown sequence $cmd_name<$_>\n";
163     }
164
165     my $parent = $seq->nested;
166     if (defined $parent) {
167
168         if ($parent->cmd_name eq 'B') {
169             $_ = sprintf "</emphasis>%s<emphasis role=\"bold\">", $_;
170         } elsif ($parent->cmd_name eq 'C') {
171             $_ = sprintf "</computeroutput>%s<computeroutput>", $_;
172         } elsif ($parent->cmd_name eq 'F') {
173             $_ = sprintf "</replaceable>%s<replaceable>", $_;
174         } elsif ($parent->cmd_name eq 'I') {
175             $_ = sprintf "</emphasis>%s<emphasis>", $_;
176         }
177     }
178
179     return $_;
180 }
181
182 # Called for a regular text block.  Gets the paragraph, the line number, and
183 # a Pod::Paragraph object.  Perform parse_text and output the results.
184 sub textblock {
185     my $self = shift;
186     return if $$self{EXCLUDE};
187     $self->output ($_[0]), return if $$self{VERBATIM};
188     local $_ = shift;
189     my $line = shift;
190     my $name;
191     my $purpose;
192
193 #    /<http:.*>/ && do {
194 #        s/<http:([^>]+)\>/<ulink url=\"http:\1\">http:\1<\/ulink>/;
195 #    };
196 #
197 #    /<.*@.*>/ && do {
198 #        s/<([^>]+@[^>]+)>/<email>\1<\/email>/g;
199 #    };
200
201     $_ = $self->parse_text(
202         { -expand_text => q(escapes),
203           -expand_seq => q(sequence) },
204                                         $_, $line ) -> raw_text();
205
206     if (defined $$self{ITEM}) {
207         $self->item ($_ . "\n");
208     } elsif ($self->{refnamediv}) {
209         ($name, $purpose) = /(.+)\s+\-\s+(.+)/;
210         my $id = $name;
211         $id =~ s/,.*$//;                # only reference by first entry?
212         $id =~ s/[ \.,\(\)]/_/g;
213         if (defined $$self{section}) {
214             $id = sprintf "%s%d", $id, $$self{section};
215         }
216         $self->output ("<refentry id=\"$id\">\n");
217         $self->{MARGIN} += 2;
218         if (defined $$self{section}) {
219             $self->output ("<refmeta>\n");
220             $self->{MARGIN} += 2;
221             $self->output (sprintf "<refentrytitle>%s</refentrytitle>\n",  $name);
222             $self->output (sprintf "<manvolnum>%d</manvolnum>\n",  $$self{section});
223             $self->{MARGIN} -= 2;
224             $self->output ("</refmeta>\n");
225         }
226         $self->output ("<refnamediv>\n");
227         $self->{MARGIN} += 2;
228         $self->output ("<refname>$name</refname>\n");
229         $self->output ("<refpurpose>$purpose</refpurpose>\n");
230         $self->{MARGIN} -= 2;
231         $self->output ("</refnamediv>\n");
232         $self->{refnamediv} = 0;
233     } else {
234         s/\n+$//;
235         $self->output ("<para>" . $_ . "<\/para>" . "\n\n");
236     }
237 }
238
239 # Level headings.
240 sub cmd_head {
241     my $self = shift;
242     local $_ = shift;
243     my $line = shift;
244     my $level = $self->{level};
245     my $i;
246
247     for($i = 4; $i > 0; --$i) {
248         if ($level <= $i) {
249             if ($$self{hlevel} >= $i) {
250                 $$self{MARGIN} -= 2;
251                 #$self->output (sprintf "</refsection>\n", $i);
252                 $self->output (sprintf "</refsect%d>\n", $i);
253             }
254         }
255     }
256
257     # special, output next <para> as <refnamediv>
258     if ($level == 1 && $_ =~ /NAME/) {
259         $self->{refnamediv} = 1;
260         return;
261     }
262
263     #$self->output (sprintf "<refsection>\n", $level);
264     $self->output (sprintf "<refsect%d>\n", $level);
265     $$self{MARGIN} += 2;
266     s/\s+$//;
267     $_ = $self->parse_text(
268         { -expand_text => q(escapes),
269           -expand_seq => q(sequence) },
270                                         $_, $line ) -> raw_text();
271     if (/^[A-Z ]+$/) {
272         s/(\w+)/\u\L$1/g if $level == 1;        # kill capitalization
273     }
274     $self->output ("<title>" . $_ . "<\/title>" . "\n");
275     $$self{hlevel} = $level;
276 }
277
278 # First level heading.
279 sub cmd_head1 {
280     my $self = shift;
281     $self->{level} = 1;
282     $self->cmd_head (@_);
283 }
284
285 # Second level heading.
286 sub cmd_head2 {
287     my $self = shift;
288     $self->{level} = 2;
289     $self->cmd_head (@_);
290 }
291
292 # Third level heading.
293 sub cmd_head3 {
294     my $self = shift;
295     $self->{level} = 3;
296     $self->cmd_head (@_);
297 }
298
299 sub cmd_head4 {
300     my $self = shift;
301     # <refsect4> doesnt exist -- we would use <refsection>
302     # when it becomes available in 4.4
303     printf STDERR "=head4 being rendered as <refsect3>\n";
304     $self->{level} = 3;
305     $self->cmd_head (@_);
306 }
307
308 # Start a list.
309 sub cmd_over {
310     my $self = shift;
311     local $_ = shift;
312     unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} }
313     push (@{ $$self{LSTATE} }, $$self{lopen});
314     push (@{ $$self{LSTATE} }, $$self{ltype});
315     undef $self->{ltype};
316     $$self{lopen} = 0;
317 }
318
319 # End a list.
320 sub cmd_back {
321     my $self = shift;
322     if ($self->{ltype} == 2) {
323         $self->{MARGIN} -= 2;
324         $self->output ("</listitem>\n");
325         $self->{MARGIN} -= 2;
326         $self->output ("</orderedlist>\n");
327     } elsif ($self->{ltype} == 1) {
328         $self->{MARGIN} -= 2;
329         $self->output ("</listitem>\n");
330         $self->{MARGIN} -= 2;
331         $self->output ("</itemizedlist>\n");
332     } else {
333         $self->{MARGIN} -= 2;
334         $self->output ("</listitem>\n");
335         $self->{MARGIN} -= 2;
336         $self->output ("</varlistentry>\n");
337         $self->{MARGIN} -= 2;
338         $self->output ("</variablelist>\n");
339     }
340     $$self{ltype} = pop @{ $$self{LSTATE} };
341     $$self{lopen} = pop @{ $$self{LSTATE} };
342     unless (defined $$self{LSTATE}) {
343         carp "Unmatched =back";
344         $$self{MARGIN} = $$self{indent};
345     }
346 }
347
348 # An individual list item.
349 sub cmd_item {
350     my $self = shift;
351     if (defined $$self{ITEM}) { $self->item }
352     local $_ = shift;
353     my $line = shift;
354     s/\s+$//;
355     $$self{ITEM} = $self->parse_text(
356         { -expand_text => q(escapes),
357           -expand_seq => q(sequence) },
358                                         $_, $line ) -> raw_text();
359 }
360
361 # Begin a block for a particular translator.  Setting VERBATIM triggers
362 # special handling in textblock().
363 sub cmd_begin {
364     my $self = shift;
365     local $_ = shift;
366     my ($kind) = /^(\S+)/ or return;
367     if ($kind eq 'text') {
368         $$self{VERBATIM} = 1;
369     } else {
370         $$self{EXCLUDE} = 1;
371     }
372 }
373
374 # End a block for a particular translator.  We assume that all =begin/=end
375 # pairs are properly closed.
376 sub cmd_end {
377     my $self = shift;
378     $$self{EXCLUDE} = 0;
379     $$self{VERBATIM} = 0;
380 }    
381
382 # One paragraph for a particular translator.  Ignore it unless it's intended
383 # for text, in which case we treat it as a verbatim text block.
384 sub cmd_for {
385     my $self = shift;
386     local $_ = shift;
387     my $line = shift;
388     return unless s/^text\b[ \t]*\n?//;
389     $self->verbatim ($_, $line);
390 }
391
392 # The complicated one.  Handle links.  Since this is plain text, we can't
393 # actually make any real links, so this is all to figure out what text we
394 # print out.
395 sub seq_l {
396     my ($self, $seq) = @_;
397
398     s/>$//;     # remove trailing >
399
400     # Smash whitespace in case we were split across multiple lines.
401     s/\s+/ /g;
402
403     # If we were given any explicit text, just output it.
404     if (/^([^|]+)\|/) { return $1 }
405
406     # Okay, leading and trailing whitespace isn't important; get rid of it.
407     s/^\s+//;
408     s/\s+$//;
409
410     # Default to using the whole content of the link entry as a section
411     # name.  Note that L<manpage/> forces a manpage interpretation, as does
412     # something looking like L<manpage(section)>.  The latter is an
413     # enhancement over the original Pod::Text.
414     my ($manpage, $section) = ('', $_);
415     if (/^(?:https?|ftp|news):/) {
416         # a URL
417         return $_;
418     } elsif (/^"\s*(.*?)\s*"$/) {
419         $section = '"' . $1 . '"';
420     } elsif (m/^[-:.\w]+(?:\(\S+\))?$/) {
421         ($manpage, $section) = ($_, '');
422     } elsif (m%/%) {
423         ($manpage, $section) = split (/\s*\/\s*/, $_, 2);
424     }
425
426     $seq->cmd_name("");
427
428     # Now build the actual output text.
429     if (length $section) {
430         $section =~ s/^\"\s*//;
431         $section =~ s/\s*\"$//;
432         $_ = $section;
433         $_ .= " in $manpage" if length $manpage;
434     }
435     if (length $manpage) {
436         my $linkend = $manpage;
437         $linkend =~ s/[\(\)]//g;
438         $linkend =~ s/[ ,\.]/_/g;       # this needs to match <refentry id=
439         $seq->prepend("<link linkend=\"$linkend\">");
440         $seq->append("</link>");
441         return $seq;
442     } else {
443         return $_;
444     }
445 }
446
447 # This method is called whenever an =item command is complete (in other
448 # words, we've seen its associated paragraph or know for certain that it
449 # doesn't have one).  It gets the paragraph associated with the item as an
450 # argument.  If that argument is empty, just output the item tag; if it
451 # contains a newline, output the item tag followed by the newline.
452 # Otherwise, see if there's enough room for us to output the item tag in the
453 # margin of the text or if we have to put it on a separate line.
454 sub item {
455     my $self = shift;
456     local $_ = shift;
457     my $tag = $$self{ITEM};
458     unless (defined $tag) {
459         carp "item called without tag";
460         return;
461     }
462     undef $$self{ITEM};
463     if ($$self{lopen}) {
464         if ($self->{ltype} == 1 || $self->{ltype} == 2) {
465             $self->{MARGIN} -= 2;
466             $self->output ("</listitem>\n");
467         } else {
468             $self->{MARGIN} -= 2;
469             $self->output ("</listitem>\n");
470             $self->{MARGIN} -= 2;
471             $self->output ("</varlistentry>\n");
472        }
473     }
474     my $output = $_;
475     $output =~ s/\n*$/\n/;
476     if (!defined $self->{ltype}) {
477             if ($tag =~ /[0-9]+\./) {
478                 $self->{ltype} = 2;
479                 $self->output ("<orderedlist>\n");
480             } elsif ($tag =~ /^\*$/) {
481                 $self->{ltype} = 1;
482                 $self->output ("<itemizedlist>\n");
483             } else {
484                 $self->{ltype} = 0;
485                 $self->output ("<variablelist>\n");
486             }
487             $self->{MARGIN} += 2;
488     }
489     if ($self->{ltype} == 1 || $self->{ltype} == 2) {
490         $self->output ("<listitem>\n");
491         $self->{MARGIN} += 2;
492         s/\n+$//;
493         $self->output ("<para>" . $_ . "<\/para>" . "\n\n");
494     } else {
495         $self->output ("<varlistentry>\n");
496         $self->{MARGIN} += 2;
497         $self->output ("<term>" . $tag . "</term>" . "\n");
498         $self->output ("<listitem>\n");
499         $self->{MARGIN} += 2;
500         s/\n+$//;
501         $self->output ("<para>" . $_ . "<\/para>" . "\n\n");
502     }
503     $$self{lopen} = 1;
504 }
505
506 # Output text to the output device.
507 sub output {
508     my $self = shift;
509     local $_ = shift;
510     s/^(\s*\S+)/(' ' x $$self{MARGIN}) . $1/gme;
511     print { $self->output_handle } $_;
512 }
513
514 1;
515
516
517 # pod2refentry -- Convert POD data to DocBook RefEntry
518 #
519 # Copyright 2005, 2006 by Chas Williams <chas@cmf.nrl.navy.mil>
520 #
521 # This program is free software; you may redistribute it and/or modify it
522 # under the same terms as Perl itself.
523 #
524 # based on:
525 #
526 # pod2text -- Convert POD data to formatted ASCII text.
527 #
528 # Copyright 1999, 2000, 2001 by Russ Allbery <rra@stanford.edu>
529 #
530 # This program is free software; you may redistribute it and/or modify it
531 # under the same terms as Perl itself.
532
533 package main;
534
535 require 5.004;
536
537 use Getopt::Long qw(GetOptions);
538 use Pod::Usage qw(pod2usage);
539
540 use strict;
541
542 # Silence -w warnings.
543 use vars qw($running_under_some_shell);
544
545 # Insert -- into @ARGV before any single dash argument to hide it from
546 # Getopt::Long; we want to interpret it as meaning stdin (which Pod::Parser
547 # does correctly).
548 my $stdin;
549 @ARGV = map { $_ eq '-' && !$stdin++ ? ('--', $_) : $_ } @ARGV;
550
551 # Parse our options.
552 my %options;
553 GetOptions (\%options, 'help|h', 'indent|i=i', 'section|s=i' ) or exit 1;
554 pod2usage (1) if $options{help};
555
556 # Initialize and run the formatter.
557 my $parser = Pod::RefEntry->new (%options);
558 $parser->parse_from_file (@ARGV);