#!/usr/local/bin/perl -w

#@(#) OA96 <Olivier.Aubert@enst-bretagne.fr>
#@(#) autodoc.pl - (Quasi) automatic documentation of perl programs

# This script is distributed under the GNU General Public License
# version 2.1 or later. See http://www.fsf.org/

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2.1, or (at your option)
# any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# A copy of the GNU General Public License can be obtained from this
# program's author (send electronic mail to the above address) or from
# Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
# or from the Free Software Foundation website: http://www.fsf.org/

use strict;

# Misc
$Autodoc::RCSversion = q$Revision: 1.5 $;
($Autodoc::version) = ($Autodoc::RCSversion =~ /Revision:\s+([\d]+\.[\d]+)/);

use Getopt::Std;

# We use an array of size $maxlines to find the parameters that follow
# a function.
$Autodoc::maxlines = 10;

# Prefix used to indent comments
$Autodoc::prefix = "  ";

# Simplification for my own style:
#  * Always a blank line before a function (or its associated comment)
#  * Comments are separated from the function definition with a blank line, or
#    no line at all
#  * The parameters extraction is separated from the body of the function
#    itself with a blank line
$Autodoc::my_style = 1;

# VT100 codes
$Autodoc::bold     = "\e[1m";
$Autodoc::norm     = "\e[m";
$Autodoc::italic   = "\e[4m";

@Autodoc::before = ();
@Autodoc::after  = ();

&getopts('chmpu7') or &usage;
# $opt_c : comments only
# $opt_h : help
# $opt_m : (more) pipe through pager
# $opt_p : parameters only
# $opt_u : ugly style (i.e. not good style)
# $opt_7 : no VT100 codes
(undef, undef) = ($::opt_u, $::opt_7);

$Autodoc::my_style = 0 if $::opt_u;

if (! $::opt_c && ! $::opt_p)
{
  $::opt_c = 1;
  $::opt_p = 1;
}

if ($::opt_7)
{
  $Autodoc::bold = "";
  $Autodoc::norm = "";
  $Autodoc::italic = "";
}

# Pager choice
$Autodoc::pager = $ENV{'PAGER'} || 'less';

# If the pager is "less", we use the -r option to interpret VT100 codes
if ($Autodoc::pager =~ /less/)
{
  $Autodoc::pager .= " -r";
}

$Autodoc::fichier = shift(@ARGV) || &usage;

if ($::opt_m)
{
  $Autodoc::pager_pid = open(SORTIE, "| $Autodoc::pager")
  or die "Cannot redirect stdout: $!\n";
}
else
{
  open(SORTIE, ">-") or die "Cannot open stdout: $!\n";
  $Autodoc::pager_pid = 0;
}

select(SORTIE);

open(F, $Autodoc::fichier) or die "Cannot open $Autodoc::fichier: $!\n";
@Autodoc::after = <F>;
close(F);

my $line;

while (scalar(@Autodoc::after) > 0)
{
  $line = shift(@Autodoc::after);

  last if ($line =~ /^\s*__END__/ || $line =~ /^\s*__DATA__/);
  
  if ($line =~ /^\s*sub\s+(\S+)\s/)
  {
    &display_fonction($1);
  }
  # We want to have the lines backwards in @before, it's easier for the
  # following processing
  unshift(@Autodoc::before, $line);
}

# We "tell" the pager that the output is done
close(SORTIE);

# We wait for the pager to quit
waitpid($Autodoc::pager_pid, 0) if ($::opt_m);

exit 0;

# Displays information about current function
sub display_fonction
{
  my($fonction) = shift;
  my(@header) = ();
  my(@tail) = ();
  my($in_comment) = 0;
  my $i;
  
  # Comments immediately preceding the function declaration
  for (@Autodoc::before)
  {
    # Maybe there's a blank line between
    if (/^\s+$/)
    {
      next if (! $in_comment);
      # We take the comment down to the previous blank line
      last; #  if ($in_comment);
    }
    
    if (/^\s*\#/)
    {
      $in_comment = 1;
      # We put it backwards again (from @Autodoc::before) to get the
      # comment in the right order
      unshift(@header, $_);
      next;
    }

    # If we're here, the line is neither a comment, nor a blank line
    # then we're done with the comment processing
    last;
  }

  # We look at the $maxlines following lines to try and find
  # information about parameters
  for $i (1 .. $Autodoc::maxlines)
  {
    $_ = $Autodoc::after[$i];

    last if ($Autodoc::my_style && /^\s+$/);
    
    if (/\@_/ || /shift/ || /\$_/)
    {
      push(@tail, $_);
    }
  }

  print "${Autodoc::bold}Function $fonction${Autodoc::norm}\n";
  
  if ($::opt_c && scalar(@header) != 0)
  {
    print "Comment:\n";
    print $Autodoc::prefix, join($Autodoc::prefix, @header);
  }

  if ($::opt_p && scalar(@tail) != 0)
  {
    print "Parameters:\n";
    print $Autodoc::prefix, join($Autodoc::prefix, @tail);
  }
  print "\n";
}

# Display help
sub usage
{

  print <<'EOF';
Syntax:
  autodoc.pl [options] file.pl

  Helps documenting perl programs by extracting functions and associated
  comments and parameters.

Options:
  -c  : Display only comments
  -h  : This help screeen
  -m  : pipe the output through a pager
  -p  : Displays only parameters
  -u  : "Ugly style" (i.e. not "my" style)
  -7  : Don't use VT100 codes

Notes:
  Comments are in fact just any comment block, without any blank line,
  just before a function declaration. There can be one or many blank lines
  between the comment and the function declaration.

  The function name must always be on the same line as the keyword "sub".

  Parameters are looked for in the 10 lines following the function declaration.
  They are the lines containing  "shift", "@_" or "$_".

  "My" style (as opposed to the "ugly style", -u option) is to always put
  a blank line between parameters extraction and the start of the function
  body itself.
EOF

print <<"EOF";
   
  OA96 -- Version $Autodoc::version
  
EOF

  exit 0;
}