doc/xml/AdminRef/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: Text.pm,v 2.1 1999/09/20 11:53:33 eagle Exp $
  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/&/&amp;/g;        # do &amp; first to avoid "fixing" the & in &lt;
 112     s/</&lt;/g;
 113     s/>/&gt;/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);