[NetScript CVS] CVS: netscript2/src/tools/IPdoc CodeElement.pm,NONE,1.1 Global.pm,NONE,1.1 Class.pm,1.3,1.4 IPdoc.pm,1.4,1.5 NSDoclet.pm,1.3,1.4 Sub.pm,1.2,1.3

[Jan T. <de...@us...>]

Update of /cvsroot/net-script/netscript2/src/tools/IPdoc
In directory usw-pr-cvs1:/tmp/cvs-serv9937

Modified Files:
	Class.pm IPdoc.pm NSDoclet.pm Sub.pm 
Added Files:
	CodeElement.pm Global.pm 
Log Message:
* added index

--- NEW FILE: CodeElement.pm ---
#--------------------------------------------------------
# This class represents IPdoc, the insOMnia Perl documenting
# system.
# $Id: CodeElement.pm,v 1.1 2002/05/13 11:19:30 derkork Exp $
# 
# DOM2 and all related materials, such as documentation,
# are protected under the terms and conditions of the Artistic License.
# (C) 2000-2002 by Jan Thomä, insOMnia
# mailto: ko...@in...
#--------------------------------------------------------

package IPdoc::CodeElement;


use strict;

#--------------------------------------------------------
# Globals
#--------------------------------------------------------
our $VERSION = '1.0';


#/**
# constant for element type.
#*/
our $ELEMENT_TYPE = "element";


#/**
# Represents a class
# @public
#*/
sub new {
    my ($proto) = shift;
    my $class = ref( $proto ) || $proto;# get the Classname

    # Create a Class using the Hash-As-An-Object-Idiom
    my $this = {};
    bless( $this, $class );             # create Object
    my @subs = ();
    my @params = ();
    my @paramValues = ();
    $this -> { m_params } = \@params;
    $this -> { m_paramValues } = \@paramValues;
    $this;
    }

#/**
# Sets/returns a comment for this sub
# @optional a comment for this sub
# @return a comment for this sub
#*/
sub comment {
    my ($this, $comment) = @_;
    if (defined($comment)) {
        $this -> { m_comment } = $comment;
        }
    $this -> { m_comment };
    }

#/**
# Returns a hash reference containing all params set for this sub.
# Mapping is names => list reference containing the names, and 
# values => list reference containing the values.
# @return all params for this sub.
#*/
sub params {
    my ($this)  = @_;
    my @params = @{$this -> { m_params } };
    my @values = @{$this -> { m_paramValues } };
    return { names => \@params, values => \@values };
    }

#/**
# Adds a new param to this sub.
# @param the name of the parameter
# @param the value of the parameter
#*/
sub newParam {
    my ($this, $name, $value) = @_;
    push( @{$this->{m_params}},$name);
    push( @{$this->{m_paramValues}},$value);
    }


#/**
# Sets/returns the name of the class
# @optional the name of the class
# @return the name of the class
#*/
sub name {
    my ($this, $name) = @_;
    if ( defined($name) ) {
        $this -> { m_name } = $name;
        }
    $this -> { m_name };
    }


#/**
# Sets/returns the parent class object.
# @optional the parent class object
# @returns the parent class object
#*/
sub parent {
    my ($this, $parent) = @_;
    if (defined($parent)) {
        $this -> { m_parent } = $parent;
        }
    $this -> { m_parent };
    }

#/**
# Returns the element type (sub or global or class). 
#*/
sub elementType {
    $ELEMENT_TYPE;
    }

#/**
# Returns the full filename of the html file where this element info is 
# stored in. Defaults to the full filename name of the enclosing class.
# @return the full filename
# @public
#*/
sub fullFileName {
    my ($this) = @_;
    $this -> parent() -> fullFileName();
    }

#/**
# Returns the relative filename where this class documentation is stored 
# in.  Defaults to the relative filename of the enclosing class.
# @return the relative filename
# @public
#*/
sub relativeFileName {
    my ($this) = @_;
    $this -> parent() -> relativeFileName();
    }

1;

--- NEW FILE: Global.pm ---
#--------------------------------------------------------
# $Id: Global.pm,v 1.1 2002/05/13 11:19:30 derkork Exp $
# 
# DOM2 and all related materials, such as documentation,
# are protected under the terms and conditions of the Artistic License.
# (C) 2000-2002 by Jan Thomä, insOMnia
# mailto: ko...@in...
#--------------------------------------------------------
use strict;

#/** 
# This class represents a global variable.
#*/
package IPdoc::Global;
use base qw(IPdoc::CodeElement);


#--------------------------------------------------------
# Globals
#--------------------------------------------------------
our $VERSION = '1.0';

our $ELEMENT_TYPE = "global";


#/**
# Represents a class
# @public
#*/
sub new {
    my ($proto) = shift;
    my $class = ref( $proto ) || $proto;# get the Classname

    my $this = $class -> SUPER::new();
    $this;
    }

sub elementType {
    $ELEMENT_TYPE;
    }

1;

Index: Class.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/tools/IPdoc/Class.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Class.pm	8 Apr 2002 21:47:57 -0000	1.3
--- Class.pm	13 May 2002 11:19:30 -0000	1.4
***************
*** 9,15 ****
  # mailto: ko...@in...
  #--------------------------------------------------------
! 
  package IPdoc::Class;
! use vars qw($VERSION);
  
  use strict;
--- 9,17 ----
  # mailto: ko...@in...
  #--------------------------------------------------------
! #/**
! # This class represents a perl class.
! #*/
  package IPdoc::Class;
! use base qw(IPdoc::CodeElement);
  
  use strict;
***************
*** 18,23 ****
  # Globals
  #--------------------------------------------------------
! $VERSION = '1.0';
  
  
  #/**
--- 20,27 ----
  # Globals
  #--------------------------------------------------------
! our $VERSION = '1.0';
! 
  
+ our $ELEMENT_TYPE = "class";
  
  #/**
***************
*** 30,97 ****
  
      # Create a Class using the Hash-As-An-Object-Idiom
!     my $this = {};
!     bless( $this, $class );             # create Object
      my @subs = ();
      my %subHash = ();
-     my @params = ();
-     my @paramValues = ();
      my @subclasses = ();
      $this -> { m_subHash } = \%subHash;
      $this -> { m_subs } = \@subs;
-     $this -> { m_params } = \@params;
-     $this -> { m_paramValues } = \@paramValues;
      $this -> { m_subclasses } = \@subclasses;
      $this;
      }
  
- #/**
- # Sets/returns a comment for this class
- # @optional a comment for this class
- # @return a comment for this class
- #*/
- sub comment {
-     my ($this, $comment) = @_;
-     if (defined($comment)) {
-         $this -> { m_comment } = $comment;
-         }
-     $this -> { m_comment };
-     }
- 
- #/**
- # Returns a hash reference containing all params set for this class.
- # Mapping is names => list reference containing the names, and 
- # values => list reference containing the values.
- # @return all params for this class.
- #*/
- sub params {
-     my ($this)  = @_;
-     my @params = @{$this -> { m_params } };
-     my @values = @{$this -> { m_paramValues } };
-     return { names => \@params, values => \@values };
-     }
- 
- #/**
- # Adds a new param to this class.
- # @param the name of the parameter
- # @param the value of the parameter
- #*/
- sub newParam {
-     my ($this, $name, $value) = @_;
-     push( @{$this->{m_params}},$name);
-     push( @{$this->{m_paramValues}},$value);
-     }
- 
- #/**
- # Sets/returns the name of the class
- # @optional the name of the class
- # @return the name of the class
- #*/
- sub name {
-     my ($this, $name) = @_;
-     if ( defined($name) ) {
-         $this -> { m_name } = $name;
-         }
-     $this -> { m_name };
-     }
  
  #/**
--- 34,52 ----
  
      # Create a Class using the Hash-As-An-Object-Idiom
!     my $this = $class -> SUPER::new();
! 
      my @subs = ();
      my %subHash = ();
      my @subclasses = ();
+     my @globals = ();
+     my %globalHash = ();
      $this -> { m_subHash } = \%subHash;
      $this -> { m_subs } = \@subs;
      $this -> { m_subclasses } = \@subclasses;
+     $this -> { m_globals} = \@globals;
+     $this -> { m_globalHash } = \%globalHash;
      $this;
      }
  
  
  #/**
***************
*** 209,211 ****
--- 164,203 ----
      my ($this, $name)  = @_;
      $this -> { m_subHash } -> { $name };
+     }
+ 
+ #/**
+ # Adds a new global.
+ # @param an instance of <code>IPdoc::Global</code>
+ # @public
+ #*/
+ sub newGlobal {
+     my ( $this, $global ) = @_;
+     push ( @{$this -> { m_globals }}, $global );
+     $this -> { m_globalHash } -> { $global -> name() } = $global; 
+     $global -> parent( $this );
+     }
+ 
+ #/**
+ # Returns the global for the given name.
+ # @param the name of the global.
+ # @return an instance of <code>IPdoc::Global</code>
+ # @public
+ #*/
+ sub globalForName {
+     my ($this, $name) = @_;
+     $this -> { m_globalHash } -> { $name };
+     }
+ 
+ #/**
+ # Returns all globals this class has. 
+ # @return a list reference holding all global objects of this class
+ #*/
+ sub globals {
+     my ($this) = @_;
+     $this -> { m_globals };
+     }
+ 
+ 
+ sub elementType {
+     $ELEMENT_TYPE;
      }

Index: IPdoc.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/tools/IPdoc/IPdoc.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** IPdoc.pm	8 Apr 2002 21:47:57 -0000	1.4
--- IPdoc.pm	13 May 2002 11:19:30 -0000	1.5
***************
*** 1,5 ****
  #--------------------------------------------------------
- # This class represents IPdoc, the insOMnia Perl documenting
- # system.
  # $Id$
  # 
--- 1,3 ----
***************
*** 10,16 ****
  #--------------------------------------------------------
  
  package IPdoc::IPdoc;
! use vars qw($VERSION);
  use IPdoc::NSDoclet;
  use IPdoc::Class;
  use IPdoc::Sub;
--- 8,18 ----
  #--------------------------------------------------------
  
+ #/**
+ # This class represents IPdoc, the insOMnia Perl documenting system.
+ #*/
  package IPdoc::IPdoc;
! 
  use IPdoc::NSDoclet;
+ use IPdoc::Global;
  use IPdoc::Class;
  use IPdoc::Sub;
***************
*** 22,26 ****
  # Globals
  #--------------------------------------------------------
! $VERSION = '1.0';
  
  #/**
--- 24,28 ----
  # Globals
  #--------------------------------------------------------
! our $VERSION = '1.03';
  
  #/**
***************
*** 49,58 ****
  # Reads the given config file and then parses all given files and
  # directories, creating documentation.
! # @param a hash reference containing the following key-value-pairs:
! #       files - a comma separated list of files and/or directories
! #           which should be documented
! #       destination - the destination directory into which the
! #           documentation should be placed
! #       title - (optional) the title for the documentation
  # @public
  #*/
--- 51,64 ----
  # Reads the given config file and then parses all given files and
  # directories, creating documentation.
! # @param a hash reference containing the following key-value-pairs:<ul>
! #       <li>files - a comma separated list of files and/or directories
! #           which should be documented</li>
! #       <li>destination - the destination directory into which the
! #           documentation should be placed</li>
! #       <li>title - (optional) the title for the documentation</li>
! #       <li>description - (optional) a filename of a file holding a description
! #           for this documentation. As an alternative, this string may
! #           contain no filename, but the description itself.</li>
! #   </ul>
  # @public
  #*/
***************
*** 60,63 ****
--- 66,83 ----
      my ($this, $paramRef) = @_;
      $this -> { m_destDir } = $paramRef -> { "destination" };
+     my $description = $paramRef -> { "description" };
+     $this -> { m_description } = "";
+     if ( -e $description ) {
+         print "Loading description from file $description ...\n";
+         open( AFILE, "<$description" );
+         while( <AFILE> ) {
+             $this -> { m_description } .= $_;
+             }
+         close( AFILE );
+         }
+     else {
+         $this -> { m_description } = $description;
+         }
+     
      if ( defined($paramRef -> { "title"})) {
          $this -> { m_title } = $paramRef -> { "title" };
***************
*** 102,108 ****
      # now we can render the classes to the destination directory
      for ( values(%classes) )  {
!         $this -> renderClass( $_ ) ;
          }
- 
      print "Writing navigation...\n";
      # now lets render some navigation
--- 122,127 ----
      # now we can render the classes to the destination directory
      for ( values(%classes) )  {
!         $this -> renderClass( $_ ) ; 
          }
      print "Writing navigation...\n";
      # now lets render some navigation
***************
*** 143,147 ****
              opendir( DIR, "$baseDir/$dirname" ) or carp "Cannot open directory: $baseDir/$dirname. Skipping...\n";
              while( defined(my $file = readdir(DIR)) ) {
!                 if ($file =~ /pm$/ && -f "$baseDir/$dirname/$file") {
                      push ( @{$this -> { m_fileList } }, "$dirname/$file" );
                      push ( @{$this -> { m_baseDirs}}, $baseDir);
--- 162,166 ----
              opendir( DIR, "$baseDir/$dirname" ) or carp "Cannot open directory: $baseDir/$dirname. Skipping...\n";
              while( defined(my $file = readdir(DIR)) ) {
!                 if ($file =~ /\.pm$/ && -f "$baseDir/$dirname/$file") {
                      push ( @{$this -> { m_fileList } }, "$dirname/$file" );
                      push ( @{$this -> { m_baseDirs}}, $baseDir);
***************
*** 184,196 ****
      while (<AFILE>) {
          my $line = $_;
!         if ( $line =~ /[^#]*package[\s]*([^;]+);/ && $class -> name() eq "" && !$commentRunning) {
              $class -> name($1);
!             # find parameters in comment
!             while ( $lastComment =~ /^[ ]*@[a-z_A-Z-]+/m ) {
!                 $lastComment =~ s/^[ ]*@([a-z_A-Z-]+)([^@]*)//m;
!                 $class -> newParam($1, $2);
!                 }
!             $class -> comment($lastComment);
!             $lastComment = "";
              }
          
--- 203,209 ----
      while (<AFILE>) {
          my $line = $_;
!         if ( $line =~ /^\s*package[\s]*([^;]+);/ && $class -> name() eq "" && !$commentRunning) {
              $class -> name($1);
!             $lastComment = $this -> processComment( $lastComment, $class );
              }
          
***************
*** 220,235 ****
              }
  
!         if ($line =~ /^[ ]*sub[ ]+([a-zA-Z0-9_]+)/ && ! $commentRunning) {
              my $sub = IPdoc::Sub -> new();
              $sub -> name($1);
!             # find parameters in comment
!             while ( $lastComment =~ /^[ ]*@[a-z_A-Z-]+/m ) {
!                 $lastComment =~ s/^[ ]*@([a-z_A-Z-]+)([^@]*)//m;
!                 $sub -> newParam($1, $2);
!                 }
!             $sub -> comment($lastComment);
              $class -> newSub($sub);
-             $lastComment = "";
              }
          }
      close (AFILE);
--- 233,251 ----
              }
  
!         if ($line =~ /^\s*sub[ ]+([a-zA-Z0-9_]+)/ && ! $commentRunning) {
              my $sub = IPdoc::Sub -> new();
              $sub -> name($1);
! 
!             $lastComment = $this -> processComment( $lastComment, $sub );
              $class -> newSub($sub);
              }
+ 
+         if ( $line =~ /^\s*our[ ]+(\$[a-zA-Z0-9_]+)/ && !$commentRunning) {
+             my $global = IPdoc::Global -> new();
+             $global -> name($1);
+             $lastComment = $this -> processComment( $lastComment, $global );
+             $class -> newGlobal( $global );
+             }
+          
          }
      close (AFILE);
***************
*** 238,241 ****
--- 254,281 ----
  
  #/**
+ # Processes a comment.
+ # @param the comment.
+ # @param an instance of <code>IPdoc::CodeElement</code> or its descendants
+ # @return the empty string
+ # @private
+ #*/
+ sub processComment {
+     my ( $this, $comment, $object ) = @_;
+ 
+     # split comment into comment and params
+     if ( $comment =~ /\n\s*@/ ) {
+         my ( $theComment, @params ) = split( /\n\s*@/, $comment );
+         for ( @params ) {
+             /([a-zA-Z_-]+)(\C*)/;   # split into name and description
+             $object -> newParam( $1, $2 );
+             }
+         $comment = $theComment;
+         }
+ 
+     $object -> comment( $comment );
+     "";
+     }
+ 
+ #/**
  # Renders a class to a file using a doclet.
  # @param the class object to render
***************
*** 254,263 ****
      
      my $doclet = $this -> { m_doclet } -> new($VERSION);
-         
      open( AFILE, ">$dir/$filename" );
!         print AFILE $doclet -> renderHead( $class -> name() . " Documentation" );
          print AFILE $doclet -> renderClass( $class );
          print AFILE $doclet -> renderSubs( $class );
!         print AFILE $doclet -> renderFoot();
      close(AFILE);
      }
--- 294,311 ----
      
      my $doclet = $this -> { m_doclet } -> new($VERSION);
      open( AFILE, ">$dir/$filename" );
!         print AFILE $doclet -> renderHead( $this -> { m_title } ,
!                  $class -> relativeFileName()."main.html", 
!                  $class -> relativeFileName()."symbol_index.html",
!                  $class -> relativeFileName()."index.html", 
!                  $class -> relativeFileName().$class -> fullFileName() );
          print AFILE $doclet -> renderClass( $class );
+         print AFILE $doclet -> renderGlobals( $class );
          print AFILE $doclet -> renderSubs( $class );
!         print AFILE $doclet -> renderFoot( $this -> { m_title } ,
!                  $class -> relativeFileName()."main.html", 
!                  $class -> relativeFileName()."symbol_index.html",
!                  $class -> relativeFileName()."index.html", 
!                  $class -> relativeFileName(). $class -> fullFileName() );
      close(AFILE);
      }
***************
*** 303,310 ****
      print AFILE $doclet -> renderPackageList( \@allPackages, "pkg_[PKNAME].html" );
      close(AFILE);   
      
      #next is the main frame
      open (AFILE, ">$dir/main.html");
!     print AFILE $doclet -> renderMainPage( $this -> { m_title } );
      close( AFILE);
  
--- 351,365 ----
      print AFILE $doclet -> renderPackageList( \@allPackages, "pkg_[PKNAME].html" );
      close(AFILE);   
+ 
+     #and the symbol index
+     open ( AFILE, ">$dir/symbol_index.html" );
+     print AFILE $doclet -> renderSymbolIndex(  $this -> { m_title },
+             "main.html", "symbol_index.html", "index.html", "main.html", \@allClasses, "pkg_[PKNAME].html" );
+     close (AFILE);
      
      #next is the main frame
      open (AFILE, ">$dir/main.html");
!     print AFILE $doclet -> renderMainPage( $this -> { m_title },
!             "main.html", "symbol_index.html", "index.html", "main.html", $this -> { m_description } );
      close( AFILE);
  

Index: NSDoclet.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/tools/IPdoc/NSDoclet.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** NSDoclet.pm	8 Apr 2002 21:47:02 -0000	1.3
--- NSDoclet.pm	13 May 2002 11:19:30 -0000	1.4
***************
*** 11,20 ****
  
  package IPdoc::NSDoclet;
! use vars qw($VERSION);
  
  #--------------------------------------------------------
  # Globals
  #--------------------------------------------------------
! $VERSION = '1.0';
  
  #/**
--- 11,20 ----
  
  package IPdoc::NSDoclet;
! use IPdoc::Sub;
  
  #--------------------------------------------------------
  # Globals
  #--------------------------------------------------------
! our $VERSION = '1.0';
  
  #/**
***************
*** 36,58 ****
  
  
  #/**
  # Renders the head.
  # @param title
  # @return the rendered head
  # @public
  #*/
  sub renderHead {
!     my ($this, $title) = @_;
!     "<html><head><title>$title</title></head><body bgcolor=\"#ffffff\">";
      }
  
  #/**
  # Renders the foot.
  # @return the rendered foot
  #*/
  sub renderFoot {
!     my ($this)  = @_;
!     "<hr><small>Created by IPDoc v".$this -> { m_ipdoc_version }.
!     " using the NSDoclet doclet.</small></body></html>";
      }
  
--- 36,97 ----
  
  
+ 
  #/**
  # Renders the head.
  # @param title
+ # @param the filename for the home
+ # @param the filenamename for the index
+ # @param the filename for the frameset
+ # @param the filename of the class itself
+ # @optional additional html code
  # @return the rendered head
  # @public
  #*/
  sub renderHead {
!     my ($this, $title, $home, $index, $frameset, $self, $code) = @_;
!     "<html><head><title>$title</title></head><body bgcolor=\"#ffffff\">".
!     $this -> renderBar($home, $index, $frameset, $self, $title, $code).
!     "<p>";
! 
!     }
! 
! #/**
! # Renders the Bar
! # @param the home file
! # @param the index file
! # @param the file holding the frameset
! # @param this filename
! # @param the title of the documentation
! # @optional additional html code
! #*/
! sub renderBar {
!     my ($this, $home, $index, $frameset, $self, $title, $code ) = @_;
!     "<table width=\"100%\" border=\"0\"><tr><td bgcolor=\"#EEEEFF\">".
!     "<a style=\"color:black\" href=\"$home\"><b>Home</b></a> ".
!     "<a style=\"color:black\" href=\"$index\"><b>Index</b></a></td>".    
!     "<td align=\"right\" width=\"25%\" rowspan=\"2\" valign=\"top\"><b><i>$title</i></b></td></tr>".
!     "<tr bgcolor=\"#FFFFFF\"><td align=\"right\">".
!     "<a style=\"font-size: 8pt\" href=\"$frameset\" target=\"_top\"><b>FRAMES</b></a> | <a style=\"font-size: 8pt\" target=\"_top\" href=\"$self\">".
!     "<b>NO FRAMES</b></a></td></table>$code<hr>";    
      }
  
  #/**
  # Renders the foot.
+ # @param the title of the documentation
+ # @param the filename for the home
+ # @param the filenamename for the index
+ # @param the filename for the frameset
+ # @param the filename of the class itself
+ # @optional additional html code
  # @return the rendered foot
  #*/
  sub renderFoot {
!     my ($this, $title, $home, $index, $frameset, $self, $code)  = @_;
!     "</p><p>".$this -> renderBar( $home, $index, $frameset, $self, $title, $code ).
!     "</p><p>".
!     "<small>Created by IPDoc v".$this -> { m_ipdoc_version }.
!     " using the NSDoclet doclet. IPDoc is the insOMnia Perl documenting System.".
!     " It is open source and available under the Artistic License. Get your copy ".
!     "at <a href=\"http://sf.net/projects/net-script\">The NetScript Project page.</a></small></p></body></html>";
      }
  
***************
*** 106,110 ****
      my @subclasses = @{$class -> subClasses()};
      
!     $result .= "<b>Direct known subclasses: </b>" if scalar @subclasses;
      for (@subclasses) {
          my $scName = $_ -> name();
--- 145,152 ----
      my @subclasses = @{$class -> subClasses()};
      
!     # sort them by name
!     @subclasses = sort { $a -> name() cmp $b -> name() } @subclasses;
!     
!     $result .= "<b>Direct known subclasses: </b>" if scalar(@subclasses);
      for (@subclasses) {
          my $scName = $_ -> name();
***************
*** 120,132 ****
      $result .= "<hr>";
      
      #render a method table
!     $result .= "<table width=\"100%\" border=\"1\"><tr><th>Subs</th></tr>";
      
!     for ( @{$class -> subs()} ) {
          my $subName = $_ -> name();
          my $subComment = $_ -> comment();
          # cut comment down to the first line or sentence.
          $subComment =~ /^([^\.]+)/;
!         $result .= "<tr><td><a href=\"#sub_$subName\"><b>$subName</b></a><br>$1...</td></tr>";
          }
  
--- 162,194 ----
      $result .= "<hr>";
      
+     my @globals = @{$class -> globals()};
+     # check if globals are available
+     if ( @globals ) {
+         # render a globals table
+         $result .= "<table width=\"100%\" border=\"1\"><tr bgcolor=\"#CCCCFF\"><th align=\"left\"><div style=\"font-size:14pt\">Globals summary</div></th></tr>";
+         @globals = sort { $a -> name() cmp $b -> name() } @globals;
+         for ( @globals ) {
+             my $globalName = $_ -> name();
+             my $globalComment = $_ -> comment();
+             # cut comment down to the first line or sentence.
+             $subComment =~ /^([^\.]+)/;
+             $result .= "<tr><td><a href=\"#global_$globalName\"><b>$globalName</b></a><br>$1</td></tr>";
+             }
+     
+         $result .= "</table><br>";
+     
+         }
+     
      #render a method table
!     $result .= "<table width=\"100%\" border=\"1\"><tr bgcolor=\"#CCCCFF\"><th align=\"left\"><div style=\"font-size:14pt\">Sub summary</div></th></tr>";
      
!     my @subs = @{$class -> subs()};
!     @subs = sort { $a -> name() cmp $b -> name() } @subs;
!     for ( @subs ) {
          my $subName = $_ -> name();
          my $subComment = $_ -> comment();
          # cut comment down to the first line or sentence.
          $subComment =~ /^([^\.]+)/;
!         $result .= "<tr><td><a href=\"#sub_$subName\"><b>$subName</b></a><br>$1</td></tr>";
          }
  
***************
*** 134,147 ****
  
      $parent = $class -> parent();
      while( defined( $parent ) ) {
          my $classname = $parent -> name();
          my $classfile = $class -> relativeFileName().$parent -> fullFileName();
          if ( scalar( @{$parent -> subs} ) ) {
!             $result .= "<br><table width=\"100%\" border=\"1\"><tr><th>Subs inherited from <a href=\"$classfile\">$classname</a></th></tr>";
!             $result .= "<tr><td>";
              my $first = 1;
!             for ( @{$parent -> subs()} ) {
                  my $subName = $_ -> name();
!                 my $subLink = $classfile . "#sub_" . $subName;
                  # cut comment down to the first line or sentence.
                  $subComment =~ /^([^\.]+)/;
--- 196,214 ----
  
      $parent = $class -> parent();
+     my %doneParents = ();
      while( defined( $parent ) ) {
+         last if $doneParents{$parent -> name()};
          my $classname = $parent -> name();
          my $classfile = $class -> relativeFileName().$parent -> fullFileName();
          if ( scalar( @{$parent -> subs} ) ) {
!             $result .= "<br><table width=\"100%\" border=\"1\"><tr bgcolor=\"#EEEEFF\"><th align=\"left\">Subs inherited from <a href=\"$classfile\">$classname</a></th></tr>";
!             $result .= "<tr><td><code>";
              my $first = 1;
!             my @parentSubs = @{$parent->subs()};
!             @parentSubs = sort { $a -> name() cmp $b -> name() } @parentSubs;
!             for ( @parentSubs ) {
                  my $subName = $_ -> name();
!                 my $type = $_ -> elementType();
!                 my $subLink = $classfile . "#$type_" . $subName;
                  # cut comment down to the first line or sentence.
                  $subComment =~ /^([^\.]+)/;
***************
*** 154,159 ****
                  $result .= "<a href=\"$subLink\">$subName</a>";
                  }
!             $result .= "</td></tr></table>";
              }
          $parent = $parent -> parent();
          }
--- 221,227 ----
                  $result .= "<a href=\"$subLink\">$subName</a>";
                  }
!             $result .= "</code></td></tr></table>";
              }
+         $doneParents{$parent->name()} = $parent ->name();
          $parent = $parent -> parent();
          }
***************
*** 161,164 ****
--- 229,254 ----
      }
  
+ 
+ #/**
+ # Renders all globals of the given class object.
+ # @param a class object
+ # @return the rendered globals
+ # @public
+ #*/
+ sub renderGlobals {
+     my ($this, $class) = @_;
+     my @globals = @{$class -> globals()};
+     my $result = "";
+     if ( @globals ) {
+         $result .= "<p><table width=\"100%\" border=\"1\"><tr bgcolor=\"#CCCCFF\"><th align=\"left\" style=\"font-size:14pt\">Global detail</th></tr></table>";
+         for (@globals) {
+             $result .= $this -> renderGlobal( $_ );
+             $result .= "<hr>";
+             }
+         $result .= "</p>";
+     }
+     $result;
+     }
+ 
  #/**
  # Renders all subs of the given class object.
***************
*** 170,176 ****
--- 260,269 ----
      my ($this, $class) = @_;
      my $result = "";
+     $result .= "<p><table width=\"100%\" border=\"1\"><tr bgcolor=\"#CCCCFF\"><th align=\"left\" style=\"font-size:14pt\">Sub detail</th></tr></table>";
      for (@{$class -> subs()}) {
          $result .= $this -> renderSub( $_ );
+         $result .= "<hr>";
          }
+     $result .= "</p>";
      $result;
      }
***************
*** 187,190 ****
--- 280,284 ----
      my $description = $sub -> comment();
      my $class = $sub -> parent();
+     my $type = $sub -> elementType();
      my $params = $sub -> params();
  
***************
*** 193,202 ****
          my $parent = $class -> parent();
          my $aSub = undef;
! 
          while( defined($parent) && $description eq "" ) {
              $aSub = $parent -> subForName( $sub -> name() );
              if (defined($aSub)) {
                  $description = $aSub -> comment();
                  }
              $parent = $parent -> parent();
              }
--- 287,298 ----
          my $parent = $class -> parent();
          my $aSub = undef;
!         my %doneParents = ();
          while( defined($parent) && $description eq "" ) {
+             last if $doneParents{$parent->name()};
              $aSub = $parent -> subForName( $sub -> name() );
              if (defined($aSub)) {
                  $description = $aSub -> comment();
                  }
+             $doneParents{ $parent->name() } = $parent ->name();
              $parent = $parent -> parent();
              }
***************
*** 212,217 ****
              }
          }
!     my $result =  "<hr><h3><a name=\"sub_$name\">$name</a></h3>$description<br><br>";
      $result .= $this -> renderParams( $params );
      $result;
      }
--- 308,334 ----
              }
          }
!     my $result =  "<h3><a name=\"$type_$name\">$name</a></h3><dl><dd>$description</dd><p>";
!     $result .= $this -> renderParams( $params );
!     $resutl .= "</p></dl>";
!     $result;
!     }
! 
! #/**
! # Renders a global..
! # @param the global object to render
! # @return the rendered string
! # @private
! #*/
! sub renderGlobal {
!     my ($this, $global ) = @_;
!     my $name = $global -> name();
!     my $description = $global -> comment();
!     my $class = $global -> parent();
!     my $type = $global -> elementType();
!     my $params = $global -> params();
! 
!     my $result =  "<h3><a name=\"$type_$name\">$name</a></h3><dl><dd>$description</dd><p>";
      $result .= $this -> renderParams( $params );
+     $resutl .= "</p></dl>";
      $result;
      }
***************
*** 231,251 ****
                       "not-standard" => "This implementation is non-standard.",
                       "return" => "return value:",
                       "public" => "This sub can be used from outside.",
!                      "protected" => "This sub should not be used from outside but can be overridden by subclasses.",
!                      "private" => "This sub should not be used from outside and not be overridden by subclasses.",
                       "abstract" => "This implementation is abstract.",
                       "note" => "Implementation note:",
!                      "fixme" => "To be fixed:",
                       "author" => "Author:",
                       "version" => "Version:",
                       "final" => "This sub or class should not be overridden by subclasses." );
  
      my @paramNames = @{$paramRef -> { names }};
      my @paramValues = @{$paramRef -> { values }};
      
!     while (@paramNames) {
!         $result .= "<b>".$mappings{(shift @paramNames)}."</b>".(shift @paramValues)."<br>";
          }
      $result;
      }
  
--- 348,386 ----
                       "not-standard" => "This implementation is non-standard.",
                       "return" => "return value:",
+                      "callback" => "This sub is a callback within the framework and should not be used from outside.",
                       "public" => "This sub can be used from outside.",
!                      "protected" => "This sub should not be used from outside but can be overridden and used by subclasses.",
!                      "private" => "This sub should not be used from outside and not be overridden or used by subclasses.",
                       "abstract" => "This implementation is abstract.",
                       "note" => "Implementation note:",
!                      "fixme" => "to be fixed:",
!                      "todo" => "to be done:",
                       "author" => "Author:",
                       "version" => "Version:",
+                      "deprecated" => "Deprecated.", 
                       "final" => "This sub or class should not be overridden by subclasses." );
  
+     my @order = ( "deprecated", "callback", "public", "private", "protected", "abstract", "final",
+                   "param", "optional", "return", "not-implemented", 
+                   "not-standard", "note", "fixme", "todo", "version", "author" );
      my @paramNames = @{$paramRef -> { names }};
      my @paramValues = @{$paramRef -> { values }};
      
!     # sort the parameters to have always the same order
!    
!     
!     $result .= "<dl>";
!     for (@order) {
!         $elem = $_;
!         foreach $index (0..$#paramNames ) { #FIXME: this is incredibly slow
!             if ( $paramNames[$index] eq $elem ) {
!                 $result .= "<dd><b>".$mappings{($paramNames[$index])}."</b><dl><dd>".(@paramValues[$index])."</dd></dl></dd>";
!                 }
!             }
!         
          }
+     $result .= "</dl>";
      $result;
+     
      }
  
***************
*** 320,328 ****
  # Renders the main Page.
  # @param a title
  # @return the rendered string
  #*/
  sub renderMainPage {
!     my ($this, $title) = @_;
!     my $result = "<html><body bgcolor=\"#ffffff\">$title</body></html>";
      $result;
      }
--- 455,550 ----
  # Renders the main Page.
  # @param a title
+ # @param home filename
+ # @param index filename
+ # @param frameset filename
+ # @param self filename 
+ # @param a string holding a description
  # @return the rendered string
  #*/
  sub renderMainPage {
!     my ($this, $title, $home, $index, $frameset, $self, $description ) = @_;
!     my $result = $this -> renderHead( $title, $home, $index, $frameset, $self );
!     $result .= "<center><h1>$title - API Documentation </h1></center><p>".$description."</p>";
!     $result .= $this -> renderFoot( $title, $home, $index, $frameset, $self );
!     $result;
!     }
! 
! #/**
! # Renders the Index
! # @param 
! #*/
! sub renderSymbolIndex {
!     my ($this, $title, $home, $index, $frameset, $self, $classes, $fmtString) = @_;
!     my $result = "";
! 
!     my @allClasses = @{$classes} ;
! 
!     # this array holds all symbols (CodeElements)
!     my @allSymbols = (); 
!     # add the class, its subs and globals to the array
!     for ( @allClasses ) {
!         push( @allSymbols, $_ );
!         push( @allSymbols, @{$_ -> subs()} );
!         push( @allSymbols, @{$_ -> globals()} );
!         }
!     
!     # sort the array alphabetically by name
!     @allSymbols =  sort { 
!         $name1 = $a -> name(); 
!         $name2 = $b -> name();
!         $name1 =~ s/^.*:://g;
!         $name2 =~ s/^.*:://g;
!         lc($name1) cmp lc($name2); 
!         }  @allSymbols;
!         
!     my $lastLetter = "";
!     my $letters = "";
!     my $biglist = "";
!     my $first = 1;
!     for (@allSymbols) {
!         my $parent = $_ -> parent();
!         my $file = $_ -> fullFileName();
!         my $type = $_ -> elementType();
!         my $name = $_ -> name();
!         my $shortName = $name;        
!         my $package = "";
!         if ( $name =~ /^(.*)::(.*)/ ) { # assumes greedyness
!             $shortName = $2;
!             $package = $1;
!             }
!         my $comment = $_ -> comment();
!         # cut comment down to the first line or sentence.
!         if ( $comment =~ /^([^\.]+)/ ) {
!             $comment = $1;
!             }
! 
!         $shortName =~ /^(.)/; # FIXME: Looks  slow
!         if ( $lastLetter ne uc($1) ) {
!             $lastLetter = uc($1);
!             $letters .= "<a href=\"#letter_$lastLetter\">$lastLetter</a> ";
!             $bigList .= "</dl><hr>" unless $first;
!             $first = 0;
!             $bigList .= "<a name=\"letter_$lastLetter\"><h2><b>$lastLetter</b></h2></a><dl>";
!             }
!         $bigList .= "<dt><a href=\"$file#$type_$name\">$shortName</a> - ";
!         if ( $type eq $IPdoc::Class::ELEMENT_TYPE ) {
!             my $pkName = $package;
!             $pkName =~ s/:/_/g;
!             my $href = $fmtString;
!             $href =~ s/\[PKNAME\]/$pkName/e;
!             $bigList .= "class in package <a href=\"$href\" target=\"pkgframe\">$package</a>";
!             } 
!         else {
!             my $pname = $parent -> name();
!             my $href = $parent -> fullFileName();
!             $bigList .= " $type in class <a href=\"$href\">$pname</a>";
!             }
! 
!         $bigList .="</dt><dd>&nbsp;$comment</dd>";
!         }
! 
!     $result .= $this -> renderHead( $title, $home, $index, $frameset, $self, $letters );    
!     $result .= $bigList;  
!     $result .= $this -> renderFoot( $title, $home, $index, $frameset, $self, $letters );
      $result;
      }

Index: Sub.pm
===================================================================
RCS file: /cvsroot/net-script/netscript2/src/tools/IPdoc/Sub.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** Sub.pm	8 Apr 2002 21:47:57 -0000	1.2
--- Sub.pm	13 May 2002 11:19:30 -0000	1.3
***************
*** 1,5 ****
  #--------------------------------------------------------
- # This class represents IPdoc, the insOMnia Perl documenting
- # system.
  # $Id$
  # 
--- 1,3 ----
***************
*** 10,15 ****
  #--------------------------------------------------------
  
  package IPdoc::Sub;
! use vars qw($VERSION);
  
  use strict;
--- 8,16 ----
  #--------------------------------------------------------
  
+ #/**
+ # This class represents a perl sub.
+ #*/
  package IPdoc::Sub;
! use base qw(IPdoc::CodeElement);
  
  use strict;
***************
*** 18,23 ****
  # Globals
  #--------------------------------------------------------
! $VERSION = '1.0';
  
  
  #/**
--- 19,25 ----
  # Globals
  #--------------------------------------------------------
! our $VERSION = '1.0';
  
+ our $ELEMENT_TYPE = "sub";
  
  #/**
***************
*** 30,107 ****
  
      # Create a Class using the Hash-As-An-Object-Idiom
!     my $this = {};
!     bless( $this, $class );             # create Object
!     my @subs = ();
!     my @params = ();
!     my @paramValues = ();
!     $this -> { m_params } = \@params;
!     $this -> { m_paramValues } = \@paramValues;
      $this;
      }
  
! #/**
! # Sets/returns a comment for this sub
! # @optional a comment for this sub
! # @return a comment for this sub
! #*/
! sub comment {
!     my ($this, $comment) = @_;
!     if (defined($comment)) {
!         $this -> { m_comment } = $comment;
!         }
!     $this -> { m_comment };
!     }
! 
! #/**
! # Returns a hash reference containing all params set for this sub.
! # Mapping is names => list reference containing the names, and 
! # values => list reference containing the values.
! # @return all params for this sub.
! #*/
! sub params {
!     my ($this)  = @_;
!     my @params = @{$this -> { m_params } };
!     my @values = @{$this -> { m_paramValues } };
!     return { names => \@params, values => \@values };
!     }
! 
! #/**
! # Adds a new param to this sub.
! # @param the name of the parameter
! # @param the value of the parameter
! #*/
! sub newParam {
!     my ($this, $name, $value) = @_;
!     push( @{$this->{m_params}},$name);
!     push( @{$this->{m_paramValues}},$value);
!     }
! 
! 
! #/**
! # Sets/returns the name of the class
! # @optional the name of the class
! # @return the name of the class
! #*/
! sub name {
!     my ($this, $name) = @_;
!     if ( defined($name) ) {
!         $this -> { m_name } = $name;
!         }
!     $this -> { m_name };
!     }
! 
! 
! #/**
! # Sets/returns the parent class object.
! # @optional the parent class object
! # @returns the parent class object
! #*/
! sub parent {
!     my ($this, $parent) = @_;
!     if (defined($parent)) {
!         $this -> { m_parent } = $parent;
!         }
!     $this -> { m_parent };
      }
  
! 
--- 32,42 ----
  
      # Create a Class using the Hash-As-An-Object-Idiom
!     my $this = $class -> SUPER::new();
      $this;
      }
  
! sub elementType {
!     $ELEMENT_TYPE;
      }
  
! 1;