home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / fteo46b5.zip / fteo46b5 / scripts / html2ipf.pl < prev    next >
Perl Script  |  1998-01-31  |  12KB  |  397 lines
  1. #!perl5 -w
  2.  
  3. # html2ipf - version 0.5
  4. # by Marko Macek, mark@hermes.si | marko.macek@snet.fer.uni-lj.si
  5. # needs some work, but is much faster than 0.2.
  6.  
  7. # version 0.4: handle some internal A HREF and A NAME.
  8. # version 0.5 changed things to make it work with multiple html files.
  9.  
  10. use strict qw(refs subs);
  11.  
  12. $h2i = 'html2ipf';
  13. $h2i_version = '0.4';
  14.  
  15. print ".*! $h2i $h2i_version\n\n";
  16.  
  17. $dl_param = 'compact tsize=10 break=all';
  18. $ol_param = 'compact';
  19. $ul_param = 'compact';
  20. $lmargin  = ':lm margin=1.';
  21. $fontspec = ''; #:font facename=Helv size=16x8.';
  22.  
  23. undef $/; # slurp whole file as one line
  24.  
  25. # read input files
  26. $file_count = 0; 
  27. while (<>) {
  28.     $file_name[$file_count] = $ARGV;
  29.     $file_text[$file_count] = $_;
  30.     printf STDERR
  31.         "file:%s size:%s\n",
  32.         $file_name[$file_count],
  33.         length $file_text[$file_count];
  34.     $file_count++;
  35. };
  36.  
  37. $wasws = 0;
  38. %rnames = ();
  39.  
  40. print ":userdoc.\n";
  41. print ":title.FTE Manual\n";
  42.  
  43. for ($pass = 1; $pass <= 2; $pass++) {
  44.     $nheads = 0;
  45.     $list_level = 0;
  46.     $head_level = 0;
  47.     $pre = 0;
  48.     $in_head = 0;
  49.     $ahref = 0;
  50.     $naname = 0;
  51.  
  52.     @styles = ();
  53.  
  54.     for ($fn = 0; $fn < $file_count; $fn++) {
  55.         $line = $file_text[$fn];
  56.         $curfile = $file_name[$fn];
  57.         $cpos = 0;
  58.         
  59.         TAG: while ($opos = $cpos,
  60.                     ($cpos = index($line, "<", $cpos) + 1) != 0) # skip to next tag
  61.         {
  62.             pos($line) = $cpos;  # match regexp there
  63.             
  64.             &out(substr($line, $opos, pos($line) - $opos - 1)); # output text
  65.             
  66.             $TAG = undef;
  67.             
  68.             if ($line =~ /\G!(.*?)(--.*?--\s*)*(.*?)>/sgo) { # comment
  69.                 $cpos = pos $line;
  70.                 #&comment($2);
  71.                 next TAG;
  72.             }
  73.             
  74.             pos ($line) = $cpos;
  75.             if ($line =~ /\G\s*([\/]?[A-Za-z0-9]*)/go) {
  76.                 $cpos = pos($line);
  77.                 $TAG = uc $1;
  78.                 
  79.                 #print "<|", $TAG, "\n";
  80.             }
  81.             
  82.             undef %ARGS;
  83.             
  84.             ARG:
  85.                 while (1) {
  86.                     pos($line) = $cpos;
  87.                     
  88.                     if ($line =~ /\G\s*/go) { $cpos = pos ($line); } # skip whitespace
  89.                     
  90.                     last ARG unless $line =~ /\G([A-Za-z0-9]+)\s*/go; # param name
  91.                     $cpos = pos $line;
  92.                     
  93.                     $pname = uc $1;
  94.                     if ($line =~ /\G=\s*/go) {
  95.                         $cpos = pos $line;
  96.                         
  97.                         if ($line =~ /\G"([^"]*)"\s*/go) {
  98.                             $cpos = pos $line;
  99.                             #print "+|$pname=\"$1\"\n";
  100.                             $ARGS{$pname} = $1;
  101.                             next ARG;
  102.                         };
  103.                         pos($line) = $cpos;
  104.                         if ($line =~ /\G'([^']*)'\s*/go) {
  105.                             $cpos = pos $line;
  106.                             #print "+|$pname='$1'\n";
  107.                             $ARGS{$pname} = $1;
  108.                             next ARG;
  109.                         };
  110.                         pos($line) = $cpos;
  111.                         if ($line =~ /\G([^ <>"']+)\s*/go) {
  112.                             $cpos = pos $line;
  113.                             #print "+|$pname=$1\n";
  114.                             $ARGS{$pname} = $1;
  115.                             next ARG;
  116.                         };
  117.                         $ARGS{$pname} = "";
  118.                         die "no value for tag";
  119.                     }
  120.                     #print "+|$pname\n";
  121.                 }
  122.                 pos($line) = $cpos;
  123.                 ($cpos = index($line, ">", $cpos) + 1) != 0 or die "tag without end";
  124.                 
  125.                 &tag($TAG, \%ARGS);
  126.         }
  127.         
  128.         &out(substr($line, $opos, length($line) - $opos));
  129.         print STDERR "\n";
  130.     }
  131.  
  132.     warn "styles left on stack: " . join(">", @styles) if  ($#styles >= 0);
  133. }
  134.  
  135. print "\n:euserdoc.\n";
  136.  
  137. print STDERR $nheads . " headings.\n";
  138.  
  139. sub put {
  140.     my $lin = $_[0];
  141.  
  142.     print $lin;
  143.  
  144.     $wasws = ($lin =~ /[\n\t ]$/os);
  145. }
  146.  
  147. sub pushstyle {
  148.     my $style = $_[0];
  149.  
  150.     print ":$style.";
  151.     return ;
  152.     $i = $#styles;
  153.     while ($i > 0) {
  154.         print ":e$styles[$i].";
  155.         $i--;
  156.     }
  157.     push(@styles, $style);
  158.     print ":$style.";
  159. }
  160.  
  161. sub popstyle {
  162.     my $style = $_[0];
  163.  
  164.     print ":e$style.";
  165.     return ;
  166.  
  167.     warn if $style ne $styles[$#style];
  168.     print ":e$style.";
  169.     pop (@styles);
  170.     $i = 0;
  171.     while ($i < $#styles) {
  172.         print ":$styles[$i].";
  173.         $i--;
  174.     }
  175. }
  176. sub addindex {
  177.     my $what = $_[0];
  178.     my $id = $_[1];
  179.  
  180.     $rnames{$what} = $id;
  181.     #print STDERR "$what :: $id\n";
  182. }
  183.  
  184. sub tag {
  185.     my $TAG = $_[0];
  186.     my %ARGS = %{$_[1]};
  187.  
  188.     if ($pass == 1) { # during first pass, check for: A NAME=...
  189.         $TAG =~ /^\/H[1-6]$/o  && do {
  190.             $nheads++;
  191.             print STDERR ".";
  192.         }
  193.         or $TAG eq 'A' && do {
  194.             $naname++;
  195.             #print STDERR %ARGS if $naname > 1;
  196.             if (defined $ARGS{"NAME"}) {
  197.                 $aname = $curfile . '#' . $ARGS{"NAME"};
  198.                 addindex($aname, $nheads - 1);
  199.             } 
  200.         }
  201.         or $TAG eq '/TITLE' && do {
  202.             addindex($curfile, $nheads);
  203.             $nheads++;
  204.         }
  205.         or $TAG eq '/A' && do {
  206.             $naname-- if ($naname > 0);
  207.         }
  208.     } elsif ($pass == 2) {
  209.         $list_level = ($list_level < 0) ? 0 : $list_level;
  210.         
  211.         $TAG eq 'B'       && do { pushstyle('hp2') unless $in_head; }
  212.         or $TAG eq '/B'      && do { popstyle('hp2') unless $in_head; }
  213.         or $TAG eq 'STRONG'  && do { pushstyle('hp7')  unless $in_head; }
  214.         or $TAG eq '/STRONG' && do { popstyle('hp7') unless $in_head; }
  215.         or $TAG eq 'I'       && do { pushstyle('hp1')  unless $in_head; }
  216.         or $TAG eq '/I'      && do { popstyle('hp1') unless $in_head; }
  217.         or $TAG eq 'TT'      && do { pushstyle('hp2')  unless $in_head; }
  218.         or $TAG eq '/TT'     && do { popstyle('hp2') unless $in_head; }
  219.         or $TAG eq 'BR'      && do { put("\n.br\n"); $wasws = 1; }
  220.         or $TAG eq 'HR'      && do { put("\n.br\n"); $wasws = 1; }
  221.         or $TAG eq 'P'       && do { put("\n:p."); $wasws = 1; }
  222.         or $TAG eq 'LI'      && do { put("\n:li."); $wasws = 1;} 
  223.         or $TAG eq 'CENTER'  && do { put(':lines align=center.'); }
  224.         or $TAG eq '/CENTER' && do { put(':elines.'); $wasws = 1; }
  225.         or $TAG eq 'DL'      && do { put(":dl " . $dl_param . '.'); $list_level++; } 
  226.         or $TAG eq '/DL'     && do { put(':edl.'); $list_level--; $wasws = 1; }
  227.         or $TAG eq 'DD'      && do { put("\n:dd."); $wasws = 1; }
  228.         or $TAG eq 'DT'      && do { put("\n:dt."); $wasws = 1; }
  229.         or $TAG eq 'PRE'     && do { put(':xmp.'); $pre++; }
  230.         or $TAG eq '/PRE'    && do { put(':exmp.'); $pre--; $wasws = 1; }
  231.         or $TAG eq 'XMP'     && do { put(':xmp.'); $pre++; }
  232.         or $TAG eq '/XMP'    && do { put(':exmp.'); $pre--; $wasws = 1; }
  233.         or $TAG eq 'OL>'     && do { put(":ol " . $ol_param . '.'); $list_level++; }
  234.         or $TAG eq '/OL'     && do { put(":eol."); $list_level--; $wasws = 1; }
  235.         or $TAG eq 'UL'      && do { put(":ul " . $ul_param . '.'); $list_level++; }
  236.         or $TAG eq '/UL'     && do { put(":eul."); $list_level--; $wasws = 1; }
  237.         or $TAG eq 'IMG'     && do {
  238.             $pic = $ARGS{"SRC"};
  239.             $pic =~ s/gif$/bmp/i;
  240.             put(":artwork runin name='$pic'.") unless $in_head;
  241.         }
  242.         or $TAG eq 'TITLE' && do {
  243.             $hl = 1;
  244.             if ($hl > $head_level + 1) { # hack for bad headings
  245.                 $hl = $head_level + 1;
  246.             }
  247.             $head_level = $hl;
  248.             put("\n:h$hl id=$nheads.");
  249.             $in_head = 1;
  250.             $curhead = "";
  251.         }
  252.         or $TAG eq '/TITLE' && do {
  253.             $nheads++;
  254.             put("\n" . $fontspec . $lmargin . ":i1." . $curhead . "\n:p.");
  255.             $in_head = 0;
  256.             $wasws = 1;
  257.         }
  258.         or $TAG eq '/A' && do { 
  259.             if ($ahref > 0) {
  260.                 put(":elink.");
  261.                 --$ahref;
  262.             }
  263.         }
  264.         or $TAG eq 'A' && do {
  265.             if (defined $ARGS{"HREF"}) {
  266.                 $ref = $ARGS{"HREF"};
  267.                 $ref = $curfile . $ref if $ref =~ /^\#/;
  268.                 
  269.                 if (defined $rnames{$ref}) {
  270.                     $id = $rnames{$ref};
  271.                     put(":link reftype=hd refid=$id.");
  272.                     ++$ahref;
  273.                 } else {
  274.                     print STDERR "no link for " . $ref . "\n";
  275.                 }
  276.                 #} else {
  277.                     # print STDERR "external ref not handled: " . $ARGS{"HREF"} . "\n";
  278.                     #}
  279.             }
  280.         }
  281.         or $TAG =~ /^\/H[1-6]$/o  && do {
  282.             $nheads++;
  283.             put("\n" . $fontspec . $lmargin . ":i1." . $curhead . "\n:p.");
  284.             $in_head = 0;
  285.             $wasws = 1;
  286.             print STDERR ".";
  287.         }
  288.         or $TAG =~ /^H([1-6])/o   && do {
  289.             $hl = $1 + 1;
  290.             if ($hl > $head_level + 1) { # hack for bad headings
  291.                 $hl = $head_level + 1;
  292.             }
  293.             $head_level = $hl;
  294.             put("\n:h$hl id=$nheads.");
  295.             $in_head = 1;
  296.             $curhead = "";
  297.         }
  298.     }
  299. }
  300.  
  301. sub out {
  302.     my $lin = $_[0];
  303.     my $first = 1;
  304.     my $i;
  305.  
  306.     return if ($pass == 1);
  307.  
  308.     #$lin =~ s/\<\;/\</og;
  309.     #$lin =~ s/\>\;/\>/og;
  310.     #$lin =~ s/\&\;/\&/og;
  311.     ##$lin =~ s/\n/ /og;
  312.     #print $lin;
  313.  
  314.     #    $lin =~ s/\./\&per\./og;             # .
  315.     $lin =~ s/\<\;/\</og;            # <
  316.     $lin =~ s/\>\;/\>/og;            # >
  317.     $lin =~ s/\:/\&colon\./og;         # :
  318.     $lin =~ s/\&\;/\&\./og;      # &
  319.  
  320.     if ($pre > 0) {
  321.         print $lin; 
  322.     } else {
  323. #        $lin =~ s/\n / /osg;
  324.         $lin =~ s/\n/ /osg;
  325.         $lin =~ s/ +/ /og;
  326.         if ($wasws) {
  327.             $lin =~ s/^ +//o;
  328.         }
  329.         if ($in_head) {
  330.             $curhead .= $lin;
  331.         }
  332.         
  333.         while ($lin ne "") {
  334.             put("\n") unless ($first);
  335.             put(" ") if $line =~ /^\./;
  336.             if (length($lin) <= 70) {
  337.                 put($lin);
  338.                 $lin = "";
  339.             } else {
  340.                 $i = 70;
  341.                 if ($i > length $lin) { $i = length $lin; }
  342.                 while ($i > 0 && substr($lin, $i, 1) ne ' ') { $i--; }
  343.                 if ($i == 0) { $i = 70 };
  344.                 if ($i > length $lin) { $i = length $lin; }
  345.                 put(substr($lin, 0, $i));
  346.         $lin = substr($lin, $i + 1);
  347.                 $lin =~ s/^ +//o;
  348.                 $first = 0;
  349.             }
  350.         }
  351.     }
  352. }
  353.  
  354. sub comment {
  355. #my $comm = $_[0];
  356.  
  357. #print $comm;
  358. }
  359.  
  360. sub badtag {
  361. #    my $badtag = $_[0];
  362. #    print "<$badtag>"; # ?
  363. }
  364. __END__
  365. sub tag {
  366.     my $TAG = $_[0];
  367.     my %PARM = %{$_[1]};
  368.     my @ARGS = @{$_[2]};
  369.     
  370.     print "<$TAG";
  371.     foreach $n (@ARGS) {
  372.         $key = $ARGS[$n][2];
  373.         print ' ';
  374.         print $key                             if $ARGS[$n][0] == -1;
  375.         print $key, '=', $ARGS[$n][1]          if $ARGS[$n][0] == 0;
  376.         print $key, '=\'', $ARGS[$n][1], '\''  if $ARGS[$n][0] == 1;
  377.         print $key, '="', $ARGS[$n][1], '"'    if $ARGS[$n][0] == 2;
  378.     }
  379.     print ">\n";
  380. }
  381.  
  382. sub out {
  383.     my $lin = $_[0];
  384.     
  385.     $lin =~ s/\n/ /;
  386.     
  387.     print " |", $lin, "\n";
  388. }
  389.  
  390. sub comment {
  391.     my $comm = $_[0];
  392.  
  393.     print "#|", $comm;
  394. }
  395.  
  396. __END__
  397.