doc/podtbl

   1 #!/usr/bin/perl
   2
   3 use Pod::Parser;
   4 use List::Util qw(max);
   5
   6 @ISA = Pod::Parser::;
   7
   8 sub stripfcodes {
   9    # strip formatting codes, dumb version
  10    map {
  11          s/[IBCLFSXZ]<< (.*?) >>/$1/gs;
  12          s/[IBCLFSXZ]<(.*?)>/$1/gs;
  13          $_
  14        } @$_;
  15 }
  16
  17 sub htmlfcodes {
  18    my %tag = (
  19       I => "i",
  20       B => "b",
  21       C => "tt",
  22       L => "i",    # broken
  23       F => "tt",
  24       S => "nobr", # non-std
  25       X => "span", # broken
  26       Z => "span", # broken
  27    );
  28    # strip formatting codes, dumb version
  29    map {
  30          s/([IBCLFSXZ])<< (.*?) >>/<$tag{$1}>$2<\/$tag{$1}>/gs;
  31          s/([IBCLFSXZ])<(.*?)>/<$tag{$1}>$2<\/$tag{$1}>/gs;
  32          $_
  33        } @$_;
  34 }
  35
  36 sub command {
  37    my ($self, $command, $paragraph) = @_;
  38
  39    if ($command eq "begin" && $paragraph =~ /^\s*table\s*$/s) {
  40       $table++;
  41    } elsif ($command eq "end" && $paragraph =~ /^\s*table\s*$/s) {
  42       $table--;
  43    } else {
  44       shift;
  45       return $self->SUPER::command (@_);
  46    }
  47 }
  48
  49 sub verbatim {
  50    my ($self, $para) = @_;
  51    shift;
  52
  53    return $self->SUPER::verbatim (@_) unless $table;
  54
  55    my $table = [ map [$_ =~ /\t([^\t]*)/g], split /\n/, $para ];
  56    my $cols = max map scalar @$_, @$table;
  57
  58    my $fh = $self->output_handle;
  59
  60    # format the table
  61    # text
  62    print $fh "=begin text\n\n";
  63
  64    for (@$table) {
  65       print $fh "   ", (map +(sprintf "%-15s ", $_), stripfcodes @$_), "\n";
  66    }
  67
  68    print $fh "\n=end text\n\n";
  69
  70
  71    # tbl
  72    print $fh "=begin roff\n\n";
  73
  74    print $fh ".TS\n" . ("l " x $cols) . ".\n";
  75    print $fh map +(join "\t", stripfcodes @$_) . "\n", @$table;
  76    print $fh ".TE\n";
  77
  78    print $fh "\n=end roff\n\n";
  79
  80    # html
  81    # pod::xhtml fails on begin/end blocks
  82 #   print $fh "=begin xhtml\n\n";
  83
  84    print $fh "=for html <table>";
  85    print $fh map "<tr><td>" . +(join "</td><td>", htmlfcodes @$_) . "</td></tr>", @$table;
  86    print $fh "</table>\n\n";
  87
  88 #   print $fh "\n=end xhtml\n\n";
  89
  90 }
  91
  92 __PACKAGE__->new->parse_from_filehandle;
  93
  94
  95