Nebula 2/Nebula Two.iso/SourceCode/MiscKit1.7.1/MiscKit/Examples/AutoDoc/lib/perl5/Autodoc/ReadSource.pm

Perl POD Document | 1995-11-02 | 29.1 KB | 1,133 lines

package Autodoc::ReadSource;

###############################################################################
###############################################################################
##
##    Written by Adam Swift (c) 1995 by Friday Software and Consulting
##                           All rights reserved.
##
##      This notice may not be removed from this source code.
##
##    This program is included in the MiscKit by permission from the author
##    and its use is governed by the MiscKit license, found in the file
##    "LICENSE.rtf" in the MiscKit distribution.  Please refer to that file
##    for a list of all applicable permissions and restrictions.
##
##    Because AutoDoc is licensed free of charge, there is no warranty
##    for the program.  Copyright holder, Friday Software and Consulting,
##    is providing this program "as is" and 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.
##
###############################################################################
###############################################################################


require 5.000;

##########################
# load required packages #
##########################
use Exporter;
use Autodoc::LogDebug;
use Autodoc::ParseComments;
use Autodoc::ScanFile;


@ISA      = qw(Exporter);
@EXPORT   = qw(read_objectinfo
               object_version
               object_year
               object_name
               object_inherits
               object_conformsto
               object_category
               object_protocol
               object_ivars
               object_ivartypes
               object_ivardocs
               object_declaredin
               object_classdocs
               object_methodnames
               object_methodblocks
               object_methoddocs
               object_classmethods
               object_instmethods
               object_defines
               object_definevals
               object_definedocs
               object_typedefs
               object_typedefvals
               object_typedefdocs
               object_macros
               object_macrodocs
               object_functions
               object_functiondocs
               object_globals
               object_globaldocs
               object_noobjectdefined
               extract_methodname);


############################################################################
#
# Purpose: Module that encapsulates reading in objective c source files to
#          parse out language elements and source code comments to construct
#          information from which documentation can be generated.
#
# HISTORY: START
# $Log: ReadSource.pm,v $
# Revision 1.2  1995/10/20  22:16:28  aswift
# Added DevMan style changes Log support
#
#
# HISTORY: END
############################################################################
#
# GOBAL VARIABLES THAT HOLD OBJECT INFORMATION:
#
#  $obj_version        The object copyright version
#  $obj_year        The object copyright year
#  $obj_name        The object name
#  $obj_inherits    The object inheritance information
#  $obj_category    The object category information
#  $obj_protocol    The object protocol name
#  @obj_ivars        The object instance variable list (in order of
#               declaration in the header file
#  %obj_ivartypes    The instance variables' types, associated with the
#             instance variables names (from @obj_ivars)
#  %obj_ivardocs    The instance variables' descriptions, associated with
#             the instance variables names (from @obj_ivars)
#  $obj_declaredin    The object's declaration (header file) location
#  @obj_conformsto    The protocols the object conforms to
#  $obj_classdocs    The object class description
#  @obj_methodnames     The object method names list (short names, suitable for
#             hash table lookups - similar to @selector style)
#  %obj_methodblocks    The method block names, associated with the method
#             that starts the method block (from @obj_methodnames)
#  %obj_methoddocs    The method descriptions, associated with the method
#             name (from @obj_methodnames)
#  @obj_classmethods    The object class methods, full declaration style
#  @obj_instmethods    The object instance methods, full declaration style
#  @obj_defines         The definitions found in the header file
#  %obj_definevals      The values assigned to the definitions
#  %obj_definedocs      The documentation for the definitions
#  @obj_typedefs        The typedef's found in the header file
#  %obj_typedefvals     The values assigned to the typedefs
#  %obj_typedefdocs     The documentation for the typedefs
#  @obj_macros          The macro definitions found in the header file
#  %obj_macrodocs       The documentation for the macros
#  @obj_functions       The function declarations found in the header file
#  %obj_functiondocs    The documentation for the functions
#  @obj_globals         The global variable declarations found in the header
#  %obj_globaldocs      The documentation for the globals
#
#############################################################################


$module_version = '$Revision: 1.2 $';
$module_version =~ s!(\$\w+: | \$)!!g;
$module_id    = '$Id: ReadSource.pm,v 1.2 1995/10/20 22:16:28 aswift Exp $';
$module_id      =~ s!(\$\w+: | \$)!!g;
$module_name    = $module_id;
$module_name    =~ s!^([^\,]+).*$!$1!;

#############################################################################
#
# NAME:       module_version
#
# ACTION:     returns the version number of this module
#
# RETURN:     the module version
#
#############################################################################
sub module_version
{
    return $module_version;
}

sub module_versionstamp
{
    return "$module_name (rev-$module_version)";
}

#############################################################################
#
# Object info accessor methods
#
#############################################################################
sub object_version
{
    return $obj_version if (defined($obj_version));
    return "";
}

sub object_year
{
    return $obj_year if (defined($obj_year));
    return "";
}

sub object_name
{
    return $obj_name if (defined($obj_name));
    return "";
}

sub object_inherits
{
    return $obj_inherits if (defined($obj_inherits));
    return "";
}

sub object_category
{
    return $obj_category if (defined($obj_category));
    return "";
}

sub object_protocol
{
    return $obj_protocol if (defined($obj_protocol));
    return "";
}

sub object_ivars
{
    return @obj_ivars if (defined(@obj_ivars));
    return ();
}

sub object_ivartypes
{
    return %obj_ivartypes if (defined(%obj_ivartypes));
    return {};
}

sub object_ivardocs
{
    return %obj_ivardocs if (defined(%obj_ivardocs));
    return {};
}

sub object_declaredin
{
    return $obj_declaredin if (defined($obj_declaredin));
    return "";
}

sub object_conformsto
{
    return @obj_conformsto if (defined(@obj_conformsto));
    return ();
}

sub object_classdocs
{
    return $obj_classdocs if (defined($obj_classdocs));
    return "";
}

sub object_methodnames
{
    return @obj_methodnames if (defined(@obj_methodnames));
    return ();
}

sub object_methodblocks
{
    return %obj_methodblocks if (defined(%obj_methodblocks));
    return {};
}

sub object_methoddocs
{
    return %obj_methoddocs if (defined(%obj_methoddocs));
    return {};
}

sub object_classmethods
{
    return @obj_classmethods if (defined(@obj_classmethods));
    return ();
}

sub object_instmethods
{
    return @obj_instmethods if (defined(@obj_instmethods));
    return ();
}

sub object_defines
{
    return @obj_defines if (defined(@obj_defines));
    return ();
}

sub object_definevals
{
    return %obj_definevals if (defined(%obj_definevals));
    return {};
}

sub object_definedocs
{
    return %obj_definedocs if (defined(%obj_definedocs));
    return {};
}

sub object_typedefs
{
    return @obj_typedefs if (defined(@obj_typedefs));
    return ();
}

sub object_typedefvals
{
    return %obj_typedefvals if (defined(%obj_typedefvals));
    return {};
}

sub object_typedefdocs
{
    return %obj_typedefdocs if (defined(%obj_typedefdocs));
    return {};
}

sub object_macros
{
    return @obj_macros if (defined(@obj_macros));
    return ();
}

sub object_macrodocs
{
    return %obj_macrodocs if (defined(%obj_macrodocs));
    return {};
}

sub object_globals
{
    return @obj_globals if (defined(@obj_globals));
    return ();
}

sub object_globaldocs
{
    return %obj_globaldocs if (defined(%obj_globaldocs));
    return {};
}

sub object_functions
{
    return @obj_functions if (defined(@obj_functions));
    return ();
}

sub object_functiondocs
{
    return %obj_functiondocs if (defined(%obj_functiondocs));
    return {};
}

sub object_noobjectdefined
{
    return 0
      if (object_inherits() || object_category() || object_protocol());
    return 1;
}

sub init_globals
{
    local (@timearray, $obj_root);

    # remove any extra file path goo from object root
    $obj_root = $_[0];
    $obj_root =~ m!([^/]+)$!;
    $obj_root = $1;

    @timearray = localtime(time);

    $obj_version      = "";
    $obj_year          = "19$timearray[5]";
    $obj_name          = $1;
    $obj_inherits      = "";
    $obj_category      = "";
    $obj_protocol     = "";
    @obj_ivars          = ();
    %obj_ivartypes      = {};
    %obj_ivardocs      = {};
    $obj_declaredin      = "$obj_root.h";
    @obj_conformsto      = ();
    $obj_classdocs      = "";
    @obj_methodnames  = ();
    %obj_methodblocks = {};
    %obj_methoddocs      = {};
    @obj_classmethods = ();
    @obj_instmethods  = ();
    @obj_defines      = ();
    %obj_definevals      = {};
    %obj_definedocs      = {};
    @obj_typedefs      = ();
    %obj_typedefvals  = {};
    %obj_typedefdocs  = {};
    @obj_macros          = ();
    %obj_macrodocs      = {};
    @obj_functions      = ();
    %obj_functiondocs = {};
    @obj_globals      = ();
    %obj_globaldocs      = {};
}

###############################################################################
#
# DATA EXTRACTION FROM OBJECT SOURCE FILES
#
#    Fill the object data global variables with information read from the
#  object source files.  Return 1 if enough information is read in order to
#  produce the documentation file
#


#
# Locate and read from the source files for the object passed as the one
# argument to this subroutine.  If any of the read_... subroutines fail
# this read_objectinfo subroutine fails and returns 0.
#
sub read_objectinfo
{
    local ($obj_root, $obj_h, $obj_m) = @_;

    &dblog (0, "Reading object info for:\t$obj_root");

    init_globals($obj_root);

    # read from the header file
    return 0
    if (!scan_openfile($obj_h));

    read_copyrightinfo();
    read_defines_typedefs_functions();

    scan_keepADCNewlines(0);
    read_objectname_inheritance();
    read_instancevariables();
    read_methodnames();
    scan_closefile();
    return 0
    if (scan_eoffound());

    # return success if the .m file is "", and we found functions, etc
    if (($obj_m eq "") || (object_noobjectdefined())) {
    return 1
        if (scalar(@obj_typedefs) || scalar(@obj_defines) ||
        scalar(@obj_macros) || scalar(@obj_functions) ||
        scalar(@obj_globals));
    return 0;
    }

    # read from the implementation file
    return 0
    if (!scan_openfile($obj_m));
    scan_keepADCNewlines(1);

    read_declarationlocation($obj_root);
    read_classdescription();
    read_methoddescriptions();
    scan_closefile();
    return 0
    if (scan_eoffound());

    return 1;
}


#############################################################################
#
# NAME:       read_copyrightinfo
#
# ACTION:     Read from the header file until we find the object version and
#           copyright year, or fail if we find "@interface" first.  The
#             argument globs are assigned scalar values for both
#
# GLOBALS:    The object version and year variable globs
#
# RETURN:     1 if we succeded in finding the copyright info, 0 if we failed
#
#############################################################################
sub read_copyrightinfo
{
    local ($in);

    return 0 if (scan_eoffound()); # don't bother if scanning won't work

    scan_skipCStyleComments(0);    # copyright info is inside c style comments

    # scan lines from the source file until an end condition is reached
    while ($in = scan_line()) {

    # check for our data line
    if ($in =~ m/^\$Id\:\s+\S+\s+(\S+)\s+(\d+)\//) {
        $obj_version = "Version $1";
        $obj_year    = $2;
        dblog (2, "Found copyrightinfo:\t(", $obj_version,
           ") (", $obj_year, ")");
        scan_skipCStyleComments(1);
        return 1;
    }

    # check for our fail conditions: interface declaration
    if ($in =~ m/^\@\s*interface\s+/) {
        scan_rescanline(1); # this is the line needed for the next sub
        dblog (2, "Can't find copyrightinfo, using defaults.");
        scan_skipCStyleComments(1);
        return 0;
    }

    # check for our fail condition: protocol declaration
    if ($in =~ m/^\@\s*protocol\s+/) {
        scan_rescanline(1); # this is the line needed for the next sub
        dblog (2, "Can't find copyrightinfo, using defaults.");
        scan_skipCStyleComments(1);
        return 0;
    }

    # check for our fail conditions: defines, typedefs, ad comments...
    if (parse_containsADComment($in) ||
        ($in =~ m!^#\s*define|^typedef|^extern!)) {
        scan_rescanline(1); # this is the line needed for the next sub
        dblog (2, "Can't find copyrightinfo, using defaults.");
        scan_skipCStyleComments(1);
        return 0;
    }
    }
    scan_skipCStyleComments(1);
    dblog (2, "Can't find copyrightinfo, using defaults.");
    return 0;
}


#############################################################################
#
# NAME:       read_defines_typedefs_functions
#
# ACTION:     Read from the header file to document defines, functions and
#           typedef's fail if we find "@interface".
#
# GLOBALS:    obj_functions array, obj_defines, obj_typedefs
#
# RETURN:     1 if we find any defines, typedefs, or functions, 0 otherwise
#
#############################################################################
sub read_defines_typedefs_functions
{
    local ($ADcomment, $findADCTarget, $targetName, $targetValue, $in);
    local ($dblevel) = 2;

    return 0 if (scan_eoffound()); # don't bother if scanning won't work

    $findADCTarget  = 0;
    $ADcomment      = "";
    $targetName     = "";
    $targetValue     = "";

  READDTF:
    while ($in = scan_line()) {

    # check for our fail conditions
    if (($in =~ m!^\@\s*interface\s+!)) {
        scan_rescanline(1); # this is the line needed for the next sub
        return 1;
    }
    if (($in =~ m!^\@\s*protocol\s+!)) {
        scan_rescanline(1); # this is the line needed for the next sub
        return 1;
    }

    # check for global functions and variables (extern's)
    if ($in =~ m!^extern\s+!) {
        $in = $';
        $in =~ s!\s+! !g;    # remove unnecessary whitespace
        $in .= scan_line()    # read in 'till we find the end ';'
        while (!($in =~ m!\;!) && !scan_eoffound());

        $in =~ s!\;.*!\;!;

        # determine if we have a variable or a function
        if ($in =~ m!\)\s*\;!) {
        # a function
        $targetName = $in;
        $targetName =~ s!\;!!;

        push (@obj_functions, $targetName);
        if ($ADcomment ne "") {
            $obj_functiondocs{$targetName} = $ADcomment;
            $ADcomment = "";
        }
        dblog($dblevel, "Found function ($targetName)");
        } else {
        # a global variable
        $targetName = $in;

        push (@obj_globals, $targetName);
        if ($ADcomment ne "") {
            $obj_globaldocs{$targetName} = $ADcomment;
            $ADcomment = "";
        }
        dblog($dblevel, "Found global ($targetName)");
        }
    }

    # check for typedef's
    if ($in =~ m!^typedef\s+!) {
        local ($curlies, $buf) = 0;

        $targetValue = $in;
        $buf = $in;
        $curlies = ($buf =~ s!\{!x!g) - ($buf =~ s!\}!x!g);
        while (!(($curlies == 0) && ($in =~ m!\;!)) && !scan_eoffound()) {
        $in = scan_line();
        $targetValue .= "\n$in";
        $buf = $in;
        $curlies += ($buf =~ s!\{!x!g) - ($buf =~ s!\}!x!g);
        }

        $in =~ m!(\S+)\s*;$!;
        $targetName = $1;
        if ($targetName =~ m!\)$!) {
        # Ewww.. A typedef function thing.
        $targetValue =~ m!(\S+)\([^\(]*\)\;$!;
        $targetName = $1;
        while ($targetName =~ m!([^\(\*]+)\)$!) {
            $targetName = $1;
        }
        }

        push (@obj_typedefs, $targetName);
        $obj_typedefvals{$targetName} = $targetValue;
        if ($ADcomment ne "") {
        $obj_typedefdocs{$targetName} = $ADcomment;
        $ADcomment = "";
        }
        # remove the newlines for debugging...
        $targetValue =~ s!\n! !g;
        dblog($dblevel,
          "Found typedef ($targetName) = \"$targetValue\"");
    }

    # check for #define's
    if ($in =~ m!^\#\s*define\s+([^\s\(]+)!) {
        $targetName = $1;
        $in = $';

        # determine if the define has parens or not
        if ($in =~ m!^\(!) {
        # it's a macro, get the portion between the parens
        $in =~ m!^\([^\)]*\)!;
        $targetName .= $&;

        while ($in =~ m!\\$!) {
            # throw away the contents of a multi line macro definition
            $in = scan_line();
        }
        push (@obj_macros, $targetName);
        if ($ADcomment ne "") {
            $obj_macrodocs{$targetName} = $ADcomment;
            $ADcomment = "";
        }
        dblog($dblevel, "Found macro ($targetName)");
        } else {
        # it's a plain define
        $in =~ m!^\s+!;
        $targetValue = $';

        while ($in =~ m!\\$!) {
            $in = scan_line();
            $targetValue =~ s!\\!$in!;
        }
        $obj_definevals{$targetName} = $targetValue;
        push (@obj_defines, $targetName);
        if ($ADcomment ne "") {
            $obj_definedocs{$targetName} = $ADcomment;
            $ADcomment = "";
        }
        dblog($dblevel,
              "Found define ($targetName) = \"$targetValue\"");
        }
        next READDTF;
    }

    # check for our data line
    if (($ADcomment = parse_extractADComment($in))) {
        # need to determine what we attach the comment to
        $findADCTarget = 1;
        next READDTF;
    }

    }
    dblog(1, "Did not find object interface declaration.");
    return 0;
}


#############################################################################
#
# NAME:       read_objectname_inheritance
#
# ACTION:     Read from the header file until we find the interface and
#             inheritance info
#
# GLOBALS:    obj_name, obj_inherits, obj_category scalars
#
# RETURN:     1 if we succeed in reading , 0 if we fail
#
#############################################################################
sub read_objectname_inheritance
{
    local ($ADcomments, $in, $after);

    return 0 if (scan_eoffound()); # don't bother if scanning won't work

    $ADcomments = "";

    while ($in = scan_line()) {

    # check for our data line
    if ($in =~ m/^\@\s*interface\s+([^\s\:]+)\s*\:\s*([^\s\/]+)\s*/) {
      $obj_name = $1;
      $obj_inherits = $2;
      $after = $';

      @obj_conformsto = extract_protocols($after);
      if ($extra = parse_extractADComment ($after)) {
        $obj_inherits .= " : $extra";
      }
      dblog (2, "Found objectname_inheritance:",
         "\t($obj_name) ($obj_inherits) (@obj_conformsto)");
      return 1;
    }

    if ($in =~ m/^\@\s*interface\s+([^\s\:]+)\s*\(\s*([^\s\)]+)\)/) {
        $obj_name = $1;
        $obj_category = $2;
        $after = $';

        @obj_conformsto = extract_protocols($after);
        dblog (2, "Found objectname_inheritance (category):",
           "\t($obj_name) ($obj_category) (@obj_conformsto)");
        return 1;
    }

    if ($in =~ m/^\@\s*protocol\s+([^\s\{]+)\s*/) {
        $obj_name = $1;
        $obj_protocol = $1;
        $after = $';

        @obj_conformsto = extract_protocols($after);
        dblog (2, "Found objectname_inheritance protocol:",
           "\t($obj_protocol)");
        return 1;
    }

    if ($in =~ m/^\@\s*interface\s+([^\s\{]+)\s*/) {
        $obj_name = $1;
        $obj_inherits = "none";
        $after = $';

        @obj_conformsto = extract_protocols($after);
        dblog (2, "Found objectname_inheritance:",
           "\t($obj_name) ($obj_inherits) (obj_conformsto)");
        return 1;
    }
    }
    dblog (2, "Could not find objectname_inheritance.");
    return 0;
}



#############################################################################
#
# NAME:       read_instancevariables
#
# ACTION:     Reads the instance variables out of the header file and stores
#             them, their types and docs
#
# GLOBALS:    @obj_ivars, %obj_ivartypes, %obj_ivardocs
#
# RETURN:     1 if we succeed in reading instance vars, 0 if we fail
#
#############################################################################
sub read_instancevariables
  {
    local ($in, $clevel, $openc, $closec, $foundivars, $ivar, $ivarline,
           $docs, $type);

    return 0
      if (scan_eoffound()); # don't bother if scanning won't work

    $clevel = 0;        # keep track of the curly braces!
    $foundivars = 0;
    $ivarline = "";        # initialize the instance variable line buffer

  READIVARS:
    while ($in = scan_line()) {

      if ($foundivars == 0) {    # Check if we have entered the ivar region
        if (!($in =~ m/\{/)) {
          scan_rescanline(1);
          dblog (2, "No instance variables found.");
          return 0;
        }
        $foundivars = 1;
        $clevel += 1;

        if ($in =~ m/\w/) {
          # remove the start brace and scan the line for ivars.
          $in =~ s/\{\s*//;
        } else {
          next READIVARS;    # skip this line if no alpha on it
        }
      }

      # Discard any line marked w/INTERNAL
      if ($in =~ m/INTERNAL/) {
        dblog (2, "Discarding \"$in\" in instance variable declaration.");
        next READIVARS;
      }

      # preprocess to extract the autodoc comment, if any
      if (($docs = parse_extractADComment($in))) {
        $in = parse_extract_preADComment($in);
      }

      $openc = ($in =~ m/\{/g);      # The number of open curly braces
      $closec = ($in =~ m/\}/g);     # The number of close curly braces
      $clevel += ($openc - $closec); # The current curly level

      if (($clevel > 1) && ($openc > 0)) {
        warn ("Unable to parse struct encountered in ivars.\n");
        dblog (2, "Found struct on line: ($in)");
        next READIVARS;
      }
      if (($clevel > 0) && ($closec > 0)) {
        dblog (2, "Found struct end on line: ($in)");
        next READIVARS;
      }
      if ($clevel == 0) {    # found the end of the ivars
        dblog (2, "Found ", scalar(@obj_ivars), " instance variables.");
        return 1;
      }

      $ivarline .= " " if ($ivarline);
      $ivarline .= $in;

      # Discard @public, @private and @protected modifiers...
      if ($in =~ m/\@\s*p/) {
        dblog (2, "Discarding \"$in\" in instance variable declaration.");
        next READIVARS;
      }

      if (!($in =~ m/\;/)) {
        dblog (2, "Multiline ivar declaration: $in");
        next READIVARS;
      }

      # partition the ivar type and name, from the documentation
      $ivarline =~ m/\;/;
      $ivarline = $`;

      # extract the type and name, *'s go in the type string
      if ($ivarline =~ m/(^.*\s+\**)(\S+)$/) {
        $type = $1;
        $ivar = $2;

        if (!defined($docs) || ($docs eq "")) {
          $docs = "No description.";
        }

        dblog (3, "Adding ivar ($type)$ivar, \"$docs\"");
        push (@obj_ivars, $ivar);
        $obj_ivartypes{$ivar} = $type;
        $obj_ivardocs{$ivar} = $docs;
      } else {
        warn ("Unable to extract ivar name and type.\n");
      }

      $ivarline = "";
    }
    return 0;
  }


#############################################################################
#
# NAME:       read_methodnames
#
# ACTION:     Read the method declarations and block names into the globals
#
# GLOBALS:    @obj_methodnames, @obj_classmethods, @obj_isntmethods,
#             %obj_methodblocks
#
# RETURN:     1 if we succeed in reading methods and block names, 0 if we fail
#
#############################################################################
sub read_methodnames
{
    local ($meth, $methname, $methblock, $methline, $in);

    return 0 if (scan_eoffound()); # don't bother if scanning won't work

    $methline = "";        # initialize the method line buffer

  READMETHODS:
    while ($in = scan_line()) {
    # detect the end of the methods list by finding an @end
    if ($in =~ m/\@end\s*$/) {
        # end of methods list reached
        dblog (2, "Found ", scalar(@obj_classmethods), " class methods, ",
           scalar (@obj_instmethods), " instance methods, and ",
           scalar(keys(%obj_methodblocks)), " method blocks.");
        return 1;
    }

    if (parse_containsADComment($in)) {
        $methblock = parse_extractADComment ($in);
        next READMETHODS;
    }

    $methline .= $in;
    if (!($in =~ m/\;/)) {
        dblog (3, "Multiline method declaration: $methline");
        $methline .= " ";
        next READMETHODS;
    }

    if ($methline =~ m/([\-\+])\s*(.*);/) {
        $meth = $2;
        $methname = $1;        # put the + or - in the methname
        $methname .= &extract_methodname($meth);

        if ($1 eq "-") {
        push (@obj_instmethods, $meth);
        } else {
        push (@obj_classmethods, $meth);
        }

        push (@obj_methodnames, $methname);
        dblog (3, "Adding method ($methname)\t($meth)");

        # if the preceeding line had a method block name comment
        if (defined($methblock) && ($methblock ne "")) {
        $obj_methodblocks{$methname} = $methblock;
        dblog (3, "Assigned ($methname) to block: \"$methblock\"");
        $methblock = "";
        }
    } else {
        warn ("Unable to parse method declaration: $methline");
    }

    $methline = "";
    }
    return 0;
}



#
# Search for methods, look them up and associate their descriptions with
# the method name
#
sub read_methoddescriptions
{
    local ($meth, $methname, $in, $foundmethod);

    return 0 if (scan_eoffound()); # don't bother if scanning won't work

    $foundmethod = 0;

  READMETHDOCS:
    while ($in = scan_line()) {

    # look for the end marker
    if ($in =~ m/\@end\s*$/) {
        dblog (2, "Found ", scalar (keys (%obj_methoddocs)),
           " method descriptions.");
        return 1;
    }

    # If we have documentation for the current method, assign it
    if ($foundmethod) {

        if (parse_containsADComment($in)) {
        $methname .= extract_methodname($meth);
        $obj_methoddocs{$methname} = parse_extractADComment($in);
        dblog (3, "Adding documentation for ($methname): \"",
               $obj_methoddocs{$methname}, "\"");
        } else {
        # if we didn't find a description, maybe it's multi-line
        if (!($in =~ m/\{/)) {
            dblog (2, "Multiline method name: $meth");
            $meth .= " $in";
            next READMETHDOCS;
        } else {
            # nope, it's missing a description...
            $methname .= extract_methodname($meth);
            $obj_methoddocs{$methname} = "No method description.";
            dblog (3, "Adding documentation for ($methname): \"",
               $obj_methoddocs{$methname}, "\"");
        }
        }
        $foundmethod = 0;
        $meth = "";
        $methname = "";
        next READMETHDOCS;
    }

    # look for a method to assign documentation to
    if ($in =~ m/^([\+\-])\s*(.*)/) {
        $meth = $2;        # the meth may be multiline, so don't
                # generate the methname until we're sure
        $methname = $1;    # grab the + or - for the methname
        $foundmethod = 1;
    }
    }
}


#
# Read in the class description, found immmediately after the @implementation
#
sub read_classdescription
{
    local ($iscategory);
    local ($in, $foundimp);

    return 0 if (scan_eoffound()); # don't bother if scanning won't work

    $iscategory = ($obj_category ne "");

    # Default description values for classes or categories
    $obj_classdocs = "No class description." if (!$iscategory);
    $obj_classdocs = "No category description." if ($iscategory);
    $foundimp = 0;

    while ($in = scan_line()) {

    if ($foundimp) {
        unless (parse_containsADComment($in)) {
        scan_rescanline(1);
        dblog (2, "Could not find class description.");
        return 0;
        }
        $obj_classdocs = parse_extractADComment ($in);
        dblog (2, "Found class description.");
        dblog (3, "\t\t\"$obj_classdocs\"");
        return 1;
    }

    # check for our data line
    if ($iscategory) {
        if ($in =~ m/^\@implementation/) {
        $foundimp = 1;
        }
    } else {
        if ($in =~ m/^\@implementation\s+$obj_name/) {
        $foundimp = 1;
        }
    }
    }
    return 0;
}


#
# Read in the method declaration location
#
sub read_declarationlocation
{
    local ($obj_root) = @_;
    local ($in, $header);

    return 0 if (scan_eoffound()); # don't bother if scanning won't work

    $header = "${obj_name}.h";

    while ($in = scan_line()) {

    # check for our data line
    if (($in =~ m/$header/) && (($in =~ m/\#\s*imp/) ||
                    ($in =~ m/\#\s*incl/))) {
        $in =~ m/[\<\"](.*$header)[\>\"]/;
        $obj_declaredin = $1;
        dblog (2, "Found header declaration location: ($obj_declaredin)");
        return 1;
    }

    # check for our fail condition
    if ($in =~ m/^\@implementation/) {
        scan_rescanline(1); # this is the line needed for the next sub
        dblog (2, "Can't find declaration location, using defaults.");
        return 0;
    }
    }
    dblog (2, "Can't find declaration location, using defaults.");
    return 0;
}

#
# turn the full method declaration to a method name suitable for hash table
# lookups for associated information
#
sub extract_methodname
{
    local ($methodname) = $_[0];

    # remove any semi-colons that might have snuck onto the end
    $methodname =~ s/;//g;

    # remove (x) delimited type-casting blocks
    $methodname =~ s/\([^\)]*\)//g;

    # remove :x argument names (leave the :, kill the name and whitespace)
    $methodname =~ s/\:\s*\S*\s*/:/g;

    # remove ALL whitespace from the methname
    $methodname =~ s/\s+//g;

    return $methodname;
}


#
# parse out protocols which appear as '<proto1, proto2>' in the line passed to
# this function, and return them as an array.  If no protocol's are referenced
# this sub returns an empty array.
#
sub extract_protocols
{
  local ($input) = $_[0];
  local (@protocols) = ();
  local ($match);

  # check for the protocol delimeters: <>
  if ($input =~ m!<([^>]+)>!) {
    $match = $1;
    $match =~ s!\s+!!g;

    # see if we have a single protocol, or a list
    if ($match =~ m!,!) {
      @protocols = split (m!,!, $match);
    } else {
      $protocols[0] = $match;
    }
  }

  # return the (possible empty) array
  return @protocols;
}


1;