#!/usr/bin/perl -w

# Tels: generate html documentation from .pm files

# [09/30/99] 0.0.1 first version
# [10/20/99] 0.0.2 added short description of each function
# 1999-11-07 0.0.3 used #doc instead of export, show list of parameters
# 1999-11-12 0.0.4 can handle function calls like bslabs() inside parameters
# 2000-01-09 0.0.5 adapted to parse subdirs
# 2000-02-06 0.0.6 take EXPORT, EXPORT_OK and doc
#                  constants as extra list (too many files, >5500 were generated and
#                  this consumed 180 mbyte for the 7 mb html on a 2 gig partition)

# where to get files from
$pmpath = "../Cowgen,../Cowgen/Architecture,../Cowgen/VWorld";  
$outpath = "html"; # where to put result
$tplpath = ".";    # where to get templates from

my $ver = "v0.0.6";
print "pm2html $ver (c) Copyright by Tels 1999-2000. All Rights Reserved.\n\n";

# check for html dir and create it on the fly

die ("Need a dir 'html', but there is already a file called 'html'!\n") 
 if ((-e "html") && (!-d "html"));
`mkdir html` if (!-e "html");
die ("Need the dir 'html', but couldn't create it!\n")
 if (!-e "html");

my $footer = readFile("$tplpath/footer.tpl");
my $header = readFile("$tplpath/header.tpl");

$mod = readFile("$tplpath/module.tpl");
$mod = $header . $mod . $footer;

my $sdtpl = readFile("$tplpath/sub.tpl");

my (@files,$dir,@dirfiles);
foreach $dir (split (',',$pmpath))
  {
  opendir (DIR, $dir) or die ("cant open dir $dir for reading: $!");
  @dirfiles = readdir(DIR);
  closedir(DIR);
  foreach (@dirfiles)
    {
    next unless /\.pm$/;
    push (@files, "$dir/$_");
    }
  }

@files = sort @files;
my $time = scalar localtime;
my $liste = ""; my $pm = "";
foreach (@files)
  { 
  next if /^\.\.?$/; # skip "." and ".."
  next unless /\.pm$/;
  $liste .= "<TR><TD>";
  $name = $_; $name =~ s/\.pm$//;
  print "Generating $name...\n";
  $pm = readFile ("$name.pm");
  $name =~ s/^\.\.\///;
  @lines = split (/\n/,$pm);
  $i = 0; $sdec = "";
  foreach (@lines) 
    {
    $i++;
    $sdec .= $_ if (($i > 1) && ($_ =~ /^#/));
    last if (($i > 2) && ($_ !~ /^#/));
    }
  $sdec =~ s/#//g;
  $link = $name; $link =~ s/.*\///g;
  $liste .= "<A HREF=\"$link.htm\">$name.pm</A><TD>$sdec\n";
  # extract list of functions
  $list = ""; $t = $pm; $t =~ s/#doc:\s(.*)/ $list .= " $1 "; /egi;
  $t = $pm; $t =~ s/EXPORT(_OK)?\s*=\s*qw\s*\(([^\)]*)\)/ $list .= " $2 "; /egi;
  $list =~ s/\s+/ /g;
  $list =~ s/^\s//g;
  $list =~ s/\s$//g;
  $constants = "<P><TABLE BORDER=0><TR>";
  @l = split (/\s/,$list);
  undef %subs;
  $list = ""; $sdec = ""; $col = 0;
  foreach (@l) 
    {
    if (($_ =~ /^[OolL]_/) || ($_ =~ /^[A-Z_]+$/) || ($_ =~ /^eax_/))
      {
      # constant
      $constants .= "<TD>$_"; 
      if ($col++ >= 4)
        {
        $col = 0; $constants .= "<TR>"; 
        }  
      }
    else
      {
      $subs{$_} = 1;
      }
    } # remove doubles
  $constants .= "</TABLE>";
  foreach $sub (sort keys %subs)
    {
    $sdec = ""; $ret = "Unknown";
    #extract sub
    $t = $pm; $t =~ s/sub $sub\s*{\s*((\n\s*#.*)+)/ $sdec = $1; /e;
    #$t = $pm; $t =~ s/sub $sub\s*{([^}])*\n\s*return\s*[^#]+#(.*)/ $ret = $2; /e;
    #$ret =~ s/#//g if (defined $ret);
    if (defined $sdec)
      {
      $dec = $sdec; $dec =~ s/[\s#\n]+/ /g;
      undef $t;
      $sdec =~ s/#([^#]+)#/ $t = $1; /e; $sdec = $t if (defined $t);
      $sdec =~ s/[\s#\n]+/ /g;
      $sdec = "&nbsp;" if ($sdec eq "");
      $dec = "&nbsp;" if ($dec eq "");
      $t = $dec; $t =~ /(named)?\sparameters?:(.*)/;

      $parm = "Not ready yet." if (!defined $2);
      if (defined $2) 
        {
        $parm = $2;
        $parm =~ s/\(\)/\[\]/g; # protect temp. function calls
        @p = split (",",$parm); 
        @p = sort @p if ($t =~ /named parameters?:/); # no sort for normal parameters
        $parm = "<TABLE BORDER=1><TR><TH>Name</TH><TH>Description</TH></TR>";
        foreach $z (@p)
          {
          $z =~ s/^\s+//; $z =~ s/\s+$//;
          if ($z =~ /\(/)
            {    
            @fi = split (/\(/,$z); $fi[1] =~ s/\)//; $fi[1] =~ s/;/,/g;
            $fi[1] =~ s/([a-zA-Z]+)\[\]/<A HREF=\"$1.htm\">$1\(\)<\/A>/g;
            }
          else
            {
            $fi[1] = ""; $fi[0] = $z;
            }
          $parm .= "<TD ALIGN=RIGHT>$fi[0]</TD><TD ALIGN=LEFT>$fi[1]</TD></TR>\n";
          }
        $parm .= "</TABLE>";
        $dec =~ s/(named)?\sparameters?:(.*)//;
        }
      }
    else
      {
      $sdec = ""; $dec = "";
      }
    $list .= "<TR><TD><A HREF=\"$link"."_$sub.htm\">$sub</A><TD>$sdec\n";+
    # create page w/ short description
    $sd = $header . $sdtpl . $footer;
    $sd =~ s/##sub##/$sub/g; 
    $sd =~ s/##name##/$link/g; 
    $sd =~ s/##returns##/$ret/g; 
    $sd =~ s/##description##/$dec/g; 
    $sd =~ s/##datetime##/$time/g;
    $sd =~ s/##version##/$ver/g;
    $sd =~ s/##parameter##/$parm/g;
    $img = "<IMG BORDER=0 SRC=\"../docimg/$sub.jpg\">";
    $img = "No image available." if (!-e "docimg/$sub.jpg");
    $sd =~ s/##img##/$img/g;
    $name =~ s/.*\///g;
    writeFile ("$outpath/$name"."_$sub.htm",$sd);
    }
  $m = $mod;
  $m =~ s/##liste##/$list/g;
  $m =~ s/##constants##/$constants/g;
  $m =~ s/##name##/$name/g;
  $m =~ s/##datetime##/$time/g;
  $m =~ s/##version##/v0.0.1/g;
  writeFile ("$outpath/$name.htm",$m);
  }

$tpl = readFile("$tplpath/contents.tpl");
$tpl = $header . $tpl . $footer;
$tpl =~ s/##liste##/$liste/g;
$tpl =~ s/##datetime##/$time/g;
$tpl =~ s/##version##/$ver/g;

print "Writing index...\n";
writeFile ("$outpath/index.htm",$tpl);

print "\nDone. See html/index.htm for more.\n";
# EOF
1;

## SUBs #######################################################################

sub readFile
  {
  $file = shift || "unknwon";
  open (FILE, $file) or die ("Cant open $file for reading: $!");
  my $tpl;
  while (<FILE>)
    {
    $tpl .= $_;
    }
  close(FILE);
  $tpl;
  }

sub writeFile
  {
  $file = shift || "unknwon"; $tpl = shift;
  open (FILE, ">$file") or die ("Cant open $file for writing: $!");
  print FILE $tpl;
  close(FILE);
  }
