API tools faq
paste
aher

table-parser.pl

aher
Jun 4th, 2013
117
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 12.35 KB | None | 0 0
raw download clone embed print report
  1. use strict;
  2. use HTML::Entities;
  3.  
  4. =begin comment
  5. This is a DFA that parses plain text tables as input and produces
  6. HTML tables as output. Input lines not recognized as part of a
  7. table are merely echoed.
  8.  
  9. A Table consists of the follwing parts:
  10.  
  11. Title/Caption [Optional]
  12. Starts with at least three = characters, followed by any number of
  13. lines of text, followed by another line of at least three = characters.
  14.  
  15. Header
  16. One or more ColHeaders can occur across one (or more) lines immediately
  17. following the Title.
  18.  
  19. Simple Column Header
  20. This Header is any text not broken by two white spaces.
  21. Two or more white spaces signifies a column break.
  22.  
  23. ColSpan Column Header
  24. This Header can span multiple columns.
  25. If Colspan Column Headers are used, then the table should be more-or-
  26. less fixed-width, so that Cells line-up underneath their respective
  27. Column Headers, otherwise there's no guarantee the table will parse
  28. correctly.
  29.  
  30. Headers are given the styles "first" or "other" in the HTML output, and
  31. "first" merely indicates the first column.
  32.  
  33. Body
  34. An table can contain one or more Bodies.
  35. Odd and even Bodies are given odd and even styles in the HTML output.
  36. A Body contains at least one line of Content.
  37. The start of a Body is indicated by a line of at least three -
  38. characters immediately followed by a line of Content.
  39.  
  40. Content is organised into Rows (number of Cols per row is fixed).
  41.  
  42. Rows
  43. Each Body has at least one Row.
  44. Odd and even Rows are given odd and even styles in the HTML output.
  45. Rows each contain one Cell per Col.
  46.  
  47. Cells contain any text not broken by two white spaces.
  48. Cells MUST contain some text. Use a dot "." for an otherwise empty cell.
  49. Two (or more) white spaces signify a column break.
  50. Cells are given the styles "object", "quantity", "value", "range" or "dot".
  51. Object is text, a quantity is a number optionally followed by a unit of
  52. measure, a value is a positive integer, a range is two values separated by
  53. a hyphen, and dot is a "." indicating an empty cell.
  54.  
  55. Content is concluded by a line of at least three - characters
  56. immediately followed by (optional) Footnotes, then a blank line.
  57.  
  58. Footnotes [Otional]
  59. These follow immediately after the (last) Body. It consists of one or
  60. more asteristsk, a space, and some text, and ends with a line break.
  61. There can be any number of Footnotes.
  62.  
  63. Here is an example of an plain text table used as input:
  64.  
  65.   ===================================================
  66.                        Missile Range
  67.   ===================================================
  68.   Item               Short   Medium    Long  Maximum*
  69.   ---------------------------------------------------
  70.   Crossbow            60ft    120ft   180ft    180yd
  71.   Dagger, hurled       .       30ft     .        .
  72.   Hand axe, hurled     .       30ft     .        .
  73.   Longbow             70ft    140ft   210ft    120yd
  74.   ---------------------------------------------------
  75.   * Applicable to massed missile fire outdoors
  76.  
  77. ...
  78.  
  79. The motivation behind this program is to add more sophisticated table
  80. processing to the "markdown" language by John Gruber. See
  81.  
  82.   L<Markdown|http://daringfireball.net/projects/markdown/>
  83.  
  84. ...
  85.  
  86. Since this is an early draft of the program, it produces a lot of
  87. debugging information to STDERR. To redirect STDOUT and STDERR to
  88. separate files, use a command-line like the following:
  89.  
  90.   perl table-parser.pl "heading rowcolspan empty.txt" >table.html 2>debug.txt
  91.  
  92. On Windows, to supress STDERR, simply redirect it to the nul device like so:
  93.  
  94.   perl table-parser.pl "heading rowcolspan empty.txt" >table.html 2>nul
  95.  
  96. =end comment
  97. =cut
  98.  
  99. our $STATE = "TEXT";  # := TEXT | TITLE | HEADER | BODY | FOOTER
  100. our $n = -1;          # line number; 0-based
  101. our @lines = <>;      # array containing each line of input file
  102. our $m = $#lines;     # max lines
  103. our %header = ();     # hashtable containing number of columns in each row of header, indexed by line number
  104. our %body = ();       # hashtable containing number of columns in each row of body, indexed by line number
  105. our @cell = ();       # matrix describing table cell $cell[r][c][x] r=line,c=col,x=0:startpos,1:endpos,3:data
  106. our @colpos = ();     # list describing coalesced column structure $colpos[c][x] with c & x as above
  107. our @colspanempty = (); # list of lines in header with fewer than maxcol columns
  108. our $body=0;          # counter for multiple bodies
  109. our $maxcol=0;        # maximum number of columns in a table row
  110. our @caption=();      # Title/caption
  111. our @footer=();       # Footer
  112.  
  113. for $_ (@lines) {
  114.   chomp;
  115.   ++$n;
  116.  
  117.   # STATE transitions
  118.   if(/^\s*$/ && $STATE ne "TEXT"){ $STATE="TEXT"; table(); next;}
  119.   if(/^===+/ && $STATE eq "TEXT" ){ $STATE="TITLE"; next;}
  120.   if(/^===+/ && $STATE eq "TITLE" ){ $STATE="HEADER"; $maxcol=0; next;}
  121.   if(/^---+/ && $STATE eq "HEADER"){ $STATE="BODY"; $body = 1; next;}
  122.   if(/^---+/ && $STATE eq "TEXT"){
  123.     if($n!=0 && $lines[$n-1] !~ /^\s*$/) {
  124.       # "Basic" table
  125.       # Previous line was the header! Go back & get it.
  126.       my $col=0;
  127.       while($lines[$n-1]=~/(\S+(?:\s\S+)*)(\s\s+|$)/g ){
  128.         ++$col; if($col>$maxcol){$maxcol=$col;}
  129.         $cell[$n-1][$col][0] = $-[1];
  130.         $cell[$n-1][$col][1] = $+[1];
  131.         $cell[$n-1][$col][3] = $1;
  132.       }
  133.       $header{$n-1} = $col;
  134.     }
  135.     $STATE="BODY"; $body = 1; $maxcol=0; next;
  136.   }
  137.   if(/^---+/ && $STATE eq "BODY" ){
  138.     if( ($n==$m) || ($n<$m && $lines[$n+1] =~ /^\s*$/) ) {$STATE="TEXT";table();next;}
  139.     elsif( $lines[$n+1] =~ /^(\*)+\s\S+/ ) {$STATE="FOOTER";next;}
  140.     else {$STATE="BODY"; $body++; next;}
  141.   }
  142.  
  143.   if($STATE ne "BODY") { print STDERR $n, " ", $STATE, ": ", $_, "\n"; } # DEBUG
  144.  
  145.   if($STATE eq "TEXT" && ($n==$m || $lines[$n+1] !~ /^---+/)) { print $_, "\n"; }
  146.  
  147.   if($STATE eq "TITLE") { push @caption, trim($_); }
  148.   if($STATE eq "FOOTER") { push @footer, trim($_); }
  149.  
  150.   if($STATE eq "BODY") {
  151.     print STDERR "line ", $n, "\n";
  152.     my $col = 0;
  153.     while(/(\S+(?:\s\S+)*)(\s\s+|$)/g ){
  154.       ++$col; if($col>$maxcol){$maxcol=$col;}
  155.       $cell[$n][$col][0] = $-[1];
  156.       $cell[$n][$col][1] = $+[1];
  157.       $cell[$n][$col][3] = $1;
  158.       if($col==1){ $cell[$n][$col][4] = $body; }
  159.      print STDERR "  column ", $col," from ", $-[1], " to ", $+[1],
  160.        ": ", $&,
  161.        "\n";
  162.     }
  163.     $body{$n} = $col;
  164.   }
  165.  
  166.   if($STATE eq "HEADER") {
  167.     print STDERR "line ", $n, "\n";
  168.     my $col=0;
  169.     while(/(\S+(?:\s\S+)*)(\s\s+|$)/g ){
  170.       ++$col; if($col>$maxcol){$maxcol=$col;}
  171.       $cell[$n][$col][0] = $-[1];
  172.       $cell[$n][$col][1] = $+[1];
  173.       $cell[$n][$col][3] = $1;
  174.       print STDERR "  column ", $col," from ", $-[1], " to ", $+[1],
  175.         ": ", $&,
  176.         "\n";
  177.     }
  178.     $header{$n} = $col;
  179.   }
  180. }
  181.  
  182. sub table {
  183.   validate();
  184.   start();
  185.   caption();
  186.   head();
  187.   body();
  188.   foot();
  189.   end();
  190.   reset_dfa();
  191. }
  192.  
  193. sub validate {
  194.   # Problem rows have number of columns != maxcols
  195.   @colspanempty = ();
  196.   foreach my $k (sort {$a<=>$b} keys(%header)){
  197.     print STDERR "header on line $k has $header{$k} columns\n";
  198.     if($header{$k}!=$maxcol) { push @colspanempty, $k; }
  199.   }
  200.   foreach my $k (sort {$a<=>$b} keys(%body)){
  201.     print STDERR "row on line $k has $body{$k} columns\n";
  202.     if($body{$k}!=$maxcol) { die "malformed row on line $k has $body{$k} columns should be $maxcol\n";}
  203.   }
  204. }
  205.  
  206. sub head {
  207.   if(scalar @colspanempty){
  208.     head_colspan();
  209.   } else {
  210.     head_simple();
  211.   }
  212. }
  213.  
  214. sub head_colspan {
  215.   coalesce();
  216.   print "<thead>\n";
  217.   foreach my $r (sort {$a <=> $b} keys(%header)) {
  218.     print "<tr>\n";
  219.     my $c = 1;
  220.     my $h = 1;
  221.     my $span = 1;
  222.     while($c <= $maxcol && $h <= $header{$r}) {
  223.       if(overlaps($colpos[$c][0],$colpos[$c][1],$cell[$r][$h][0],$cell[$r][$h][1])){
  224.         my $startcol = $c;
  225.         while(++$c <= $maxcol && overlaps($colpos[$c][0],$colpos[$c][1],$cell[$r][$h][0],$cell[$r][$h][1])){
  226.           $span++;
  227.         }
  228.         print_header($cell[$r][$h][3],$startcol,$span);
  229.         $h++;
  230.         $span = 1;
  231.       } else { # no overlap
  232.         print_header("",$c,1);
  233.         $c++;
  234.       }
  235.     }
  236.     if($c<=$maxcol && $h>$header{$r}){
  237.       while($c++<=$maxcol) {
  238.         print_header("",$c,1);
  239.       }
  240.     }
  241.     print "</tr>\n";
  242.   }
  243.   print "</thead>\n";
  244. }
  245.  
  246.  
  247. sub start {
  248.   print "<table>\n";
  249. }
  250.  
  251. sub caption {
  252.   if(scalar @caption){
  253.     my $caption = join " ", @caption;
  254.     print "<caption>", encode_entities($caption), "</caption>\n";
  255.   }
  256. }
  257.  
  258. sub head_simple {
  259.   print "<thead>\n",
  260.     "<tr>\n";
  261.   foreach my $r (sort {$a <=> $b} keys(%header)) {
  262.     foreach my $c (1..$maxcol) {
  263.       print_header($cell[$r][$c][3],$c,1);
  264.     }
  265.   }
  266.   print "</tr>\n",
  267.     "</thead>\n";
  268. }
  269.  
  270. sub body {
  271.   my $s = -1; # row number within current body number
  272.   my $t = -1; # tbody number
  273.   foreach my $r (sort {$a <=> $b} keys(%body)) {
  274.     if($t!=$cell[$r][1][4]) {
  275.       if($t!=-1){ print "</tbody>\n"; }
  276.       $t = $cell[$r][1][4];
  277.       $s=0;
  278.       print "<tbody style=\"", $t%2==1?"odd":"even", "\">\n";
  279.     }
  280.     $s++;
  281.     print "<tr style=\"", $s%2==1?"odd":"even", "\">\n";
  282.     foreach my $c (1..$maxcol) {
  283.       my $data = $cell[$r][$c][3];
  284.       my $style = style($data);
  285.       print "<td style=\"$style\">", encode_entities($data), "</td>\n";
  286.     }
  287.     print "</tr>\n";
  288.   }
  289.   print "</tbody>\n";
  290. }
  291.  
  292. sub foot {
  293.   if(scalar @footer){
  294.     print "<tfoot>\n";
  295.     foreach my $f (@footer) {
  296.       print "<tr>\n",
  297.         "<td colspan=\"$maxcol\">", encode_entities($f), "</td>\n",
  298.         "</tr>\n";
  299.     }
  300.     print "</tfoot>\n";
  301.   }
  302. }
  303.  
  304. sub end {
  305.   print "</table>\n";
  306. }
  307.  
  308. sub coalesce {
  309.   # This subroutine looks at rows that have maxcol cells
  310.   # and uses the data in these cells to establish the minimum
  311.   # positions/widths in each column. It's merely a guess,
  312.   # and other possibilities exist.
  313.  
  314.   @colpos = ();
  315.   for my $c (1..$maxcol) {
  316.     $colpos[$c][0] = 1_000_000;
  317.     $colpos[$c][1] = -1;
  318.   }
  319.   foreach my $r (keys %header) {
  320.     next unless $header{$r} == $maxcol;
  321.     for my $c (1..$maxcol) {
  322.       print STDERR "cell[$r][$c] = (",
  323.         $cell[$r][$c][0], ", ",
  324.         $cell[$r][$c][1], ", ",
  325.         $cell[$r][$c][3], ")\n";
  326.       if( $cell[$r][$c][0] < $colpos[$c][0] ){
  327.         $colpos[$c][0] = $cell[$r][$c][0];
  328.       }
  329.       if( $cell[$r][$c][1] > $colpos[$c][1] ){
  330.         $colpos[$c][1] = $cell[$r][$c][1];
  331.       }
  332.     }
  333.   }
  334.   foreach my $r (keys %body) {
  335.     for my $c (1..$maxcol) {
  336.       print STDERR "cell[$r][$c] = (", $cell[$r][$c][0], ", ",
  337.         $cell[$r][$c][1], ", ",
  338.         $cell[$r][$c][3], ")\n";
  339.       if( $cell[$r][$c][0] < $colpos[$c][0] ){
  340.         $colpos[$c][0] = $cell[$r][$c][0];
  341.       }
  342.       if( $cell[$r][$c][1] > $colpos[$c][1] ){
  343.         $colpos[$c][1] = $cell[$r][$c][1];
  344.       }
  345.     }
  346.   }
  347.   # print colpos
  348.   for my $c (1..$maxcol) {
  349.     print STDERR "column $c starts at ",
  350.       $colpos[$c][0], " and ends at ",
  351.       $colpos[$c][1], "\n";
  352.   }
  353. }
  354.  
  355. sub overlaps {
  356. =begin comment
  357.  Does column a overlap column b?
  358.  Imagine a is made of minuses and b plusses. There are 7 cases:
  359.  
  360.  minus coincides plus:
  361.  -----
  362.  +++++
  363.  
  364.  minus before plus:
  365.  -----    
  366.       +++++
  367.  
  368.  minus after plus:
  369.       -----
  370.  +++++
  371.  
  372.  minus overlaps start of plus:
  373.  -----
  374.    +++++
  375.  
  376.  minus overlaps end of plus:
  377.     -----
  378.  +++++
  379.  
  380.  minus contains plus:
  381.  -----
  382.   +++
  383.  
  384.   minus contained by plus:
  385.   ---
  386.  +++++
  387.  
  388. =end comment
  389. =cut
  390.  
  391.   my ($a1,$a2,$b1,$b2) = @_;
  392.   if(    ($a1 >= $b1 && $a1 <= $b2) # overlaps end
  393.       || ($a2 >= $b1 && $a2 <= $b2) # overlaps start
  394.       || ($a1 <= $b1 && $a2 >= $b2) # contains, coincides
  395.       || ($a1 >= $b1 && $a2 <= $b2) # contained by, coincides
  396.   ){
  397.     1;
  398.   } else {
  399.     0;
  400.   }
  401. }
  402.  
  403. sub print_header {
  404.   my ($str,$c,$span) = @_;
  405.   my $style = ($c == 1) ? "first" : "other";
  406.   print "<th style=\"$style\"";
  407.   if($span != 1){ print " colspan=\"$span\""; }
  408.   print ">", encode_entities($str), "</th>\n";
  409. }
  410.  
  411. sub trim {
  412.   my ($str) = @_;
  413.   $str =~ s/^\s+//;
  414.   $str =~ s/\s+$//;
  415.   return $str;
  416. }
  417.  
  418. sub style {
  419.   my ($str) = @_;
  420.   if($str eq "."){ return "dot"; }
  421.   if($str eq "0"){ return "quantity"; }
  422.   if($str =~ /^\d+\s?-\s?\d+$/){ return "range"; }
  423.   if($str =~ /^\d+(\+\d+)?$/){ return "value"; }
  424.   if($str =~ /^\d+\D/){ return "quantity"; }
  425.   return "object";
  426. }
  427.  
  428. sub reset_dfa {
  429.   %header = ();
  430.   %body = ();
  431.   @cell = ();
  432.   @colpos = ();
  433.   @colspanempty = ();
  434.   $body=0;
  435.   $maxcol=0;
  436.   @caption=();
  437.   @footer=();
  438. }
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!