/usr/lib/grass64/tools/g.html2man

#!/bin/sh  -- #perl, to stop looping
eval 'exec $GRASS_PERL -S $0 ${1+"$@"}'
    if 0;

############################################################################
#
# MODULE:       g.html2man
# AUTHOR(S):    Daniel Calvelo Aros
# PURPOSE:      convert HTML formatted page to MAN page format
# COPYRIGHT:    (C) 2004 by the GRASS Development Team
#
#               This program is free software under the GNU General Public
#               License (>=v2). Read the file COPYING that comes with GRASS
#               for details.
#
#############################################################################

# Note: the GRASS_PERL variables must be set!
# Usage:
#       perl g.html2man <html file> <man file> <section>

our $preformat, $in_bu, $in_nb, @nb_n;
our $suppress = 0;

sub CvtTable {
#
# converts <table> structures to tbl commands.
#
# limitations: malformed (sloppy html) tables won't convert
# properly, eg no closing tags are bad. 
# <th> headers are handled; nested <table>s are not
#
# since tables may be line-formatted randomly, this function
# works on a full file; thus, the original line-oriented
# unbuffered design had to be changed.
#
# modify $format if centered headings and left-aligned
# contents don't suit you.
#
# also, groff recognizes the tbl commands and preprocesses
# accordingly; for other roff formatters that is uncertain.
# it might be advisable to put a '.\" t' line at the beginning
# of the output file
#
# TODO: rewrite g.html2man using the HTML::Parser module
#
  my $i = shift;
  return $i unless $i =~ m|<table.*?>(.+?)</table>|is;
  my $header = ".TS\nexpand box;\n";
  $_ = $1;
  ($one_row,) = m|<tr.*?>(.+?)</tr>|is ;
  $ncols = -1 + scalar split /<td/i, $one_row;
  $has_header = m|<th|i ;
  s|[\n\r]||g;
  s|</tr.*?>|\n.br\n|gis;
  s|</td.*?>|\t|gis;
  foreach $tag ( qw(<td.*?> <th.*?> </th> <tr.*?>) ){
    s/$tag//gi;
  }
  $format = $has_header
          ? "cb"x$ncols . "\n"."-"x$ncols . "\n"
	  : "";
  $format .= "l"x$ncols . ".\n";
  $i =~ s|<table.*?>.+?<table>|$header$format$_.TE\n|is;
  return CvtTable($i);
}

sub basename {
  $slash = rindex($_[0], "/");
  $suffix = rindex($_[0], $_[1]);
  if ($suffix == -1) {$suffix=length($_[0])};
  return substr($_[0], $slash+1, $suffix-$slash-1);
}                                                                               

sub GetTitle {
  while (<INP>) {
    if (m#<TITLE>.*MAN page for:#i) {
      s#<TITLE>##i;
      s#MAN page for:##i;
      s#</TITLE>##i;
      @TITLE = split;
      return 1;
    }
    if (m#<TITLE>#i) {
      return 1;
    }
  }
  return 0;
}

sub PrintHeader {
      print OUT ".TH $_[0] $_[1] \"\" \"GRASS " . $ENV{'VERSION_NUMBER'} . "\" \"Grass User's Manual\"\n";
##      print OUT ".so /usr/share/lib/tmac/sml\n";
##      print OUT ".so /usr/share/lib/tmac/rsml\n";
}

sub DoStrip {
  if (m#<.*TITLE>#i) { return 1};
  if (m/<.*HEADER>/i) { return 1};
  if (m/<.*HEAD>/i) { return 1};
  if (m/<.*BODY>/i) { return 1};
  if (m/<.*HEADER>/i) { return 1};
  if (m/<.*BLINK>/i) { return 1};
  if (m/^<A HREF="#toc/i) {return 1};
  if (s#<A HREF=".*">##i) {
      s#</A>##i;
  }
  return 0;
}

sub DoLine {

  if (m#</PRE>#i) {
    s#</PRE>#\n.DE\n\\fR#i;
    $preformat = 0;
    return 1;
  }
###  if ($preformat) {return 1};
  if (m#<PRE>#i) {
    s#^.*<PRE>#\\fC\n.DS#i;
    $preformat = 1;
    return 1;
  }
  s#<IMG SRC=.*>##i;
  if (m#<A NAME="toc">#i) {return 2};
  s#<A NAME=".*">##i;
  #s#<\!\-\-#.\\\" #i;
  #s#\-\->##i;
  if (m#^<HR.*>$#i) {return 0};
  s#<HR>##i;
  s#<HR .*>##i;
  if (&DoStrip($_)) {return 0}
  &DoFont($_);
  if (! &DoList($_)) {return 0};
  if (! &DoSection($_)) {return 0}
  &DoEscape($_);
  &DoPara($_);
  if (! $preformat) {
    if (m/^$/) {return 0};
    s#^[ \t]*##;
    s#<[^>]*>##g;
  }
  return 1;
}

sub DoEscape {
  s#&gt;#>#i;
  s#&lt;#<#i;
  s#&amp;#&#i;
  s#&quot;#"#i;
  s#&nbsp;# #i;
  s#&copy;#©#i;
  s#&auml;#ä#i;
  s#&uuml;#ü#i;
  s#&lt;#<#i;
  s#&gt;#>#i;
}

sub DoSection {
  if (m#^ *Table of Contents *$#i) {return 0};
  if (m#^<A NAME=".*">$#i) {return 0;}
  s#<A NAME=".*">##i;
  s#^.*<H2>#.SH #i;
  s#^.*<H3>#.SS #i;
  s#^.*<H4>#.SS #i;
  if (m#^</[^>]*>$#i) {return 0};
  s#</[^>]*>##ig;
  s#^<BR>$#.br#i;
  s#<BR>#\n.br\n#i;
  return 1;
}


#================
# Paragraph breaks: <P>
#
sub DoPara {
  s/^ *<P>/.PP\n/i;
  s/<P>/\n.PP\n/ig;
  return;
}

#================
# Lists
#    <DL><DT><DD>
#
sub DoList {
  if (m#^ *</DT> *$#i) {return 0};
  if (m#<DT> *$#i) {chop};
  s#^ *<DT>#.IP \"#i;
  s#<DT>#\n.IP \"#i;
  s#</DT>#\" 4m#i;

  if (m#^ *<DD> *$#i) {return 0};
  if (m#^ *</DD> *$#i) {return 0};
  if (m#^</LI>$#i) {return 0};
  s#<DD>#\n.br\n#i;
  s#</DD>##i;

  s#^.*<DL> *$##i;
  s#<DL>#\n.VL 4m\n#i;

  s#^.*</DL> *$#.PP#i;
  s#<DL>#\n.IP\n#i;

  s|<UL>|\n.RS\n|i and $in_bu=1;
  s|</UL>|\n.RE\n|i and $in_bu=0;

  s|<OL>|\n..IP\n|i and ($in_nb++,$nb_n[$in_nb]=1); # @nb_n is a stack allowing for nested <ol>'s
  s|</OL>|\n.PP\n|i and ($nb_n[$in_nb]=0,$in_nb--);

  s|</LI>||i;
  if(/<li>/){
    $in_bu and s|<LI>|\n.IP\n|i;
    $in_nb and (                          # since we're hand-composing the ordered lists (not using mm's .AL),
      $n=(join ".", (                     # we use a uniform indentation and x.y.z numbering 
        (map {$_-1} @nb_n[1..($in_nb-1)]) # nb_n's are one beyond the current number for the levels above current
	,
	$nb_n[$in_nb])),                  # and exact for the current level
      s|<li>|\n.IP \\fB$n\\fR\n|i, 
      $nb_n[$in_nb]++                     # because we post-increment after encountering each <li>
      );
  }

  # move into CvtTable()  ??
  s/<TD.*?>/\t| /gi;
  s/<TR.*?>/\n.br\n/i;

  return 1;
}

#================
# Font transitions: 
#   <B>  => \fB
#   </B> => \fR
#   <I>  => \fI
#   </I> => \fR
#
sub DoFont {
  s# *</B> *_ *<B> *#_#ig;
  s#</B> *<B># #ig;
  s#<B>#\\fB#ig;
  s#</B>#\\fR#ig;
  s#<SUP>#\\u#ig;
  s#</SUP>#\\d#ig;

  s# *</I> *_ *<I> *#_#ig;
  s#</I> *<I># #ig;
  s#<I>#\\fI#ig;
  s#</I>#\\fR#ig;
  s# *</CODE> *_ *<CODE> *#_#ig;
  s#</CODE> *<CODE># #ig;
  s#<CODE>#\\fI#ig;
  s#</CODE>#\\fR#ig;
  s# *</EM> *_ *<EM> *#_#ig;
  s#</EM> *<EM># #ig;
  s#<EM>#\\fI#ig;
  s#</EM>#\\fR#ig;
  s/&NBSP;/ /ig;
  return;
}

#==================
# Process HTML file

$infile = $ARGV[0];
$outfile = $ARGV[1];
$preformat = 0;
$page = &basename($ARGV[0], ".html");
$sect = $ARGV[2];
open(INP,$infile) || die "Can't open '$infile' for reading: $!";
if (! &GetTitle($page,$sect)) {  
  print "$infile: Did not find a valid <TITLE> line\n";
  close(INP);
  exit;
}
open(OUT,"> $outfile") || die "Can't open '$outfile' for writing: $!";
print "Converting: $infile to $outfile\n";
&PrintHeader($page,$sect,$TITLE[0]);

while (<INP>) {
  # for intro pages which lack a module NAME (for whois entry)
  if ($_ =~ s/<!-- meta page description:(.*)-->/$1/) {
	print OUT ".SH NAME\n$page \\-$_\n";
  }

  s/\\/\\(rs/g;
  $result = &DoLine($_);
  if ($result == 2) {
    close(INP);
    close(OUT);
    return;
  }

  if (&DoLine($_) == 1) {
    s#&lt#<#g;
    s#&gt#>#g; 
    s#^'#\\(cq#gm;
    s#^"#\\(dq#gm;
    s#`#\\(ga#g;

    #
    # this part removes the comments
    # 
    $line = $_;
    $line =~ s/<!--.*-->//g; # 
    if ($line =~ s/(.*)<!--.*/$1/) {
        $suppress = 1;
        $out .= $line;
    }
    if ($line =~ s/.*\-\-\>(.*)/$1/g) {
        print $line
        $suppress = 0;
    }
    if ($suppress != 0) {
        $line = "";
    }
    #
    # end of comment part
    #
    
    $out .= $line;

    if ($preformat == 1) {
      $out .= ".br\n";
    }
  }
}
$out =~ s/\n+/\n/gm;
print OUT CvtTable($out);
close(INP);
close(OUT);

exit;
grass-dev 6.4.3-3 / usr / lib / grass64 / tools / g.html2man
