--- /dev/null
+#!/usr/bin/perl
+ eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
+ if $running_under_some_shell;
+
+# Pod::RefEntry -- Convert POD data to DocBook RefEntry
+#
+# Copyright 2005, 2006 by Chas Williams <chas@cmf.nrl.navy.mil>
+#
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+#
+# based on:
+#
+# Pod::PlainText -- Convert POD data to formatted ASCII text.
+# $Id: Text.pm,v 2.1 1999/09/20 11:53:33 eagle Exp $
+#
+# Copyright 1999-2000 by Russ Allbery <rra@stanford.edu>
+#
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+
+package Pod::RefEntry;
+
+require 5.005;
+
+use Carp qw(carp);
+use Pod::Select ();
+
+use strict;
+use vars qw(@ISA %ESCAPES $VERSION);
+
+# We inherit from Pod::Select instead of Pod::Parser so that we can be used
+# by Pod::Usage.
+@ISA = qw(Pod::Select);
+
+$VERSION = '0.06';
+
+# This table is taken near verbatim from Pod::PlainText in Pod::Parser,
+# which got it near verbatim from the original Pod::Text. It is therefore
+# credited to Tom Christiansen, and I'm glad I didn't have to write it. :)
+%ESCAPES = (
+ 'amp' => '&', # ampersand
+ 'lt' => '<', # left chevron, less-than
+ 'gt' => '>', # right chevron, greater-than
+ 'quot' => '"', # double quote
+);
+
+# Initialize the object. Must be sure to call our parent initializer.
+sub initialize {
+ my $self = shift;
+
+ $$self{hlevel} = 0 unless defined $$self{hlevel};
+ $$self{ltype} = 0 unless defined $$self{ltype};
+ $$self{lopen} = 0 unless defined $$self{lopen};
+ $$self{indent} = 2 unless defined $$self{indent};
+ $$self{width} = 76 unless defined $$self{width};
+ $$self{refnamediv} = 0;
+
+ $$self{LSTATE} = [];
+ $$self{MARGIN} = 0; # Current left margin in spaces.
+
+ $self->SUPER::initialize;
+}
+
+sub begin_pod {
+ my $self = shift;
+
+ $self->output ("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n");
+}
+
+sub end_pod {
+ my $self = shift;
+ my $i;
+
+ for($i = 4; $i > 0; --$i) {
+ if ($$self{hlevel} >= $i) {
+ $self->{MARGIN} -= 2;
+ #$self->output ("</refsection>\n");
+ $self->output (sprintf "</refsect%d>\n", $i);
+ };
+ };
+
+ $self->{MARGIN} -= 2;
+ $self->output ("</refentry>\n");
+}
+
+# Called for each command paragraph. Gets the command, the associated
+# paragraph, the line number, and a Pod::Paragraph object. Just dispatches
+# the command to a method named the same as the command. =cut is handled
+# internally by Pod::Parser.
+sub command {
+ my $self = shift;
+ my $command = shift;
+ return if $command eq 'pod';
+ return if ($$self{EXCLUDE} && $command ne 'end');
+ $self->item ("\n") if defined $$self{ITEM};
+ $command = 'cmd_' . $command;
+ $self->$command (@_);
+}
+
+# Called for a verbatim paragraph. Gets the paragraph, the line number, and
+# a Pod::Paragraph object. Just output it verbatim, but with tabs converted
+# to spaces.
+sub verbatim {
+ my $self = shift;
+ return if $$self{EXCLUDE};
+ $self->item if defined $$self{ITEM};
+ local $_ = shift;
+ return if /^\s*$/;
+ $$self{MARGIN} += 2;
+ s/&/&/g; # do & first to avoid "fixing" the & in <
+ s/</</g;
+ s/>/>/g;
+ my $saved = $$self{MARGIN};
+ $$self{MARGIN} = 0;
+ $self->output ("<programlisting>\n");
+ $self->output ($_);
+ $self->output ("</programlisting>\n");
+ $$self{MARGIN} = $saved;
+}
+
+sub escapes {
+ (undef, local $_) = @_;
+ s/(&)/\&/g;
+ s/(<)/\</g;
+ s/(>)/\>/g;
+ $_;
+}
+
+# Called for interior sequences. Gets a Pod::InteriorSequence object
+# and is expected to return the resulting text.
+sub sequence {
+ my ($self, $seq) = @_;
+
+ my $cmd_name = $seq->cmd_name;
+
+ $seq->left_delimiter( '' );
+ $seq->right_delimiter( '' );
+ $seq->cmd_name( '' );
+ $_ = $seq->raw_text;
+
+ if ($cmd_name eq 'B') {
+ $_ = sprintf "<emphasis role=\"bold\">%s</emphasis>", $_;
+ } elsif ($cmd_name eq 'C') {
+ $_ = sprintf "<computeroutput>%s</computeroutput>", $_;
+ } elsif ($cmd_name eq 'F') {
+ $_ = sprintf "<replaceable>%s</replaceable>", $_;
+ } elsif ($cmd_name eq 'I') {
+ $_ = sprintf "<emphasis>%s</emphasis>", $_;
+ } elsif ($cmd_name eq 'S') {
+ # perhaps translate ' ' to
+ $_ = sprintf "%s", $_;
+ } elsif ($cmd_name eq 'L') {
+ $_ = $self->seq_l ($seq);
+ } elsif ($cmd_name eq 'E') {
+ if (defined $ESCAPES{$_}) {
+ $_ = $ESCAPES{$_} if defined $ESCAPES{$_};
+ } else {
+ carp "Unknown escape: E<$_>";
+ }
+ } else {
+ carp "\nUnknown sequence $cmd_name<$_>\n";
+ }
+
+ my $parent = $seq->nested;
+ if (defined $parent) {
+
+ if ($parent->cmd_name eq 'B') {
+ $_ = sprintf "</emphasis>%s<emphasis role=\"bold\">", $_;
+ } elsif ($parent->cmd_name eq 'C') {
+ $_ = sprintf "</computeroutput>%s<computeroutput>", $_;
+ } elsif ($parent->cmd_name eq 'F') {
+ $_ = sprintf "</replaceable>%s<replaceable>", $_;
+ } elsif ($parent->cmd_name eq 'I') {
+ $_ = sprintf "</emphasis>%s<emphasis>", $_;
+ }
+ }
+
+ return $_;
+}
+
+# Called for a regular text block. Gets the paragraph, the line number, and
+# a Pod::Paragraph object. Perform parse_text and output the results.
+sub textblock {
+ my $self = shift;
+ return if $$self{EXCLUDE};
+ $self->output ($_[0]), return if $$self{VERBATIM};
+ local $_ = shift;
+ my $line = shift;
+ my $name;
+ my $purpose;
+
+# /<http:.*>/ && do {
+# s/<http:([^>]+)\>/<ulink url=\"http:\1\">http:\1<\/ulink>/;
+# };
+#
+# /<.*@.*>/ && do {
+# s/<([^>]+@[^>]+)>/<email>\1<\/email>/g;
+# };
+
+ $_ = $self->parse_text(
+ { -expand_text => q(escapes),
+ -expand_seq => q(sequence) },
+ $_, $line ) -> raw_text();
+
+ if (defined $$self{ITEM}) {
+ $self->item ($_ . "\n");
+ } elsif ($self->{refnamediv}) {
+ ($name, $purpose) = /(.+)\s+\-\s+(.+)/;
+ my $id = $name;
+ $id =~ s/,.*$//; # only reference by first entry?
+ $id =~ s/[ \.,\(\)]/_/g;
+ if (defined $$self{section}) {
+ $id = sprintf "%s%d", $id, $$self{section};
+ }
+ $self->output ("<refentry id=\"$id\">\n");
+ $self->{MARGIN} += 2;
+ if (defined $$self{section}) {
+ $self->output ("<refmeta>\n");
+ $self->{MARGIN} += 2;
+ $self->output (sprintf "<refentrytitle>%s</refentrytitle>\n", $name);
+ $self->output (sprintf "<manvolnum>%d</manvolnum>\n", $$self{section});
+ $self->{MARGIN} -= 2;
+ $self->output ("</refmeta>\n");
+ }
+ $self->output ("<refnamediv>\n");
+ $self->{MARGIN} += 2;
+ $self->output ("<refname>$name</refname>\n");
+ $self->output ("<refpurpose>$purpose</refpurpose>\n");
+ $self->{MARGIN} -= 2;
+ $self->output ("</refnamediv>\n");
+ $self->{refnamediv} = 0;
+ } else {
+ s/\n+$//;
+ $self->output ("<para>" . $_ . "<\/para>" . "\n\n");
+ }
+}
+
+# Level headings.
+sub cmd_head {
+ my $self = shift;
+ local $_ = shift;
+ my $line = shift;
+ my $level = $self->{level};
+ my $i;
+
+ for($i = 4; $i > 0; --$i) {
+ if ($level <= $i) {
+ if ($$self{hlevel} >= $i) {
+ $$self{MARGIN} -= 2;
+ #$self->output (sprintf "</refsection>\n", $i);
+ $self->output (sprintf "</refsect%d>\n", $i);
+ }
+ }
+ }
+
+ # special, output next <para> as <refnamediv>
+ if ($level == 1 && $_ =~ /NAME/) {
+ $self->{refnamediv} = 1;
+ return;
+ }
+
+ #$self->output (sprintf "<refsection>\n", $level);
+ $self->output (sprintf "<refsect%d>\n", $level);
+ $$self{MARGIN} += 2;
+ s/\s+$//;
+ $_ = $self->parse_text(
+ { -expand_text => q(escapes),
+ -expand_seq => q(sequence) },
+ $_, $line ) -> raw_text();
+ if (/^[A-Z ]+$/) {
+ s/(\w+)/\u\L$1/g if $level == 1; # kill capitalization
+ }
+ $self->output ("<title>" . $_ . "<\/title>" . "\n");
+ $$self{hlevel} = $level;
+}
+
+# First level heading.
+sub cmd_head1 {
+ my $self = shift;
+ $self->{level} = 1;
+ $self->cmd_head (@_);
+}
+
+# Second level heading.
+sub cmd_head2 {
+ my $self = shift;
+ $self->{level} = 2;
+ $self->cmd_head (@_);
+}
+
+# Third level heading.
+sub cmd_head3 {
+ my $self = shift;
+ $self->{level} = 3;
+ $self->cmd_head (@_);
+}
+
+sub cmd_head4 {
+ my $self = shift;
+ # <refsect4> doesnt exist -- we would use <refsection>
+ # when it becomes available in 4.4
+ printf STDERR "=head4 being rendered as <refsect3>\n";
+ $self->{level} = 3;
+ $self->cmd_head (@_);
+}
+
+# Start a list.
+sub cmd_over {
+ my $self = shift;
+ local $_ = shift;
+ unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} }
+ push (@{ $$self{LSTATE} }, $$self{lopen});
+ push (@{ $$self{LSTATE} }, $$self{ltype});
+ undef $self->{ltype};
+ $$self{lopen} = 0;
+}
+
+# End a list.
+sub cmd_back {
+ my $self = shift;
+ if ($self->{ltype} == 2) {
+ $self->{MARGIN} -= 2;
+ $self->output ("</listitem>\n");
+ $self->{MARGIN} -= 2;
+ $self->output ("</orderedlist>\n");
+ } elsif ($self->{ltype} == 1) {
+ $self->{MARGIN} -= 2;
+ $self->output ("</listitem>\n");
+ $self->{MARGIN} -= 2;
+ $self->output ("</itemizedlist>\n");
+ } else {
+ $self->{MARGIN} -= 2;
+ $self->output ("</listitem>\n");
+ $self->{MARGIN} -= 2;
+ $self->output ("</varlistentry>\n");
+ $self->{MARGIN} -= 2;
+ $self->output ("</variablelist>\n");
+ }
+ $$self{ltype} = pop @{ $$self{LSTATE} };
+ $$self{lopen} = pop @{ $$self{LSTATE} };
+ unless (defined $$self{LSTATE}) {
+ carp "Unmatched =back";
+ $$self{MARGIN} = $$self{indent};
+ }
+}
+
+# An individual list item.
+sub cmd_item {
+ my $self = shift;
+ if (defined $$self{ITEM}) { $self->item }
+ local $_ = shift;
+ my $line = shift;
+ s/\s+$//;
+ $$self{ITEM} = $self->parse_text(
+ { -expand_text => q(escapes),
+ -expand_seq => q(sequence) },
+ $_, $line ) -> raw_text();
+}
+
+# Begin a block for a particular translator. Setting VERBATIM triggers
+# special handling in textblock().
+sub cmd_begin {
+ my $self = shift;
+ local $_ = shift;
+ my ($kind) = /^(\S+)/ or return;
+ if ($kind eq 'text') {
+ $$self{VERBATIM} = 1;
+ } else {
+ $$self{EXCLUDE} = 1;
+ }
+}
+
+# End a block for a particular translator. We assume that all =begin/=end
+# pairs are properly closed.
+sub cmd_end {
+ my $self = shift;
+ $$self{EXCLUDE} = 0;
+ $$self{VERBATIM} = 0;
+}
+
+# One paragraph for a particular translator. Ignore it unless it's intended
+# for text, in which case we treat it as a verbatim text block.
+sub cmd_for {
+ my $self = shift;
+ local $_ = shift;
+ my $line = shift;
+ return unless s/^text\b[ \t]*\n?//;
+ $self->verbatim ($_, $line);
+}
+
+# The complicated one. Handle links. Since this is plain text, we can't
+# actually make any real links, so this is all to figure out what text we
+# print out.
+sub seq_l {
+ my ($self, $seq) = @_;
+
+ s/>$//; # remove trailing >
+
+ # Smash whitespace in case we were split across multiple lines.
+ s/\s+/ /g;
+
+ # If we were given any explicit text, just output it.
+ if (/^([^|]+)\|/) { return $1 }
+
+ # Okay, leading and trailing whitespace isn't important; get rid of it.
+ s/^\s+//;
+ s/\s+$//;
+
+ # Default to using the whole content of the link entry as a section
+ # name. Note that L<manpage/> forces a manpage interpretation, as does
+ # something looking like L<manpage(section)>. The latter is an
+ # enhancement over the original Pod::Text.
+ my ($manpage, $section) = ('', $_);
+ if (/^(?:https?|ftp|news):/) {
+ # a URL
+ return $_;
+ } elsif (/^"\s*(.*?)\s*"$/) {
+ $section = '"' . $1 . '"';
+ } elsif (m/^[-:.\w]+(?:\(\S+\))?$/) {
+ ($manpage, $section) = ($_, '');
+ } elsif (m%/%) {
+ ($manpage, $section) = split (/\s*\/\s*/, $_, 2);
+ }
+
+ $seq->cmd_name("");
+
+ # Now build the actual output text.
+ if (length $section) {
+ $section =~ s/^\"\s*//;
+ $section =~ s/\s*\"$//;
+ $_ = $section;
+ $_ .= " in $manpage" if length $manpage;
+ }
+ if (length $manpage) {
+ my $linkend = $manpage;
+ $linkend =~ s/[\(\)]//g;
+ $linkend =~ s/[ ,\.]/_/g; # this needs to match <refentry id=
+ $seq->prepend("<link linkend=\"$linkend\">");
+ $seq->append("</link>");
+ return $seq;
+ } else {
+ return $_;
+ }
+}
+
+# This method is called whenever an =item command is complete (in other
+# words, we've seen its associated paragraph or know for certain that it
+# doesn't have one). It gets the paragraph associated with the item as an
+# argument. If that argument is empty, just output the item tag; if it
+# contains a newline, output the item tag followed by the newline.
+# Otherwise, see if there's enough room for us to output the item tag in the
+# margin of the text or if we have to put it on a separate line.
+sub item {
+ my $self = shift;
+ local $_ = shift;
+ my $tag = $$self{ITEM};
+ unless (defined $tag) {
+ carp "item called without tag";
+ return;
+ }
+ undef $$self{ITEM};
+ if ($$self{lopen}) {
+ if ($self->{ltype} == 1 || $self->{ltype} == 2) {
+ $self->{MARGIN} -= 2;
+ $self->output ("</listitem>\n");
+ } else {
+ $self->{MARGIN} -= 2;
+ $self->output ("</listitem>\n");
+ $self->{MARGIN} -= 2;
+ $self->output ("</varlistentry>\n");
+ }
+ }
+ my $output = $_;
+ $output =~ s/\n*$/\n/;
+ if (!defined $self->{ltype}) {
+ if ($tag =~ /[0-9]+\./) {
+ $self->{ltype} = 2;
+ $self->output ("<orderedlist>\n");
+ } elsif ($tag =~ /^\*$/) {
+ $self->{ltype} = 1;
+ $self->output ("<itemizedlist>\n");
+ } else {
+ $self->{ltype} = 0;
+ $self->output ("<variablelist>\n");
+ }
+ $self->{MARGIN} += 2;
+ }
+ if ($self->{ltype} == 1 || $self->{ltype} == 2) {
+ $self->output ("<listitem>\n");
+ $self->{MARGIN} += 2;
+ s/\n+$//;
+ $self->output ("<para>" . $_ . "<\/para>" . "\n\n");
+ } else {
+ $self->output ("<varlistentry>\n");
+ $self->{MARGIN} += 2;
+ $self->output ("<term>" . $tag . "</term>" . "\n");
+ $self->output ("<listitem>\n");
+ $self->{MARGIN} += 2;
+ s/\n+$//;
+ $self->output ("<para>" . $_ . "<\/para>" . "\n\n");
+ }
+ $$self{lopen} = 1;
+}
+
+# Output text to the output device.
+sub output {
+ my $self = shift;
+ local $_ = shift;
+ s/^(\s*\S+)/(' ' x $$self{MARGIN}) . $1/gme;
+ print { $self->output_handle } $_;
+}
+
+1;
+
+
+# pod2refentry -- Convert POD data to DocBook RefEntry
+#
+# Copyright 2005, 2006 by Chas Williams <chas@cmf.nrl.navy.mil>
+#
+# This program is free software; you may redistribute it and/or modify it
+# under the same terms as Perl itself.
+#
+# based on:
+#
+# pod2text -- Convert POD data to formatted ASCII text.
+#
+# Copyright 1999, 2000, 2001 by Russ Allbery <rra@stanford.edu>
+#
+# This program is free software; you may redistribute it and/or modify it
+# under the same terms as Perl itself.
+
+package main;
+
+require 5.004;
+
+use Getopt::Long qw(GetOptions);
+use Pod::Usage qw(pod2usage);
+
+use strict;
+
+# Silence -w warnings.
+use vars qw($running_under_some_shell);
+
+# Insert -- into @ARGV before any single dash argument to hide it from
+# Getopt::Long; we want to interpret it as meaning stdin (which Pod::Parser
+# does correctly).
+my $stdin;
+@ARGV = map { $_ eq '-' && !$stdin++ ? ('--', $_) : $_ } @ARGV;
+
+# Parse our options.
+my %options;
+GetOptions (\%options, 'help|h', 'indent|i=i', 'section|s=i' ) or exit 1;
+pod2usage (1) if $options{help};
+
+# Initialize and run the formatter.
+my $parser = Pod::RefEntry->new (%options);
+$parser->parse_from_file (@ARGV);