[hcoop/debian/openafs.git] / doc / xml / AdminRef / pod2refentry

#!/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'       =>    '&amp;',      # ampersand
    'lt'        =>    '&lt;',      # left chevron, less-than
    'gt'        =>    '&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/&/&amp;/g;	# do &amp; first to avoid "fixing" the & in &lt;
    s/</&lt;/g;
    s/>/&gt;/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/(&)/\&amp;/g;
    s/(<)/\&lt;/g;
    s/(>)/\&gt;/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 &nbsp;
	$_ = 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);
Commit	Line	Data
805e021f CE	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' => '&', # ampersand
	43	'lt' => '<', # left chevron, less-than
	44	'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/&/&/g; # do & first to avoid "fixing" the & in <
112	s/</</g;
113	s/>/>/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/(&)/\&/g;
125	s/(<)/\</g;
126	s/(>)/\>/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
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);