scandoc.pl

Apache V2.0.15 Alpha For Linuxhttpd-2_0_15-alpha.tar.Z

#!/usr/bin/perl
#
# ScanDoc - Version 0.12,  A C/C++ Embedded Documentation Analyser
# ----------------------------------------------------------------
#
# Distributed under the "Artistic License".  See the file 
# "COPYING" that accompanies the ScanDoc distribution.
#
# See http://scandoc.sourceforge.net/ for more information and
# complete documentation.
#
# (c) 1997 - 2000 Talin and others.

require "ctime.pl";
require "getopts.pl";

# 1 = on (verbose); 0 = off 
$debug = 0;

# Get the current date
$date = &ctime(time);

# Set the default tab size
$tabSize = 4;

$minorVersion = 12;
$majorVersion = 0;
$scandocURL   = "http://scandoc.sourceforge.net/";

# Set up default templates
&Getopts( 'i:d:p:t:' );

if ($#ARGV < 0) {
  die "Usage: -i <doc-template> -p <output-path> -t<tabsize> -d<sym>=<value> [ <input-files> ... ]\n";
}

# Read the template
if (!defined $opt_i) {
  $opt_i = "default.pl";
}
&readTemplate( $opt_i );

# Set the destination path.
$destPath = "";
$destPath = $opt_p if (defined($opt_p));

# Set the tab size.
$tabSize = $opt_t if (defined($opt_t));

# Handle defines
if ($opt_d) {
  foreach $def (split( /,/, $opt_d )) {
    if ($def =~ /\s*(\w*)\=(.*)/) {
      $${1} = $2;
    }
    else {
      $${1} = 1;
    }
  }
}

# For each input filename, parse it
while ($srcfile = shift(@ARGV)) {

  $linenumber = 0;
  open( FILE, $srcfile ) || die "Can't open file $srcfile\n";
  print STDERR "Reading \"$srcfile\"\n";
  
  $docTag = 'description';
  $docEmpty = 1;
  $packageName = '.general';
  $author = '';
  $version = '';
  $class = 0;
  $_ = '';
  
  while (&parseDeclaration( '' )) {}
}

# Collate subclasses and associate with class record.
foreach $className (keys %subclasses) {
  my $class = &classRecord( $className );
  
  if ($class) {
    my @subs = ();
    # print STDERR "$className ", join( ',', @{$subclasses{ $className }} ), "\n";
    foreach $subName ($subclasses{ $className }) {
      if (&classRecord( $subName )) {
	push @subs, $subName;
      }
      $class->{ 'subs' } = @subs;
    }
  }
}

# Turn packages into objects. Special case for "default" package.
foreach $pkg (keys %packages)
{
  # print STDERR $pkg, "\n";
  bless $packages{ $pkg }, PackageRecord;
  if ($pkg eq '.general') {
    $packages{ $pkg }{ 'name' } = "General";
  }
  else {
    $packages{ $pkg }{ 'name' } = $pkg;
  }
  # print STDERR $packages{ $pkg }->Classes(), "\n";
}

# Execute template file
# print STDERR $docTemplate; # For debugging
eval $docTemplate;
print STDERR $@;

exit;

# ======================= Subroutines ================================

# Read a line of input, and remove blank lines and preprocessor directives.
sub rdln {
  my ($skip_next_line) = 0;
  if (defined ($_)) {
    my ($previous_line) = $_;
    while ( (/^(\s*|\#.*)$/ || $skip_next_line ) && ($_ = <FILE>)) {
      if ($previous_line =~ m/\\\s*/) { $skip_next_line = 1; }
      else { $skip_next_line = 0; }
      $previous_line = $_;
      $linenumber++; 
      if ($debug) { print STDERR "(0:$srcfile) $linenumber.\n"; } 
    }
  }
  # Dispose of Apache specific macros
  removeApacheMacros();
}

# Don't skip "#"
sub rdln2 {
  if (defined ($_)) {
    while (/^(\s*)$/ && ($_ = <FILE>)) {$linenumber++; if ($debug) { print STDERR "(0:$srcfile) $linenumber.\n"; } }
  }
}

# Remove comments from current line
sub removeComment {
  s|//.*||;
}

# parsing functions
sub matchKW		{ &rdln; return (s/^\s*($_[0])//, $1) if defined ($_); return (0, 0); }
#sub matchStruct		{ &rdln; return (s/^\s*(struct|class)//, $1) if defined ($_); return (0, 0); }
#sub matchPermission	{ &rdln; return (s/^\s*(public|private|protected)// && $1) if defined ($_); return (0,0); }
sub matchID		{ &rdln; return (s/^\s*([A-Za-z_]\w*)//, $1) if defined ($_); return (0,0); }
sub matchColon		{ &rdln; return (s/^\s*\://) if defined ($_); return 0; }
sub matchComma		{ &rdln; return (s/^\s*\,//) if defined ($_); return 0; }
sub matchSemi		{ &rdln; return (s/^\s*\;//) if defined ($_); return 0; }
sub matchRBracket	{ &rdln; return (s/^\s*\{//) if defined ($_); return 0; }
sub matchLBracket	{ &rdln; return (s/^\s*\}//) if defined ($_); return 0; }
sub matchRParen		{ &rdln; return (s/^\s*\(//) if defined ($_); return 0; }
sub matchLParen		{ &rdln; return (s/^\s*\)//) if defined ($_); return 0; }
sub matchRAngle		{ &rdln; return (s/^\s*\<//) if defined ($_); return 0; }
sub matchLAngle		{ &rdln; return (s/^\s*\>//) if defined ($_); return 0; }
sub matchDecl           { &rdln; return (s/^(\s*[\s\w\*\[\]\~\&\n\:]+)//, $1) if defined ($_); return (0, 0); }
sub matchOper		{ &rdln; return (s/^\s*([\~\&\^\>\<\=\!\%\*\+\-\/\|\w]*)// && $1) if defined ($_); return 0; }
sub matchFuncOper	{ &rdln; return (s/^\s*(\(\))// && $1) if defined ($_); return 0; }
sub matchAny		{ &rdln; return (s/^\s*(\S+)//, $1) if defined ($_); return (0, 0); }
sub matchChar		{ &rdln; return (s/^(.)//, $1) if defined ($_); return (0, 0); }
sub matchChar2	        { &rdln2; return (s/^(.)//, $1) if defined ($_); return (0, 0); }
sub matchString 	{ &rdln; return (s/^\"(([^\\\"]|(\\.)))*\"//, $1) if defined ($_); return (0, 0); }

# Skip to next semicolon
sub skipToSemi {
  
  while (!&matchSemi) {
    
    &rdln;
    s|//.*||;			# Eat comments
      if (&matchLBracket) {
	&skipBody;
	next;
      }
    last if !s/^\s*([^\s\{\;]+)//;
    # print STDERR "$1 ";
  }
}

# Skip function body
sub skipBody {
  local( $nest );
  
  $nest = 1;
  
  for (;;) {
    if (&matchRBracket) { $nest++; }
    elsif (&matchLBracket) {
      $nest--;
      last if !$nest;
    }
    else { 
      last if ((($valid,) = &matchKW( "[^\{\}]")) && !$valid);
    }
  }
}

# Skip a string. (multiline)
sub skipString {
  local( $char, $lastchar);
  $lastchar = "\"";
  
  for (;;) {
    ($valid, $char) = &matchChar2;
    if (($char eq "\"") && ($lastchar ne "\\")) { last; }
    if ($lastchar eq "\\") { $lastchar = " "; }
    else { $lastchar = $char; }
  }
}


# Skip everything in parenthesis.
sub skipParenBody {
  local( $nest );
  
  $nest = 1;
  
  for (;;) {
    if (&matchRParen) { $nest++; }
    elsif (&matchLParen) {
      $nest--;
      last if !$nest;
    }
    else { 
      last if ((($valid,) = &matchKW( "[^\(\)]")) && !$valid);
    }
  }
}

# Parse (*name) syntax
sub parseParenPointer {
  if (s/^(\s*\(\s*\*)//) {
    $decl .= $1;
    $nest = 1;
    
    for (;;) {
      # Preserve spaces, eliminate in-line comments
      &removeComment;
      while (s/^(\s+)//) { $decl .= $1; &rdln; }
      
      if (&matchRParen) { $nest++; $decl .= "("; }
      elsif (&matchLParen) {
	$decl .= ")";
	$nest--;
	last if !$nest;
      }
      elsif ((($valid, $d) = &matchKW( "[^\(\)]*")) && $valid) { $decl .= $d; }
      else { last; }
    }
    
    # Just in case there are array braces afterwards.
    while ((($valid, $d) = &matchDecl) && $valid) { $decl .= $d; }
  }
}

# Parse template arguments
sub matchAngleArgs {
  
  if (&matchRAngle) {
    local ($args, $nest);
    
    $args = "&lt;";
    $nest = 1;
    
    for (;;) {
      if (&matchRAngle) { $nest++; $args .= "&lt;"; }
      elsif (&matchLAngle) {
	$nest--;
	$args .= "&gt;";
	last if !$nest;
      }
      elsif ((($valid, $d) = &matchChar) && $valid) { $args .= $d; }
      else { last; }
    }
    return $args;
  }
  else { return ''; }
}

# convert tabs to spaces
sub expandTabs {
  local	($text) = @_;
  local 	($n);
  
  while (($n = index($text,"\t")) >= 0) {
    substr($text, $n, 1) = " " x ($tabSize-($n % $tabSize));
  }
  
  return $text;
}

# Process a line of text from a "special" comment
sub handleCommentLine {
  local ($_) = @_;
  
  if ($docEmpty) {
    # Eliminate blank lines at the head of the doc.
    return if (/^\s*$/);
  }
  
  # First, expand tabs.
  $_ = &expandTabs( $_ );
	
  # Remove gratuitous \s*\s  (james)
  s/(^|\n)\s*\*\s/$1/g;
  
  # If it's one of the standard tags
  if (s/^\s*\@(see|package|version|author|param|return|result|exception|keywords|deffunc|defvar|heading|todo)\s*//) {
    my $tag = $1;
    $tag = 'return' if ($tag eq 'result');
    
    # for param and exception, split the param name and the text
    # seperate them with tabs.
    if ($tag eq "param" || $tag eq "exception") {
      s/^\s*(\w+)\s*(.*)/\t$1\t$2/;
    }
    elsif ($tag eq "heading") {
      # 'heading' is processed by the template, if at all.
      $_ = "\@heading\t$_";
      $tag = "description";
    }
    elsif ($tag eq 'todo') {
      if ($todolist{ $srcfile } ne '') {
	$todolist{ $srcfile } .= "\n";
      }
    }
    
    # If it's @deffunc or @defvar
    if ($tag =~ /def(.*)/) {
      
      $type = $1;
      
      # @deffunc and @defvar force a comment to be written out as if there was a
      # declaration.
      # Designed for use with macros and other constructs I can't parse.
      
      if (/(\S+)\s+(.*)$/) {
	$name = $1;
	$decl = $2;
	$dbname = &uniqueName( "$baseScope$name" );
	
	my $entry = { 'type'    => $type,
		      'name'    => $name,
		      'longname'=> $name,
		      'fullname'=> "$name $decl",
		      'scopename'=>"$baseScope$name",
		      'uname'   => $dbname,
		      'decl'    => $decl,
		      'package' => $packageName };

        bless $entry, MemberRecord;

	if ($class) {
	  $entry->{ 'class' } = "$context";
	  $class->{ 'members' }{ $dbname } = $entry;
	} 
	else {
	  $packages{ $packageName }{ 'globals' }{ $dbname } = $entry;
	}
	$docTag = 'description';
	&dumpComments( $entry );
	return;
      }
    }
    elsif ($tag eq 'package') {
      s/^\s*//;
      s/\s*$//;
      $packageName = $_;
      $docTag = 'description';
      return;
    }
    elsif ($tag eq 'author') {
      $author = $_;
      $docTag = 'description';
      return;
    }
    elsif ($tag eq 'version') {
      $version = $_;
      $docTag = 'description';
      return;
    }
    
    $docTag = $tag;
  }
  elsif (/^\s*@\w+/) {
    # any other line that begins with an @ should be inserted into the main
    # description for later expansion.
    $docTag = 'description';
  }
  
  # "To-do" lists are handled specially, and not associated with a class.
  if ($docTag eq 'todo') {
    $todolist{ $srcfile } .= $_;
    return;
  }
  
  # Append to current doc tag, regardless of whether it's a new line
  # or a continuation. Also mark this doc as non-empty.
  $docTags{ $docTag } .= $_;
  $docEmpty = 0;
  
  # @see doesn't persist.
  if ($docTag eq 'see') { $docTag = 'description'; }
  
  # print STDERR ":$_";
}

# Clear doc tag information at end of class or file
sub clearComments {
  
  $docTag = 'description';
  $docEmpty = 1;
  %docTags = ();
}

# Add doc tag information to current documented item
sub dumpComments {
  local ($hashref) = @_;
  
  if ($docEmpty == 0) {
    
    if ($author ne  '') { $hashref->{ 'author'  } = $author;  }
    if ($version ne '') { $hashref->{ 'version' } = $version; }
    $hashref->{ 'sourcefile' } = $srcfile;
    
    # Store the tags for this documentation into the global doc symbol table
    foreach $key (keys %docTags) {
      my $data = $docTags{ $key };

      $data =~ s/\s*$//;
      
      $hashref->{ $key } = $data;
    }
  }
  
  &clearComments();
}

# Generate a unique name from the given name.
sub uniqueName {
  local ($name) = @_;