scandoc.pl

精通tomcat书籍原代码,希望大家共同学习

    # print STDERR "Popping!\n";
    return 1;
  }
  elsif (&matchRBracket) {
    &skipBody;
  }
  elsif ((($valid, $token) = &matchAny) && $valid) {
    # Comment in for debugging
    # print STDERR "token: $token \n";
  }
  else { return 0; }
  
  return 1;
}

# read a file into a string ( filename, default-value )
sub readFile {
  local ( $filename, $result ) = @_;
  
  if ($filename && open( FILE, $filename )) {
    $result = "";
    while (<FILE>) { $result .= $_; }
    close( FILE );
  }
  return $result;
}

# Read the entire document template and translate into PERL code.
sub readTemplate {
  local ( $filename ) = @_;
  $docTemplate = '';
  $indent = '';
  $literal = 1;  # We're in literal mode.
  
  if (!-e $filename) {
    if (-e "./templates/$filename") { $filename = "./templates/$filename"; }
    elsif (-e "../templates/$filename") { $filename = "../templates/$filename"; }
    else { die "Could not find template '$filename'.\n"; }
  }
  
  open( FILE, $filename ) || die "Error opening '$filename'.\n";
  while (<FILE>) {
    last if (/END/);
    
    # if we found a code entry.
    for (;;) {
      &expandTabs( $_ );
      if ($literal) {
	# Check for beginning of code block.
	if (s/^(.*)\<\<//) {
	  $line = $1; 
	  if (substr( $line, 0, length( $indent ) ) eq $indent) {
	    substr( $line, 0, length( $indent ) ) = '';
	  }
	  
	  if ($line ne '') {
	    $line =~ s/\"/\\\"/g;
	    $line =~ s/\$\((\w+)\.(\w+)\)/\" \. \$$1->$2() \. \"/g;
	    $docTemplate .= "${indent}print\"$line\";";
	  }
	  # else { $docTemplate .= "\n"; }
	  $literal = 0;
	}
	else {
	  if (substr( $_, 0, length( $indent ) ) eq $indent) {
	    substr( $_, 0, length( $indent ) ) = "";
	  }
	  chop;
	  s/\"/\\\"/g;
	  s/\$\((\w+)\.(\w+)\)/\" \. \$$1->$2() \. \"/g;
	  $_ = $indent . "print \"" . $_ . "\\n\";\n";
	  last;
	}
      }
      else {
	# Check for beginning of literal block.
	if (s/^(\s*)\>\>//) {
	  $indent = $1;
	  $literal = 1;
	}
	elsif (s/^(\s*)(.*)\>\>//) {
	  $docTemplate .= "$indent$2";
	  $literal = 1;
	}
	else {
	  last;
	}
      }
    }
    
    $docTemplate .= $_;
  }
  close( FILE );
  # print $docTemplate;
}

# Functions intended to be called from doc template file.

# Open a new output file
sub file {
  my $mfile = $_[ 0 ];
  
  open( STDOUT, ">$destPath$mfile" ) || die "Error writing to '$mfile'\n";
}

# return list of package objects
sub packages {
  my ($p, @r);
  @r = ();
  
  foreach $p (sort keys %packages) {
    push @r, $packages{ $p };
  }
  return @r;
}

# return list of source files which have to-do lists
sub todolistFiles {
  my ($p, @r);
  @r = ();
  
  foreach $p (sort keys %todolist) {
    push @r, $p;
  }
  return @r;
}

# return list of tab-delimited to-do-list texts.
sub todolistEntries {
  local $_ = $todolist{ $_[0] };
  s/^\s+//;				# Remove whitespace from beginning
  s/\s+$/\n/;				# Remove whitespace from end
  return split( /\n/, $_ );
}

# Convert package name to URL.
sub packageURL {
  my $p = $_[0];
  
  if ($p eq 'General') { $p = '.general'; }
  if ($p eq '') { $p = '.general'; }
  
  if (ref $packages{ $p }) {
    return $packages{ $p }->url();
  }
  return 0;
}

# Get the see-also list for an object
sub seealsoList {
  my $self = shift;
  my ($see, $name, $url, $p, @r);
  @r = ();
  
  if (defined ($self->{ 'see' })) {
    foreach $_ (split(/\n/,$self->{ 'see' })) {
      
      if (/^\<a\s+href/) { # if already an HREF.
	$name = $_;
	$url = 0;
      }
      elsif (/([^\#]*)\#(.*)/) { # If a package name is present
	$url = &packageURL( $1 ) . '#' . $2;
	$name = $2;
      }
      else {
	$name = $_;
	$url = "#$_";
	
	# This doesn't appear to do anything - so I commented it.  (james)
	# Look up the package in the index and use it to construct the html filename.
	#if (/^([^\:]*)\:\:(.*)/) {
	#  $className = ($1 eq '') ? '' : $classToPackage{ $1 };
	#  $p = $packageToFile{ $className };
	#  if ($p ne '') {
	#    $url = &packageURL( $1 ) . '#' . $_;
	#  }
	#}
      }
      
      $url =~ s/^\:*//;		# Remove leading colons from name
      $url =~ s/::/-/g;		# Replace :: with dash
      
      my $entry = { 'name' => $name,
		    'url'  => $url };
      
      bless $entry, DocReference;
      
      push @r, $entry;
    }
  }
  return @r;
}

# Class for parsed package
package PackageRecord;

sub classes {
  my $self = shift;
  my $classes = $self->{ 'classes' };
  return map $classes->{ $_ }, (sort keys %$classes);
}

sub globals {
  my $self = shift;
  my $globals = $self->{ 'globals' };
  return map $globals->{ $_ }, (sort keys %$globals);
}

sub globalvars {
  my $self = shift;
  my $globals = $self->{ 'globals' };
  my ($p, @r);
  @r = ();
  
  foreach $p (sort keys %$globals) {
    my $m = $globals->{ $p };
    if ($m->{ 'type' } ne 'func') { push @r, $m; }
  }
  return @r;
}

sub globalfuncs {
  my $self = shift;
  my $globals = $self->{ 'globals' };
  my ($p, @r);
  @r = ();
  
  foreach $p (sort keys %$globals) {
    my $m = $globals->{ $p };
    if ($m->{ 'type' } eq 'func') { push @r, $m; }
  }
  return @r;
}

sub name {
  my $self = shift;
  return $self->{ 'name' };
}

sub url {
  my $self = shift;
  return "default-pkg.html" if ($self->{ 'name' } eq '.general');
  return $self->{ 'name' } . '.html';
}

sub anchor {
  my $self = shift;
  my $url = $self->{ 'name' };
  return $url;
}

# Class for parsed class
package ClassRecord;

sub keywords    { return ${$_[0]}{ 'keywords' }; }
sub author      { return ${$_[0]}{ 'author' }; }
sub version     { return ${$_[0]}{ 'version' }; }
sub name        { return ${$_[0]}{ 'name' }; }
sub longname    { return ${$_[0]}{ 'longname' }; }
sub fullname    { return ${$_[0]}{ 'fullname' }; }
sub scopename   { return ${$_[0]}{ 'scopename' }; }
sub sourcefile  { return ${$_[0]}{ 'sourcefile' }; }
#sub description { return &::processDescription( ${$_[0]}{ 'description' } ); }
sub description { return ${$_[0]}{ 'description' }; }
sub seealso     { &::seealsoList( $_[0] ); }

sub url {
  my $self = shift;
  return 0 unless $self->{ 'package' };
  my $pname = ::packageURL( $self->{ 'package' } );
  my $url = $self->{ 'uname' };
  $url =~ s/::/-/g;
  return "$pname#$url";
}

sub anchor {
  my $self = shift;
  my $url = $self->{ 'uname' };
  $url =~ s/::/-/g;
  return $url;
}

sub members {
  my $self = shift;
  my $members = $self->{ 'members' };
  my ($p, @r);
  @r = ();
  
  foreach $p (sort keys %$members) {
    push @r, $members->{ $p };
  }
  return @r;
}

sub membervars {
  my $self = shift;
  my $members = $self->{ 'members' };
  my ($p, @r);
  @r = ();
  
  foreach $p (sort keys %$members) {
    my $m = $members->{ $p };
    if ($m->{ 'type' } ne 'func') { push @r, $m; }
  }
  return @r;
}

sub memberfuncs {
  my $self = shift;
  my $members = $self->{ 'members' };
  my ($p, @r);
  @r = ();
  
  foreach $p (sort keys %$members) {
    my $m = $members->{ $p };
    if ($m->{ 'type' } eq 'func') { push @r, $m; }
  }
  return @r;
}

sub baseclasses {
  my $self = shift;
  my $bases = $self->{ 'bases' };
  my ($p, $class, @r);
  @r = ();
  
  foreach $p (@$bases) {
    
    unless ($class = $::classList{ $p }) {
      # It's one we don't know about, so just make something up
      $class = { 'name'    => $p,
		 'longname'=> "class $p",
		 'fullname'=> "class $p",
		 'scopename'=>"class $p",
		 'uname'   => $p,
		 'members' => {} };
      
      if ($::classToPackage{ $p }) {
	$class->{ 'package' } = $::classToPackage{ $p };
      }
      
      bless $class, ClassRecord;
    }
    push @r, $class;
  }
  return @r;
}

sub subclasses {
  my $self = shift;
  my $subs;
  my ($p, $class, @r);
  @r = ();
  
  if (defined ($self->{ 'subs' })) {
    $subs = $self->{ 'subs' };
    foreach $p (sort @$subs) {
      $class = $::classList{ $p };
      push @r, $class;
    }
  }
  return @r;
}

# Class for parsed class member or global
package MemberRecord;

sub type         { return ${$_[0]}{ 'type' }; }
sub keywords     { return ${$_[0]}{ 'keywords' }; }
sub author       { return ${$_[0]}{ 'author' }; }
sub version      { return ${$_[0]}{ 'version' }; }
sub name         { return ${$_[0]}{ 'name' }; }
sub longname     { return ${$_[0]}{ 'longname' }; }
sub fullname     { return ${$_[0]}{ 'fullname' }; }
sub scopename    { return ${$_[0]}{ 'scopename' }; }
sub returnValue  { return ${$_[0]}{ 'return' }; }
sub sourcefile   { return ${$_[0]}{ 'sourcefile' }; }
sub description  { return ${$_[0]}{ 'description' }; }
sub seealso      { &::seealsoList( $_[0] ); }

sub url {
  my $self = shift;
  return 0 unless $self->{ 'package' };
  my $pname = ::packageURL( $self->{ 'package' } );
  my $url = $self->{ 'uname' };
  $url =~ s/::/-/g;
  return "$pname#$url";
}

sub anchor {
  my $self = shift;
  my $url = $self->{ 'uname' };
  $url =~ s/::/-/g;
  $url;
}

sub params {
  my $self = shift;
  my $params = $self->{ 'param' };
  my @r;
  @r = ();
  
  return 0 unless ($params);
  
  my @paramList = split( /\t/, $params );
  
  for ($i = 1; $i < $#paramList; $i += 2) {
    my $entry = { 'name'        => $paramList[ $i ],
		  'description' => $paramList[ $i + 1 ] };
    
    bless $entry, ArgRecord;
    
    push @r, $entry;
  }
  return @r;
}

sub exceptions {
  my $self = shift;
  my $params = $self->{ 'exception' };
  my @r;
  @r = ();
  
  return 0 unless ($params);
  
  my @paramList = split( /\t/, $params );
  
  for ($i = 1; $i < $#paramList; $i += 2) {
    my $entry = { 'name'        => $paramList[ $i ],
		  'description' => $paramList[ $i + 1 ] };
    
    bless $entry, ArgRecord;
    
    push @r, $entry;
  }
  return @r;
}

package ArgRecord;
sub name        { return ${$_[0]}{ 'name' }; }
sub description { return ${$_[0]}{ 'description' }; }

package DocReference;
sub name        { return ${$_[0]}{ 'name' }; }
sub url         { return ${$_[0]}{ 'url' }; }