scandoc.pl

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

  
  # Duplicate doc entries need to be distinguished, so give them a different label.
  while ($docs{ $name }) {
    if ($name =~ /-(\d+)$/) {
      $name = $` . "-" . ($1 + 1);
    }
    else { $name .= "-2"; }
  }
  
  $docs{ $name } = 1;
  return $name;
}

# Get the current class record.
sub classRecord {
  local ($className) = @_;
  local ($pkg) = $classToPackage{ $className };
  
  if ($pkg) {
    return $packages{ $pkg }{ 'classes' }{ $className };
  }
  return 0;
}

# Parse a declaration in the file
sub parseDeclaration {
  
  local ($context) = @_;
  local ($baseScope) = '';
  local ($decl);
  my ($token);
  
  if ($context) { $baseScope = $context . "::"; }
  
  &rdln;

  if (!defined ($_)) { return 0; }
  
  if (s|^\s*//\*\s+||) {
    # Special C++ comment
    &handleCommentLine( $' );
    $_ = ''; &rdln;
  }	
  elsif (s|^\s*//||) { 
    # Ordinary C++ comment
    $_ = '';
    &rdln;
  }
  elsif (s|^\s*\/\*\*\s+||) {
    # Special C comments
    
    s/\={3,}|\-{3,}|\*{3,}//;			# Eliminate banner strips
    $text = '';
    $docTag = 'description';
    
    # Special comment
    while (!/\*\//) { &handleCommentLine( $_ ); $text .= $_; $_ = <FILE>; $linenumber++; if ($debug) { print STDERR "(1) $linenumber\n."; }}
    s/\={3,}|\-{3,}|\*{3,}//;			# Eliminate banner strips
    /\*\//;
    &handleCommentLine( $` );
    $text.= $`; $_ = $';
  }
  elsif (s|^\s*\/\*||) {
    # Ordinary C comment
    $text = "";
    
    while (!/\*\//) { $text .= $_; $_ = <FILE>; $linenumber++; if ($debug) { print STDERR "(2) $linenumber\n."; }}
    /\*\//;
    $text.= $`; $_ = $';
  }
  elsif ((($valid, $tag) = &matchKW( "template")) && $valid) {
    # Template definition
    $args = &matchAngleArgs;
    &rdln;
    
    ##$tmplParams = $args; JAMES
    $result = &parseDeclaration( $context );
    ##$tmplParams = ''; JAMES
    return $result;
  }
  elsif ((($valid, $tag) = &matchKW("class|struct")) && $valid) {
    # Class or structure definition
    local ($className,$class);
    
    if ((($valid, $className) = &matchID) && $valid) {
      
      return 1 if (&matchSemi);		# Only a struct tag
      
      # A class instance
      if ((($valid,)=&matchID) && $valid) {
	&matchSemi;
	return 1;
      }
      
      my $fullName = "$baseScope$className"; ##$tmplParams"; JAMES
      # print STDERR "CLASS $fullName\n";
      
      my @bases = ();
      
      if (&matchColon) {
	
	for (;;) {
	  my $p;
	  &matchKW( "virtual" );
	  $perm = "private";
	  if ((($valid, $p) = &matchKW( "public|private|protected" )) && $valid) { $perm = $p; }
	  &matchKW( "virtual" );
	  
	  last if !(  (($valid, $base) = &matchID) && $valid  );
	  
	  push @bases, $base;
	  push @{ $subclasses{ $base } }, $fullName;
	  # print STDERR " : $perm $base\n";
	  last if !&matchComma;
	}
      }
      
      #	print STDERR "\n";
      # print STDERR "parsing class $fullName\n";

      if ($docEmpty == 0) {
	$class = { 'type'    => $tag,
		   'name'    => $fullName,
		   'longname'=> "$tag $className",
		   'fullname'=> "$tag $className",
		   'scopename'=> "$tag $fullName",
		   'uname'   => $fullName,
		   'bases'   => \@bases,
		   'package' => $packageName,
		   'members' => {} };
	
	# print STDERR "$className: @bases\n";
	
	bless $class, ClassRecord;
	
	print STDERR "   parsing class $fullName\n";
	# $classToPackage{ $className } = $packageName;
	$classToPackage{ $fullName } = $packageName;
	# $classList{ $className } = $class;
	$classList{ $fullName } = $class;
	$packages{ $packageName }{ 'classes' }{ $fullName } = $class;
	&dumpComments( $class );
      }
      
      if (&matchRBracket) {
	local ($perm) = ("private");
	
	while (!&matchLBracket) {
	  my $p;
	  if ((($valid, $p) = &matchKW( "public\:|private\:|protected\:" )) && $valid) {
	    $perm = $p;
	  }
	  else {
	    &parseDeclaration( $fullName )
	      || die "Unmatched brace! line = $linenumber\n";
	  }
	}
	
	&matchSemi;
      }
      
      &clearComments;
    }
  }
  elsif ( ((($valid,)=&matchKW( "enum")) && $valid) || ((($valid,)=&matchKW( "typedef" )) && $valid)) {
    &skipToSemi;
  }
  elsif ((($valid,)=&matchKW( "friend\s*class" )) && $valid) {
    &skipToSemi;
  }
  elsif ((($valid, $token) = &matchKW("extern\\s*\\\"C\\\"")) && $valid) {
    &matchRBracket;
    while (!&matchLBracket) {
      &parseDeclaration( '' ) || die "Unmatched brace! line = $linenumber\n";
    }
    &matchSemi;
  }
  # elsif ($kw = &matchID) {
  #   $type = "$kw ";
  #
  #   if ($kw =~/virtual|static|const|volatile/) {
  #	$type .= &typ;
  #   }
  # }
  elsif ((($valid, $decl) = &matchDecl) && $valid) {
    my ($instanceClass) = "";
    
    # print STDERR "DECLARATION=$decl, REST=$_, baseScope=$baseScope\n";

    return 1 if ($decl =~ /^\s*$/);

    if (!($class)) {
      if ($decl =~ s/(\S*\s*)(\S+)\:\:(\S+)\s*$/$1$3/) {
        $instanceClass = $2;
      }
    }

    # Eliminate in-line comments
    &removeComment;

    # Check for multi-line declaration
    while ((($valid, $d) = &matchDecl) && $valid) { $decl .= $d; }
    
    # Handle template args, but don't let operator overloading confuse us!
    $tempArgs = '';
    if (!($decl =~ /\boperator\b/) && ($tempArgs = &matchAngleArgs)) {
      $tempArgs = $decl . $tempArgs;
      $decl = '';
      while ((($valid, $d) = &matchDecl) && $valid) { $decl .= $d; }
    }
    
    # Look for (*name) syntax
    &parseParenPointer;
    
    # Special handling for operator... syntax
    $oper = "";
    if ($decl =~ s/\boperator\b(.*)/operator/) {
      $oper = $1;
      $oper .= &matchOper;
      # If, after all that there's no opers, then try a () operator
      if (!($oper =~ /\S/)) { $oper .= &matchFuncOper; }
    }

    ($type,$mod,$decl) = $decl =~ /([\s\w]*)([\s\*\&]+\s?)(\~?\w+(\[.*\])*)/;
    
    $type = $tempArgs . $type;
    $decl .= $oper;
    
    if ($mod =~ /\s/) { $type .= $mod; $mod = ""; }
    
    for (;;) {
      
      # print STDERR "Looping: $type/$mod/$decl\n";
      
      if (&matchRParen) {
	$nest = 1;
	$args = "";
	
	for (;;) {
	  # print STDERR "Argloop $_\n";
	  
	  # Process argument lists.
	  
	  # Preserve spaces, eliminate in-line comments
	  # REM: Change this to save inline comments and automatically
	  # generate @param clauses
	  s|//.*||;
	  while (s/^(\s+)//) { $args .= " "; &rdln; }
	  
	  if (&matchRParen) { $nest++; $args .= "("; }
	  elsif (&matchLParen) {
	    $nest--;
	    last if !$nest;
	    $args .= ")";
	  }
	  elsif ((($valid, $d) = &matchKW( "[\,\=\.\:\-]" )) && $valid) { $args .= $d; }
	  elsif ((($valid, $d) = &matchDecl) && $valid) { $args .= $d; }
	  elsif ((($valid, $d) = &matchAngleArgs) && $valid) { $args .= $d; }
	  elsif ((($valid, $d) = &matchString) && $valid) { $args .= "\"$d\""; }
	  else { last; }
	}
				
	# print STDERR "$type$mod$baseScope$decl($args);\n";
	
	&matchKW( "const" );
	
	# Search for any text within the name field
	# if ($docTag && $decl =~ /\W*(~?\w*).*/)
	if ($docEmpty == 0) {
	  $type =~ s/^\s+//;
	  $mod  =~ s/\&/\&amp;/g;
	  $args =~ s/\&/\&amp;/g;
	  $args =~ s/\s+/ /g;
	  $dbname = &uniqueName( "$baseScope$decl" );
	  
	  my $entry = { 'type'    => 'func',
			'name'    => $decl,
			'longname'=> "$decl()",
			'fullname'=> "$type$mod$decl($args)",
			'scopename'=>"$type$mod$baseScope$decl($args)",
			'uname'   => $dbname,
			'decl'    => "$type$mod$decl($args)",
			'package' => $packageName };
	  
	  bless $entry, MemberRecord;
	  
	  if ($class) {
	    $entry->{ 'class' } = "$context";
	    $class->{ 'members' }{ $dbname } = $entry;
	  }
	  elsif ($instanceClass) {
	    $class = &classRecord ($instanceClass);
	    if (!($class)) {
	      print STDERR "WARNING: Skipping \"$instanceClass\:\:$decl\".  Class \"$instanceClass\" not declared ($linenumber).\n";
	    } else {
	      $entry->{ 'class' } = "$instanceClass";
	      $class->{ 'members' }{ $dbname } = $entry;
	      $class = 0;
	    }
	  }
	  else {
	    $packages{ $packageName }{ 'globals' }{ $dbname } = $entry;
	  }
	  &dumpComments( $entry );
	}
	else { &clearComments; }
	
	s|//.*||;
	
	# Constructor super-call syntax
	if (&matchColon) {
	  
	  # Skip over it.
	  for (;;) {
	    &rdln;
	    last if /^\s*(\{|\;)/;
	    last if !((($valid,)=&matchAny) && $valid);
	  }
	}
	
	last if &matchSemi;
	if (&matchRBracket) { &skipBody; last; }
	last if !&matchComma;
	last if !((($valid, $decl) = &matchDecl) && $valid);
	
	# Look for (*name) syntax
	&parseParenPointer;
	
	$decl =~ s/^\s*//;
	$oper = "";
	if ($decl =~ /\boperator\b/) {
	  $decl =~ s/\boperator\b(.*)/operator/;
	  $oper = $1 . &matchOper;
	}
	($mod,$d) = $decl =~ /^\s*([\*\&]*)\s*(\~?\w+(\[.*\])*)/;
	$decl .= $oper;
	$decl = $d if $d ne "";
      }
      else {
	s|//.*||;
	
	$final = 0;
	
	if ((($valid,)=&matchKW( "\=" )) && $valid) {
	  for (;;) {
	    
	    if (&matchRBracket) {
	      &skipBody;
	      $final = 1;
	      last;
	    }
	    
	    if (&matchSemi) {
	      $final = 1;
	      last;
	    }
	    
	    # var = new ... (...)
	    if ((($valid,)=&matchKW("new")) && $valid) {
	      &matchKW("[A-Za-z_0-9 ]*");
	      if (&matchRParen) {
	        &skipParenBody;
	      }
	    }
	    
	    # var = (.....) ...
	    if (&matchRParen) {
	      &skipParenBody;
	    }
	    
	    # var = ... * ...
	    &matchKW ("[\/\*\-\+]*");
	    
	    # var = "..."
	    if ((($valid,) = &matchKW ("[\"]")) && $valid) {
	      &skipString;
	    }
	    #&matchString;
	    
	    last if /^\s*,/;
	    #last if !((($valid,)=&matchAny) && $valid);
	    last if !((($valid,)=&matchKW("[A-Za-z_0-9 \-]*")) && $valid);
	    if (&matchSemi) {
	        $final = 1;
	        last;
	    }
	  }
	}
	
	s|//.*||;
	
	# void ~*&foo[];
	# void foo[];
	# void far*foo[];
	# print STDERR "Decl: $type$mod$baseScope$decl;\n";

	# Search for any text within the name field
	if ($docEmpty == 0 && ($decl =~ /\W*(~?\w*).*/))
	  {
	    $mod  =~ s/\&/\&amp;/g;
	    $name = $decl;
	    
	    $dbname = &uniqueName( "$baseScope$1" );
	    
	    my $entry = { 'type'     => 'var',
			  'name'     => $1,
			  'longname' => "$name",
			  'fullname' => "$type$mod$decl",
			  'scopename'=> "$baseScope$type$mod$decl",
			  'uname'    => $dbname,
			  'decl'     => "$type$mod$decl",
			  'package'  => $packageName };
	    
	    bless $entry, MemberRecord;
	    
	    if ($class) {
	      $entry->{ 'class' } = "$context";
	      $class->{ 'members' }{ $dbname } = $entry;
	    }
	    else {
	      $packages{ $packageName }{ 'globals' }{ $dbname } = $entry;
	    }
	    &dumpComments( $entry );
	  }
	else { &clearComments; }
	
	last if $final;
	last if &matchSemi;
	last if !&matchComma;
	last if !((($valid, $decl) = &matchDecl) && $valid);
	
	# Look for (*name) syntax
	&parseParenPointer;
	
	$decl =~ s/^\s*//;
	($mod,$d) = $decl =~ /^\s*([\*\&]*)(\~?\w+(\[.*\])*)/;
	$decl = $d if $d ne "";
      }
    }
  }
  elsif ($context ne "" && /^\s*\}/) {
    # print STDERR "Popping!\n";
    return 1;
  }
  elsif (&matchRBracket) {
    &skipBody;
  }