Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

357 lines (313 sloc) 9.445 kb
#!/usr/bin/perl -w
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.