Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

358 lines (314 sloc) 9.452 kB
#!/usr/bin/perl -w
# $Id$
use strict;
my $output_type = shift;
die "$0: bad output tipe '$output_type'\n"
unless (($output_type eq 'html') || ($output_type eq 'pod'));
sub ST_HEADING () { 'heading list'; }
sub ST_PLAIN () { 'plain text'; }
sub ST_BQUOTE () { 'bquote text'; }
sub ST_BOF () { 'begin'; }
sub ST_PARAGRAPH () { 'paragraph'; }
sub ST_ENUMLIST () { 'enum list'; }
sub ST_BULLETLIST () { 'bullet list'; }
sub ST_EOF () { 'cease'; }
sub ST_DOCUMENT () { 'new document'; }
sub ST_SECTION () { 'new section'; }
sub ST_BACKOUT () { 'close head'; }
my @list_counts;
my @html_head =
( [ '*', '+0' ],
[ 'I', '+1' ], [ 'A', '+1' ], [ '1', '+1' ], [ 'a', '+0' ], [ 'i', '+0' ],
[ 'a', '+0' ], [ 'i', '+0' ], [ 'a', '+0' ], [ 'i', '+0' ], [ 'a', '+0' ],
);
# stolen^Wmodeled after Perl POD
my %handler =
( 'html' =>
{ 'I' => sub { "<i>" . $_[0] . "</i>"; },
'B' => sub { "<b>" . $_[0] . "</b>"; },
'S' => sub { my $txt = shift; $txt =~ s/ /\&\#160;/g; $txt; },
'C' => sub { "<code>" . $_[0] . "</code>"; },
'F' => sub { "<tt>" . $_[0] . "</tt>"; },
'Z' => sub { '' },
'E' => sub { "\&\#" . $_[0] . ";"; },
'#' => sub { ""; },
},
'pod' =>
{ 'I' => sub { "I<" . $_[0] . ">"; },
'B' => sub { "B<" . $_[0] . ">"; },
'S' => sub { "S<" . $_[0] . ">"; },
'C' => sub { "C<" . $_[0] . ">"; },
'F' => sub { "F<" . $_[0] . ">"; },
'Z' => sub { "Z<>" },
'E' => sub { "E<" . $_[0] . ">"; },
'#' => sub { ""; },
},
);
my $state = ST_BOF;
my $last_index = 0;
my $plain_buffer = '';
use Carp;
sub preprocess_html {
my $text = shift;
croak "no text" unless (defined $text);
$text =~ s/\&/\&\#38;/g;
$text =~ s/\</\&\#60;/g;
$text =~ s/\>/\&\#62;/g;
$text;
}
sub preprocess_pod {
my $text = shift;
$text =~ s/([&<>])/"E<" . ord($1) .">"/ge;
$text;
}
my %preprocessors =
( 'html' => \&preprocess_html,
'pod' => \&preprocess_pod,
);
sub filter_text {
my $text = shift;
$text = &{$preprocessors{$output_type}}($text);
while ($text =~ /^(.*?)(\S)®(.*?)¯(.*)$/) {
my ($left, $tag, $mid, $right) = ($1, $2, $3, $4);
if (exists $handler{$output_type}->{$tag}) {
$mid = &{$handler{$output_type}->{$tag}}($mid);
}
else {
$mid = " [unknown tag $tag] " . $mid;
}
$text = $left . $mid . $right;
}
$text;
}
sub flush_text {
my $flush_state = shift;
if ($plain_buffer ne '') {
if ($flush_state ne ST_BQUOTE) {
$plain_buffer =~ s/\s+/ /g;
$plain_buffer =~ s/^\s+//s;
}
$plain_buffer =~ s/\s+$//s;
if (($output_type eq 'html') || ($flush_state ne ST_BQUOTE)) {
print &filter_text($plain_buffer), "\n";
}
else {
print $plain_buffer, "\n";
}
$plain_buffer = '';
}
}
sub START () { 'begin' }
sub CEASE () { 'cease' }
sub MAINT () { 'maint' }
sub TWEEN () { 'tween' }
my %formats =
( 'html' =>
{ &CEASE =>
{ &ST_BQUOTE => sub { "</pre></p>\n" },
&ST_PLAIN => sub { "</p>\n" },
&ST_PARAGRAPH => sub { "" },
&ST_ENUMLIST => sub { "</ol>\n" },
&ST_BULLETLIST => sub { "</ol>\n" },
&ST_DOCUMENT => sub { "</p>\n<hr>\n" .
"<font size=-1>Generated by out-out on " .
scalar(gmtime) . " GMT.</font>\n" .
"</body>\n</html>"
},
},
&START =>
{ &ST_PARAGRAPH => sub { "" },
&ST_PLAIN => sub { "<p>\n" },
&ST_BQUOTE => sub { "<p><pre>\n" },
&ST_ENUMLIST => sub { "<ol type=1>\n<li>" },
&ST_BULLETLIST => sub { "<ul type=disc>\n<li>" },
&ST_DOCUMENT => sub { "<html>\n<head>\n<title>" . $_[0] .
"</title>\n</head>\n<body>\n" .
"<h1>" . $_[0] . "</h1>\n"
},
&ST_SECTION => sub { "<hr>\n<h1>$_[0]</h1>\n" },
&ST_HEADING => sub { "<ol type=" . $html_head[$_[1]]->[0] . ">\n" },
},
&TWEEN =>
{ &ST_ENUMLIST => sub { &flush_text($state); "<li>"; },
&ST_BULLETLIST => sub { &flush_text($state); "<li>"; },
&ST_HEADING => sub { "<font size=" . $html_head[$_[1]]->[1] . ">" .
"<li>" . $_[0] . "</font>\n"
},
}
},
'pod' =>
{ &CEASE =>
{ &ST_BQUOTE => sub { "\n" },
&ST_PLAIN => sub { "\n" },
&ST_PARAGRAPH => sub { "" },
&ST_ENUMLIST => sub { pop @list_counts; "\n=back\n\n" },
&ST_BULLETLIST => sub { "\n=back\n\n" },
&ST_DOCUMENT => sub { "=cut\n" },
},
&START =>
{ &ST_PARAGRAPH => sub { "" },
&ST_PLAIN => sub { "" },
&ST_BQUOTE => sub { "" },
&ST_ENUMLIST => sub { push(@list_counts, 1);
"=over 2\n\n=item " . $list_counts[-1]++ . ' '
},
&ST_BULLETLIST => sub { "=over 2\n\n=item * " },
&ST_DOCUMENT => sub { "\n=head1 $_[0]\n\n" },
&ST_SECTION => sub { "=head1 $_[0]\n\n" },
&ST_HEADING => sub { push(@list_counts, 1);
"=over 2\n\n"
},
},
&TWEEN =>
{ &ST_ENUMLIST => sub { &flush_text($state);
"\n=item " . $list_counts[-1]++ . ' ';
},
&ST_BULLETLIST => sub { &flush_text($state); "\n=item * "; },
&ST_HEADING => sub { "=item " . $list_counts[-1]++ .
" $_[0]\n\n"
},
# &ST_HEADING => sub { "=item " . ($_[1]+1) . " $_[0]\n\n" },
}
}
);
sub format {
my $mode = shift;
my $format = shift;
my $text = &filter_text(shift);
print &{$formats{$output_type}->{$mode}->{$format}}($text, @_);
}
sub format_outline {
my $new_state = shift;
my $text = shift;
if (($new_state eq ST_HEADING) and ($text eq '')) {
$new_state = ST_BACKOUT;
}
# state transition
if ($new_state ne $state) {
&flush_text($state);
if ($state eq ST_BQUOTE) {
&format(CEASE, ST_BQUOTE, $text);
}
elsif ($state eq ST_PLAIN) {
&format(CEASE, ST_PLAIN, $text);
}
elsif ($state eq ST_PARAGRAPH) {
&format(CEASE, ST_PARAGRAPH, $text);
}
elsif ($state eq ST_ENUMLIST) {
&format(CEASE, ST_ENUMLIST, $text);
}
elsif ($state eq ST_BULLETLIST) {
&format(CEASE, ST_BULLETLIST, $text);
}
if ($new_state eq ST_PARAGRAPH) {
&format(START, ST_PARAGRAPH, $text);
}
elsif ($new_state eq ST_PLAIN) {
&format(START, ST_PLAIN, $text);
}
elsif ($new_state eq ST_BQUOTE) {
&format(START, ST_BQUOTE, $text);
}
elsif ($new_state eq ST_ENUMLIST) {
&format(START, ST_ENUMLIST, $text);
}
elsif ($new_state eq ST_BULLETLIST) {
&format(START, ST_BULLETLIST, $text);
}
}
# maintain the current state
else {
if ($state eq ST_ENUMLIST) {
&format(TWEEN, ST_ENUMLIST, $text);
}
elsif ($state eq ST_BULLETLIST) {
&format(TWEEN, ST_BULLETLIST, $text);
}
}
# things regardless of transition
if ($new_state eq ST_HEADING) {
my ($index) = @_;
if ($index - $last_index > 1) {
die "outline level changes by more than +1 at input line $.\n";
}
if ($index < $last_index) {
my $pop_index = $last_index;
do {
&format(CEASE, ST_ENUMLIST, $text);
$pop_index--;
} until ($index == $pop_index);
}
if ($index == 0) {
if ($last_index == 0) {
&format(START, ST_DOCUMENT, $text);
}
else {
&format(START, ST_SECTION, $text);
}
}
else {
if ($index > $last_index) {
&format(START, ST_HEADING, $text, $index);
}
&format(TWEEN, ST_HEADING, $text, $index);
}
$last_index = $index;
}
elsif ($new_state eq ST_BACKOUT) {
my $new_index = $_[0];
my $pop_count = $last_index - $new_index;
if ($pop_count < 1) {
die "can't back out $pop_count levels at input line $.\n";
}
&format(CEASE, ST_ENUMLIST, $text) while ($pop_count--);
if ($new_index == 0) {
if ($last_index == 0) {
die "$0 should never reach the code";
}
else {
&format(START, ST_SECTION, $text);
}
}
else {
&format(START, ST_PARAGRAPH, $text, $new_index);
}
$last_index = $new_index;
}
elsif ($new_state eq ST_EOF) {
while ($last_index--) {
&format(CEASE, ST_ENUMLIST, $text);
}
&format(CEASE, ST_DOCUMENT, $text);
}
elsif ($new_state ne ST_PARAGRAPH) {
$plain_buffer .= $text . "\n";
}
$state = $new_state;
}
while (<>) {
1 while (chomp());
if (s/^(\*+)\s*//) {
&format_outline(ST_HEADING, $_, length($1)-1);
}
elsif ($_ eq '') {
&format_outline(ST_PARAGRAPH, $_);
}
elsif (/^\s/) {
&format_outline(ST_BQUOTE, $_);
}
elsif (s/^\#\)\s+//) {
&format_outline(ST_ENUMLIST, $_);
}
elsif (s/^o\)\s+//) {
&format_outline(ST_BULLETLIST, $_);
}
else {
&format_outline(ST_PLAIN, $_);
}
}
&format_outline(ST_EOF, '');
__END__
out-out pod POE-outline > POE.pod
out-out html POE-outline > POE.html
pod2html POE.pod > POE.pod.html
Jump to Line
Something went wrong with that request. Please try again.