use Pod::Parser;
require Pod::PlainText;
package Pod::Rtf;
@ISA = qw(Pod::Parser);
BEGIN {
$li = "";
}
sub begin_input {
my $parser = shift;
my $header = <<"EOHEADER";
{\\rtf1\\ansi \\deff0\\deflang1024
{\\fonttbl
{\\f0\\froman Times New Roman;}
{\\f1\\fmodern Fixedsys;}
}
{\\colortbl;
\\red0\\green0\\blue0;
\\red0\\green0\\blue255;
\\red0\\green255\\blue0;
\\red255\\green0\\blue0;
\\red255\\green255\\blue255;
}
EOHEADER
if ($pound_note) {
$pound_note = context_string($pound_note);
$header .= "#{\\footnote $pound_note}\n";
push(@pound_pages,$pound_note);
}
if ($dollar_note) {
$header .= "\${\\footnote $dollar_note}\n";
push(@index_pages,$dollar_note);
}
if ($K_note) {
$header .= "K{\\footnote $K_note}\n";
push(@K_pages,$dollar_note);
}
$header .= "\n{\\pard}\n";
my $out_fh = $parser->output_handle();
print $out_fh $header;
}
sub command {
my ($parser, $command, $paragraph, $line_num) = @_;
my $cmd_open = "{";
my $cmd_close = "}\n";
if ($command eq 'head1') {
my $line = $paragraph;
$line = context_string("$pound_note$line");
if (length($line) > 0) {
push(@pound_topics,$line);
$cmd_open = "#{\\footnote $line}\n$cmd_open\\f0\\fs36 ";
}
$cmd_close .= "{\\par}{\\pard}\n";
$li = "";
}
elsif ($command eq 'head2') {
my $line = $paragraph;
$line = context_string("$pound_note$line");
if (length($line) > 0) {
push(@pound_topics,$line);
$cmd_open = "#{\\footnote $line}\n$cmd_open\\f0\\fs28 ";
}
$cmd_close .= "{\\par}{\\pard}\n";
$li = "";
}
elsif ($command =~ /head[3-9]/) {
my $line = $paragraph;
$line = context_string("$pound_note$line");
if (length($line) > 0) {
push(@pound_topics,$line);
$cmd_open = "#{\\footnote $line}\n$cmd_open\\f0\\fs24 ";
}
$cmd_close .= "{\\par}{\\pard}\n";
$li = "";
}
elsif ($command eq 'item') {
my $non_space = $paragraph;
$non_space =~ s/\s+//g;
if ($non_space eq '*') { $paragraph =~ s/\*/\\bullet/; }
# HCW on NT seems to have difficulty w/ RTF, we hack around:
if ($is_first_item eq "yes") {
$cmd_open =~ s/\{//;
$is_first_item = "";
}
}
elsif ($command eq 'over') {
my $amount = $paragraph;
if ($amount !~ s/(\d+)/$1/) { $amount = 4 }
# @10 pt fontw/ 2:1 aspect: 5 pts/space * 20 twips/point
$amount *= 100;
$paragraph = "";
$li = "\\li$amount";
$cmd_open = "$cmd_open$li\\f0\\fs20";
# HCW on NT seems to have difficulty w/ RTF, we hack around:
$cmd_close =~ s/\}//;
$is_first_item = "yes";
}
elsif ($command eq 'back') {
$li = "";
$cmd_close = "{\\par}{\\pard}$cmd_close";
}
elsif ($command eq 'cut') {
$li = "";
}
elsif ($command eq 'pod') {
$li = "";
}
# perhaps for and begin ought to be handled as verbatim(?)
elsif ($command eq 'for') {
$li = "";
}
elsif ($command eq 'begin') {
}
elsif ($command eq 'end') {
}
## ... other commands and their actions
else {
warn "Unrecognized command '$command'\n" if $VERBOSE;
}
my $expansion = $parser->interpolate($paragraph, $line_num);
$expansion = "$cmd_open$expansion$cmd_close";
my $out_fh = $parser->output_handle();
print $out_fh $expansion;
}
sub verbatim {
my ($parser, $paragraph, $line_num) = @_;
## Format verbatim paragraph; sample actions might be:
my @lines = split(/\n/,$paragraph);
my $out_fh = $parser->output_handle();
foreach my $line (@lines) {
chomp($line);
$line = rtf_escape($line);
$line = "{{\\keep}\\f1\\fs20 $line {\\line}}\n";
print $out_fh $line;
}
$line="{\\par}{\\pard}\n";
print $out_fh $line;
}
sub textblock {
my ($parser, $paragraph, $line_num) = @_;
## Translate/Format this block of text; sample actions might be:
# Because we do the rtf escape here it is not necessary to do it
# for the interior sequences individually.
my $rtf_paragraph = rtf_escape($paragraph);
my $expansion = $parser->interpolate($rtf_paragraph, $line_num);
my $rtf_par = "{$li\\f0\\fs20\n$expansion\{\\par}}\n{\\par}{\\pard}\n";
my $out_fh = $parser->output_handle();
print $out_fh $rtf_par;
}
sub interior_sequence {
my ($parser, $seq_command, $argument) = @_;
my $cfont = '\\f1';
my $cfonts = '\\fs20';
# rtf escape has already been done by textblock
# my $argument = rtf_escape($seq_argument);
## Expand an interior sequence; sample actions might be:
return "{\\i $argument}" if ($seq_command eq 'I');
return "{\\b $argument}" if ($seq_command eq 'B');
return "{{\\keep} $argument{\\pard}}"
if ($seq_command eq 'S');
return "{$cfont$cfonts $argument}{\\pard}"
if ($seq_command eq 'C');
if ($seq_command eq 'L') {
my @links = split(/\|/,$argument);
my $show = $argument;
if ($#links >= 1) {
$show = $links[0];
$argument = join('|',@links[1..$#links]);
}
if ($argument =~ /\/?\"[^\"\|\/]+\"/) { # an L<"sec"> or L</"sec">
my $vlink = context_string("$pound_note$argument");
return "{\\strike $show}{\\v $vlink}"
}
if ($argument =~ /[^\"\|\/]+/) { # an L<name> or L<sec>
my $vlink = context_string($argument);
# *if* we have seen it before:
if (scalar(grep(/$vlink/,@pound_topics))) {
$vlink = context_string("$pound_note$vlink");
}
elsif (scalar(grep(/$vlink/,@pound_pages))) {
if ($vlink !~ /\./) { $vlink .= ".pod"; }
}
else {
if ($vlink !~ /\./) {
if ($vlink =~ /perl/) {
$vlink .= ".pod";
}
elsif ($argument =~ /::/) {
$vlink .= ".pm";
}
}
}
return "{\\strike $show}{\\v $vlink}"
}
# if (($argument !~ /\//) ||
# ($argument !~ /\|/));
#if ( m{^ ([a-zA-Z][^\s\/]+) (\([^\)]+\))? $}x ) {
# ## LREF: a manpage(3f)
# $_ = "the $1$2 manpage";
#}
#elsif ( m{^ ([^/]+) / ([:\w]+(\(\))?) $}x ) {
# ## LREF: an =item on another manpage
# $_ = "the \"$2\" entry in the $1 manpage";
#}
#elsif ( m{^ / ([:\w]+(\(\))?) $}x ) {
# ## LREF: an =item on this manpage
# $_ = $self->internal_lrefs($1);
#}
#elsif ( m{^ (?: ([a-zA-Z]\S+?) / )? "?(.*?)"? $}x ) {
# ## LREF: a =head2 (head1?), maybe on a manpage, maybe right here
# ## the "func" can disambiguate
# $_ = ((defined $1) && $1)
# ? "the section on \"$2\" in the $1 manpage"
# : "the section on \"$2\"";
#}
}
return "$argument" if ($seq_command eq 'F');
if ($seq_command eq 'X') {
return "{\\strike $argument}{\\v $argument}";
}
return "$argument" if ($seq_command eq 'Z');
if ($seq_command eq 'E') {
if (defined($Pod::PlainText::HTML_Escapes{$argument})) {
return "$Pod::PlainText::HTML_Escapes{$argument}";
}
else {
warn "Unrecognized escape sequence '$seq_command<$argument>'\n" if $VERBOSE;
return "$argument";
}
}
## ... other sequence commands and their resulting text
warn "Unrecognized interior sequence '$seq_command<$argument>'\n" if $VERBOSE;
return "$argument";
}
sub end_input {
my $parser = shift;
my $footer = <<"EOFOOTER";
}
EOFOOTER
my $out_fh = $parser->output_handle();
print $out_fh $footer;
}
sub rtf_escape {
my $text = shift;
#
# According to Keith Bugg we need to \ escape \ {} [] # $
# Experience with HCW on NT 4 shows that only \ {} need be escaped.
#
$text =~ s/(\\)/\\$1/g;
$text =~ s/(\{)/\\$1/g;
$text =~ s/(\})/\\$1/g;
return($text);
}
sub context_string {
my $text = shift;
$text =~ s/[^A-Za-z0-9_\.]//g;
if (length($text) > 255) {
return(substr($text,0,255));
}
return($text);
}
sub context_string {
my $text = shift;
$text =~ s/[^A-Za-z0-9_\.]//g;
if (length($text) > 255) {
return(substr($text,0,255));
}
return($text);
}
=head1 NAME
pod2rtf
=head1 SYNOPSIS
pod2rtf podfile [> podfile.rtf]
=head1 DESCRIPTION
This script incorporateds the Pod::Rtf module and invokes it fon input files,
=head1 SEE ALSO
L<perl>. L<Pod::Rtf>, E<amp> L<"DESCRIPTION"> for further detail.
=head1 BUGS
The indentation for lists requires an =over and is a bit of a kludge.
For some reason yumlaut (\xFF) does not seem to render iunder the fonts
used here.
=head1 AUTHOR
Peter Prymmer.
Copyright (c) 1999 Peter Prymmer. This code may be distributed
under the same terms as Perl itself.
=cut
package main;
## Create a parser object and have it parse file whose name was
## given on the command-line (use STDIN if no files were given).
my $parser = new Pod::Rtf();
$parser->parse_from_filehandle(\*STDIN) if (@ARGV == 0);
for (@ARGV) {
my $file = $_;
$file =~ s/\..*$//;
$Pod::Rtf::pound_note = $_;
$Pod::Rtf::dollar_note = $file;
$Pod::Rtf::K_note = $file;
$parser->parse_from_file($_);
}
__END__