#!/usr/bin/env perl

#  PCE2 - Perl C++ Extractor version 2
#  Copyright 2000-1999, Karl Nelson  <kenelson@users.sourceforge.net>
#  Copyright 1997, Mark Peskin <mpeskin@mail.utexas.edu>
#
#  This program is free software; you can redistribute it and/or modify it
#  under the terms of the GNU General Public License as published by the
#  Free Software Foundation; either version 2 of the License, or (at your
#  option) any later version.
#
#  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. See the GNU General Public License
#  for more details.

#
#  Credits:  
#     Mark Peskin - original percep extractor 
#     Karl Nelson - rewrite of extractor, added OO tree views.
#     Dave Smith  - xml dump
#

# DONE: Edward Maros
#   Support templates
#   Support Functions with leading namespace/class declaration
#   Support Variables with leading namespace/class declaration

# TODO: Edward Maros
#   Support code blocks

# TODO:
#   add reporting functions
#   enums
#   improve plugins
#   add command line interface

# This file is divided into 3 sections.  
#
#  1.0 Extraction  - Lexer and parser to extract the C++ headers
#  2.0 Plugin      - System for adding user defined code
#  3.0 Symbol Tree - Perl classes representing extracted code.
#

#
# usage: pce2 [options] files
#

#######################################################################
##### 0.0 Global defines
#######################################################################
$Enum::NONE=0;

@Enum::ACCESS_NAMES=("none","public","protected","private");
$Enum::PUBLIC=1;
$Enum::PROTECTED=2;
$Enum::PRIVATE=3;


@Enum::TYPE_NAMES=("none","namespace","class","struct","union",
                   "function","variable","typedef","friend","macro");
@Enum::TYPE_NAMES_=("none","namespaces","classes","structs","unions",
                   "functions","variables","typedefs","friends","macros");

$Enum::NAMESPACE=1;
$Enum::CLASS=2;
$Enum::STRUCT=3;
$Enum::UNION=4;
$Enum::FUNCTION=5;
$Enum::VARIABLE=6;
$Enum::TYPEDEF=7;
$Enum::FRIEND=8;
$Enum::MACRO=9;

$Enum::SYM="[A-Za-z_][A-Za-z0-9_]*";

$Html::COMMENT="<tt><font color=maroon><i>";
$Html::COMMENT_="</i></font></tt>";

$Html::BOLD="<b>";
$Html::BOLD_="</b>";
$Html::ITAL="<i>";
$Html::ITAL_="</i>";

$Html::STRING="<tt><font color=green><i>";
$Html::STRING_="</i></font></tt>";
$Html::KEYWORD="<tt><font color=black><b>";
$Html::KEYWORD_="</b></font></tt>";
$Html::FUNCTION="<tt><font color=blue><b>";
$Html::FUNCTION_="</b></font></tt>";
$Html::TYPE="<tt><font color=navy>";
$Html::TYPE_="</font></tt>";
$Html::VARIABLE="<tt><font color=blue>";
$Html::VARIABLE_="</font></tt>";
$Html::CLASS="<tt><font color=navy><b>";
$Html::CLASS_="</b></font></tt>";
$Html::ENUM="<tt><font color=green>";
$Html::ENUM_="</font></tt>";
$Html::NAMESPACE="<tt><font color=navy><b>";
$Html::NAMESPACE_="</b></font></tt>";
$Html::INTRENSIC="<tt><font color=purple>";
$Html::INTRENSIC_="</font></tt>";
$Html::SPECIFIER="<tt>";
$Html::SPECIFIER_="</tt>";

# hash tables for syntax highlighting (use init.plg to add to these)
@Html::intrensics=("void","bool","char","int","float","double");
@Html::specifiers=("inline","register","auto","virtual","const","static", "template");

# hash tables of regular expressions
%::Regex;
$::Regex{comma} = '(,|%%COMM)';
$::Regex{class} = '(class|struct|union)';
$::Regex{identifier} ='([A-Za-z_][A-Za-z_0-9]*)';
$::Regex{identifier2}="(($Enum::SYM\\:\\:)*((\\~?$Enum::SYM)|operatr\\s*\\S+))";

#
# Forward declaration of some regular expressions
#
$::Regex{class_name} = "$::Regex{identifier}";		# A.8
$::Regex{namespace_name} = "$::Regex{identifier}";	# A.6
$::Regex{cv_qualifier} = "(const|volatile)";		# A.7.1

#
# A.5 Expressions
#
$::Regex{unqualified_id} =
    "(" .
    "$::Regex{identifier}" . "|" .
    "`\~\\s*$::Regex{class_name}" .
    # operator_func_id
    # conversion_function_id
    # template_id
    ")";
$::Regex{qualified_id} =
    "($::Regex{nested_name_specifier}\\s*(template|)\\s*$::Regex{unqualified_id})";
$::Regex{id_expression} = "($::Regex{unqualified_id})|($::Regex{qualified_id})";
$::Regex{expression} =
    "($::Regex{assignment_expression}\\s*($::Regex{comma}\\s*$::Regex{assignment_expression})*)";
$::Regex{conditional_expression} =
    "($::Regex{logical_or_expression}\\s*(\?\\s*$::Regex{expression}\\s*:\\s*$::Regex{assignment_expression})?)";
$::Regex{constant_expression} = "$::Regex{conditional_expression}";
$::Regex{class_or_namespace_name} =
    "($::Regex{class_name}|$::Regex{namespace_name})";
$::Regex{nested_name_specifier} =
    "(($::Regex{class_or_namespace_name}\:\:)+)";

#
# A.7 Declarations
#
$::Regex{function_specifier} = '(inline|virtual|explicit)';
$::Regex{storage_class_specifier}='(auto|register|static|extern|mutable)';
$::Regex{class_name} = "$::Regex{identifier}";
$::Regex{enum_name} = "$::Regex{identifier}";
$::Regex{typedef_name} = "$::Regex{identifier}";
$::Regex{type_name} =
    "($::Regex{class_name}|$::Regex{enum_name}|$::Regex{typedef_name})";
    
$::Regex{simple_type_specifier} =
    "(" .
    "((\:\:)?$::Regex{nested_name_specifier}?$::Regex{type_name})" . "|" .
    "char|wchar_t|bool|short|int|long|signed|unsigned|float|double|void" .
    ")";
$::Regex{elaborated_type_specifier} =
    "(" .
    "($::Regex{class_key}|enum)\\s*\\:\\:\\s*$::Regex{nexted_name_specifier}?$::Regex{identifier}" . "|" .
    "typename\\s*\\:\\:\\s*$::Regex{nested_name_spedifier}\\s*$::Regex{identifier}\\s*<\\s*$::Regex{template_argument_list}\\s*>" .
    ")";
$::Regex{type_specifier} =
    "(" .
    "$::Regex{simple_type_specifier}" . "|" .
    "$::Regex{elaborated_type_specifier}" . "|" .
    "$::Regex{cv_qualifier}" .
    # class_specifier
    # enum_specifier
    ")";
$::Regex{type_specifier_seq} =
    "($::Regex{type_specifier2}(\\s*$::Regex{comma}\\s*$::Regex{type_specifier2})*)";
$::Regex{type_id} = 
    "($::Regex{type_specifier_seq}(\\s*$::Regex{abstract_declarator})?)";


#
# A.7.1 Declarators
#
$::Regex{cv_qualifier_seq} =
    "$::Regex{cv_qualifier}?";
$::Regex{ptr_operator} =
    "(" .
    "\\*\\s*$::Regex{cv_qualified_seq}?" . "|" .
    "\\&|(\:\:)?$::Regex{nested_name_specifier}\\s*\\*\\s*$::Regex{cv_qualified_seq}?" .
    ")";
$::Regex{declarator_id} = 
    "((\:\:)?\\s*($::Regex{id_expression}|$::Regex{nested_name_specifier}\\s*$::Regex{type_name}))";
$::Regex{declarator} =
    "($::Regex{ptr_operator}*$::Regex{direct_declarator})";

#
# A.8 Classes
#
$::Regex{pure_specifier} = '(=\s*0\s*)';
$::Regex{constant_initializer} = "(=\\s*$::Regex{constant_expression})";
$::Regex{member_declarator} =
    "(" .
    "($::Regex{declarator}\\s*$::Regex{pure_specifier}?)" . "|" .
    "($::Regex{declarator}\\s*$::Regex{constant_initializer}?" . "|" .
    "($::Regex{identifier}\\s*\:\\s*$::Regex{constant_expression})" .
    ")";

#------------------------------------------------------------------------
# A.8.3 Overloading
#------------------------------------------------------------------------
#: The regular expression for an operator
#!expr: 1 - only the operator
#------------------------------------------------------------------------
$::Regex{operator}=
    '(new|delete|new\[\]|delete\[\]'.
    '|[\+\-\*\/%^&\|~!=<>]' .
    '|\+=|\-=|\*=|\/=|\%=|^=|&=|\|=|<<|>>|>>=|<<=|=='.
    '|!=|<=|>=|&&|\|\||\+\+|\-\-|$::Regex{comma}|->\*|->|\(\)|\[\])';
#------------------------------------------------------------------------
#: The regular expression for an operator overload function
#!expr: 1 - complete expression
#!expr: 2 - only the operator
#------------------------------------------------------------------------
$::Regex{operator_func_id}="(operator\\s*$::Regex{operator})";

#------------------------------------------------------------------------
# A.9 Templates
#------------------------------------------------------------------------
$::Regex{template_parameter} =
    "((class|typename)\\s+($::Regex{identifier}|))";
$::Regex{template_parameter_list}="($::Regex{template_parameter}\\s*($::Regex{comma}\\s*$::Regex{template_parameter}\\s*)*)?";
$::Regex{template_name} =
    "($::Regex{identifier2}\\s*<\\s*$::template_parameter_list\\s*>)";
$::Regex{template_arg} =
    "($::Regex{template_name}|$::Regex{type_id})";
$::Regex{template_arg_list} =
    "($::Regex{template_arg}(\\s*$::Regex{comma}\\s*$::Regex{template_arg})*)?";
$::Regex{template_id} =
    "($::Regex{template_name}\\s*<\\s*$::Regex{template_arg_list}\\s*>)";
#------------------------------------------------------------------------
#: The regular expression for a throw expression
#!expr: 1 - arguments to throw specifier
#------------------------------------------------------------------------
$::Regex{throw}='throw\s*\(([^\)]*)\)';
$::Regex{template_declaration_only} =
    "((export\\s+|)template\\s*<\\s*$::Regex{template_parameter_list}\\s*>)";
# $::Regex{type_specifier}='(((inline|virtual)\s+)*)';

$::Regex{nested_templated_name_specifier} =
    "(($::Regex{class_or_namespace_name}\\s*(<\\s*$::Regex{template_arg_list}\\s*>)?\\s*\:\:)+)";
$::Regex{templated_ptr_operator} =
    "(" .
    "\\*\\s*$::Regex{cv_qualified_seq}?" . "|" .
    "\\&|(\:\:)?$::Regex{nested_templated_name_specifier}\\s*\\*\\s*$::Regex{cv_qualified_seq}?" .
    ")";
$::Regex{templated_type_name} = 
    "($::Regex{type_name}(\\s*<\\s*$::Regex{template_arg_list}\\s*>)?)";
$::Regex{templated_declarator_id} = 
    "((\:\:)?\\s*($::Regex{id_expression}|$::Regex{nested_templated_name_specifier}\\s*$::Regex{templated_type_name}))";
#my $key;
#foreach $key (sort keys %::Regex)
#{
#    print STDERR "INFO: key - $key - $::Regex{$key}\n";
#}
#exit 0;

#######################################################################
##### 0.1 Command line and Main 
#######################################################################
#
# GLOBALS:
#   &PROCESS
#   &PLUGIN
#   $global - namespace for all extracted symbols
#   $unknown - namespace for extrapolated symbols 
# 
package main;
use strict;

$::debug=1;
$::verbose=1;
$::ws_verbose=1;
$::report_xml=0;
$::code_blocks=0;

&parseArgs(@ARGV);

$::global=Namespace::new("","");
%::global_variables;
$::anonymous=Namespace::new("","");
$::unknown=Namespace::new("","");

my $output_plugin="output";
my @filelist;
my @suffixes=("h","H","hh");
my $buffer;

&EXEC();
exit;

##################################################  
### EXEC
sub EXEC {
  my $buffer;
  my $file;

  &PLUGIN("init");

  foreach $file (@filelist) {
    $buffer="";
    print "Reading $file\n" if ($::verbose);
    $::currentfile=$file;
    $::currentfile=~s/^.*\///g;
    $::currentfileprefix=$file;
    $::currentfileprefix=~s/^(.*)\/([^\/]*)/$1/g;

    open(INPUT,"<$file");
    while(<INPUT>) { $buffer.=$_; }
    close(INPUT);  

    $buffer=&PLUGIN("input",$file, $buffer);

    &Extract::process($buffer);
  }

  &Extract::crossRef($::global);
  &Extract::crossArgs($::global);
  &Extract::markup($::global);

  &PLUGIN($output_plugin,$::global);
  &XML if ($::report_xml);
}


sub regexDepth
{
    my ($regex) = @_;
    my ($escape) = 0;
    my ($depth) = 0;
    foreach (split //, $regex)
    {
	do { $escape = 0; next; } if ($escape);
	$escape = 1 if $_ eq '\\';
	$depth++ if $_ eq '(';
    }
    return $depth;
}

##################################################  
### parseArgs
sub parseArgs {
  my $arg;
  print "Parsing Command Line\n" if $::debug;
  while (@_) {
    $arg=shift;
    if ( $arg=~/^--(.*)/) {
      if    ($1 eq "help")   {
        USAGE();
      }
      elsif ($1 eq "plgdir") {
        unshift(@Plugin::directory_,shift @_);
      }
      elsif ($1 eq "xml") {
        $::report_xml=1;
        $::verbose=0;
      }
      elsif ($1 eq "output") {
	$output_plugin=shift;
      }
      elsif ($1 eq "codeblocks") {
	  # :TODO: Need to support codeblocks.
	  $::code_blocks=1;
      }
      else {
        print STDERR "Unknown argument --$1\n";
	exit;
      }
    }
    else
    {
      if ( -d $arg ) {
        my $entry;
	my $str;

        $str='\.((';
	$str.=join(")|(",@suffixes);
	$str.='))\$';

	opendir(DIR,"$arg");
	foreach $entry (sort readdir(DIR)) {
	push (@filelist,"$arg/$entry") if ( $entry =~ /$str/) ;
	}
      }
      else {
        push(@filelist,$arg);
      }
    }
  }
}

sub XML {
  print "<?xml version=\"1.0\"?>\n";
  print "<global>\n";
  $::global->dump_xml();
  print "</global>\n";
}



#######################################################################
##### 1.0 Code Extractor
#######################################################################
package Extract;
use strict;

##################################################  
### process
sub process  {
  my ($buffer)=@_;
  

  $buffer=&prep($buffer);

  &parse($::global,$buffer);

  return $::global;
}

##################################################  
### Typedef
sub parse {
  my($env,$buffer)=@_;

  my $line;
  my(@lines)=split(/\n|([}{;])/,$buffer); # lines to be processed

  my $block="";
  my($comments);      # comments collected before a block
  my($macro_data)=""; # macro string collected
  my($process)=0;     # indicates time to process block
  my($inblock)=0;     # indicates block start found
  my($bcount)=0; 
  my($isdef)=0;  
  my($needsemi)=0;
  my($comment_continue)=0;
  my($comment_key);

#
#  Process File
#   (line by line)

  open(STDERR, ">> stderr");
  while (@lines) {
    $_=shift @lines;
#    print STDERR "Processing \"$_\"\n";

#
#  main statement blocks
#

    # collect up comments for later
    if (/^\s*\/\/(.*)$/) {
      if ($bcount<1) {
        $comments.=&unmask($1);
        $comments.="\n";
      }
      else {
        $block.="$_\n";
      }
      next;
    }

    # push back comments not starting line
    if (/^(.+)\s*(\/\/.*)$/) {
      unshift(@lines,$2);
      $_=$1;
    }

    if (!$inblock) {
      if (/^\s*\/\/!(.*)/) {
	  my ($globals) = &unmask($1);
	  my $global_equals = '=';
	  while ($globals=~s/[^\w\d]([\w\d]+)\s*$global_equals\s*([^\"\'\s]+)//)
	  {
	      $::global_variables{$1}=$2;
	  }
          while ($globals=~s/[^\w\d]([\w\d]+)\s*$global_equals\s*(\"|\')([^\2]+)\2//)
	  {
	      $::global_variables{$1}=$3;
	  }

      }

      if (/^\s*(public|protected|private):(.*)$/) {
        $_=$2;
        $env->set_public() if ($1 eq "public");
        $env->set_private() if ($1 eq "private");
        $env->set_protected() if ($1 eq "protected");
      }

      # break up lines with access declarations
      if (/^(.*)(public:|protected:|private:)(.*)$/) {
        unshift(@lines,$2);
        unshift(@lines,$3);
        $_=$1;
      }

      next if ($_ eq ";" ); # dump extra ;
      next if (/^\s*$/);

      # handle macros
      if (/^\#/ || $macro_data) {
        $macro_data.=$_;
        if (!s/\\$//) {
          # why do we process the macro only if there are comments?
          &procMacro($macro_data) if ($comments);
          $comments="";
          $macro_data="";
        }
        next;
      }

      # We are entering a code block 
      $inblock=1;
      $isdef=0;

      $needsemi=1 if (/^\s*(typedef\s+|)(class|struct|union|enum)/); 
    }

    # we must be in a block
    if ( $_ eq "{" ) { 
      $bcount++; 
      $isdef=1; 
    }

    if ( $_ eq "}" ) { 
      $bcount--; 
      $_="} << $needsemi $isdef " if ($bcount == 0);
    }

    $process=1 if ( $bcount<1 && /^;/ );
    $process=1 if ( $bcount<1 && !$needsemi && $isdef );
    
    if ($bcount)
      { $block.="$_\n";}
    else
      { $block.="$_ ";}

#
#  Examine extracted statement blocks: Determine type and process appropriately
#
    if ($process) {

      if ($block=~/^\s*template(\s|<)/) 
        {&procTemplate($env,$block,$comments);}
      elsif ($block=~/^\s*$::Regex{class}\s/) 
        {&procClass($env,$block,$comments);}
      elsif ($block=~/^\s*namespace/) 
        {&procNamespace($env,$block,$comments);}
      elsif ($block=~/^\s*extern %%QUOTDC%%QUOTD/) 
        {&procExtern($env,$block,$comments);}
      elsif ($block=~/^\s*using\s/) 
        {} # we do not track using
      elsif ($block=~/^\s*friend\s/) 
        {&procFriend($env,$block,$comments);} 
      elsif ($block=~/^\s*enum/) 
        {&procEnum($env,$block,$comments);}
      elsif ($block=~/^\s*typedef/) 
        {&procDef($env,$block,$comments);}
      elsif ($block=~/^\s*([^)]*)\s+$::Regex{identifier2}\s*\(([^\)]*)\)\s*(const)*\s*($::Regex{throw})*\s*($::Regex{pure_specifier}|try)?\s*[:{;]/)
        {&procFunc($env,$block,$comments);}
      elsif ($block=~/^\s*([^)]*)\s+$::Regex{nested_templated_name_specifier}?$::Regex{operator_func_id}\s*\(([^\)]*)\)\s*(const)*\s*($::Regex{throw})*\s*($::Regex{pure_specifier}|try)?\s*[:{;]/)
        {&procFunc($env,$block,$comments);}
      elsif ($block=~/^\s*([\w<>:\,\s\*&]*[\w<>:\*&]\s[\s\*&]*)(\S+|$::Regex{operator_func_id})\s*\(([^\{\)]*)\)\s*(const|)($::Regex{throw})?\s*($::Regex{pure_specifier}|try)?(\W|)\s*$/) 
        {&procFunc($env,$block,$comments);}
      elsif ($block=~/^\s*(\S+|$::Regex{operator_func_id})\s*\(([^\{\)]*)\)\s*(const|)/) 
        {&procFunc($env,$block,$comments);}
      elsif ($block=~/^\s*([\w<>:\,\s\*&]*[\w<>:\*&]\s[\s\*&]*)(\w[\w\s:\[\]]*)\s*\=*\s*\S*\s*([,;])/) 
        {&procVar($env,$block,$comments);}
      else
        { print STDERR "UNKNOWN: >>$block<<\n"; }

      $process=0;
      $bcount=0;
      $block="";
      $inblock=0;
      $needsemi=0;
      $comments="";
    }
  }
#  print STDERR "LEFTOVERS\n$comments\n" if ($comments);
}

##################################################  
### prep
#
# Prepares buffer for parser.  
#  - removes C comments
#  - masks ^#.*$ ^//.*$ (.*) ".*" '.'
#
sub prep {
  my $in=join("",@_);
  my $str;
  my $token;
  my $last;
  my @tokens;
  my @out;
  my $line;
  my @lines;
  my @look=();
  my $lookfor="";
  my $newline=0;
  my @buffer=split("\n",$in);;
  
  while (@buffer) {
    $newline=1;

    # handle continued lines
    $str=shift(@buffer);
    $str.="\n";

    while ($str =~/^(.*)\\$/)  {
      $str="$1"; 
      $str.=shift(@buffer); 
    }


    @tokens=split(/(\s+|\/\*|\*\/|\/\/|\\.|\"|\'|#|\(|\))/,$str);
    while(@tokens)
      {
        $last=$token if ($token ne "");
        $token=shift(@tokens);
  
        # order is very important
 
        next if ($token eq "");  # skip blank tokens
 
        # C comment beats most
        if ($lookfor eq "/*") {
          if ($token eq "*/") {
            $line=pop(@lines);
            $lookfor=pop(@look);
            next;
          } 
          $line.=$token;
          next;
        }
 
        # quote beats ()
        if ($lookfor eq "\"" || $lookfor eq "\'") {
          if ($token eq $lookfor) {
            $line.=$token;
            $str=&mask($line);
            $line=pop(@lines);
            $line.=$str;
            $lookfor=pop(@look);
            next;
          }
          $line.=$token;
          next;
        }
       
        if ($lookfor eq "(" && $token eq ")") {
          $str=&mask($line);
          $line=pop(@lines);
          $line.=$str;
          $line.=$token;
          $lookfor=pop(@look);
          next;
        }
 
        if ($token =~ /\s+/) { 
          $line.=$token;
          next;
        }

        if (!$lookfor && $newline && $token eq "#") {
          $line.=$token;
          $str=&prep(join("",@tokens));
          $line.=$str;
          @tokens=();
          next;
        }
        $newline=0;
        if ($token eq "//") {
          $line.=$token;
          $str=&mask(join("",@tokens));
          $str=~s/\/\//%%CPCOMM/g;
          $line.=$str;
          @tokens=();
          next;
        }

        if ($token eq "\"" || $ token eq "\'" || $token eq "/*" ) {
          push(@look,$lookfor);
          push(@lines,$line); 
          $line="";
          $lookfor=$token;
        }
        elsif ($token eq "(") {
          $line.=$token;
          push(@look,$lookfor);
          push(@lines,$line); 
          $line="";
          $lookfor=$token;
          next;
        }

        $line.=$token;
      }

    if (!@lines) {
      push(@out,$line);
      $line="";
    }
  }
  $str=join("",@out);
  $str.=join("",@lines);
  $str;
}

##################################################  
### mask
#
# hides certain symbols so they don't confuse the parser
sub mask {
  my $line=shift;
  $line=~s/\{/%%BRACEO/g;
  $line=~s/\}/%%BRACEC/g;
  $line=~s/\"/%%QUOTD/g;
  $line=~s/\'/%%QUOTS/g;
  $line=~s/\(/%%BRAKO/g;
  $line=~s/\)/%%BRAKC/g;
  $line=~s/,/%%COMM/g;
  $line=~s/;/%%SEMI/g;
  $line;
}

##################################################  
### unmask
#
# recovers masked symbols
sub unmask {
  my $line=shift;
  $line=~s/%%BRACEO/\{/g;
  $line=~s/%%BRACEC/\}/g;
  $line=~s/%%QUOTD/\"/g;
  $line=~s/%%QUOTS/\'/g;
  $line=~s/%%BRAKO/\(/g;
  $line=~s/%%BRAKC/\)/g;
  $line=~s/%%COMM/,/g;
  $line=~s/%%SEMI/;/g;
  $line;
}


##################################################  
### extract
# extracts part of the buffer.
sub extract {
  my ($block,$start,$stop,$nonest)=@_;
  my @in=split(/($start|$stop)/,$block);
  my @out;
  my $str;
  my $token;
  my $depth=0;

  while (@in) {
    $token=shift(@in);
    if ($token eq $stop) {
      $depth--;
      if ($nonest || $depth==0) {
        $str=join("",@out); 
        return $str;
      }
    }
    push(@out,$token) if ($depth>0);
    $depth++ if ($token eq $start);
  }
  return "";
}


##################################################  
### proc*

# sub routines for extracting sepecific types of blocks.

sub procNamespace {
    my($env,$block,$com)=@_;
    $block=~s/^\s+//;
    
    if ($block=~/^namespace\s+(\S+)\s*\{/) { 
	$env=Namespace::new($env,"$1",$com);
    }
    elsif ($block=~/^namespace\s*\{/) { 
	$env=$::anonymous; 
    }
    elsif ($block=~/^namespace\s+\S+\s*=\s*\S+\s*;/) { 
	# ignore namespaces aliases
    }
    else { 
	print STDERR "ERROR: namespace:\n<BLOCK>\n$block\n<\BLOCK>\n\n"; 
	return ""; 
    }
    &parse($env,&extract($block,"{","}"));
    return $env;
}

sub procClass {
    my($env,$block,$com)=@_;
    my($namespace,$name,$type,$base);

    if ($block =~ /$::Regex{class}\s+((($Enum::SYM\:\:)*$Enum::SYM)\:\:)?($Enum::SYM<\s*$::Regex{template_arg_list}\s*>)/)
    {
	$namespace=$3;
	$type=$1;
	$name=$5;
	print STDERR "DEBUG: procClass - 1\n";
	my($local_env) = $env;
	if ($namespace !~ /^$/)
	{
	    $local_env = Namespace::new($env, $namespace, "");
	}
	$env=Class::new($local_env,$name,$com,$type,"");
    }
    elsif ($block=~/^\s*(class|union|struct)\s+((($Enum::SYM\:\:)*$Enum::SYM)\:\:)?($Enum::SYM)\s*(:[^:].*)?\{/) { 
	$namespace=$3;
	$type=$1;
	$name=$5;
	$base=$6;
	$base =~ s/^:\s*//;
	print STDERR "DEBUG: procClass - 2\n";
	print STDERR "DEBUG: procClass - 2- 1:$1 2:$2 3:$3 4:$4 5:$5 6:$6\n";
	my($local_env) = $env;
	if ($namespace !~ /^\s*$/)
	{
	    print STDERR "DEBUG: Creating namespace $3 inside of $env->{fullname}\n";
	    $local_env = Namespace::new($env, $namespace, "");
	}
	print STDERR "DEBUG: procClass - 2- 1:$1 2:$2 3:$3 4:$4 5:$5\n";
	if ( $base )
	{
	    $env=Class::new($local_env,$name,$com,$type,$base);
	}
	else
	{
	    $env=Class::new($local_env,$name,$com,$type);
	}
    }
    elsif ($block=~/^\s*(class|union|struct)\s+(\S+)\s*:([^:].*)\{/)
    { 
	$type=$1;
	$name=$2;
	$base=$3;
	print STDERR "DEBUG: procClass - 3\n";
	$env=Class::new($env,$name,$com,$type,$base);
    }
    elsif ($block=~/^\s*(class|union|struct)\s+(\S+)\s*\{/) { 
	$type=$1;
	$name=$2;
	print STDERR "DEBUG: procClass - 4\n";
	$env=Class::new($env,$name,$com,$type);
    }
    elsif ($block=~/^\s*(union|struct)\s*\{/) { 
	print STDERR "DEBUG: procClass - 5\n";
	# anonymous union (do nothing)
	&parse($env,&extract($block,"{","}"));
	return "";
    }
    elsif ($block=~/^\s*(class|union|struct)\s+(\S+)\s*;/) { 
	print STDERR "DEBUG: procClass - 6\n";
	# forward decl (ignore)
	return "";
    }
    elsif ($block=~/^\s*$::Regex{class}\s+(\S+)\s+(\S+)\s*;/) {
	print STDERR "DEBUG: procClass - 7\n";
	# Actually a variable declaration;
	return &procVar($env, $block, $com);
    }
    else 
    {
	print STDERR "ERROR: class:\n$block\n\n"; return "";
    }
    &parse($env,&extract($block,"{","}"));
    return $env;
}

sub procArgs {
  my($env,$block,$comments)=@_;
  return "";
}

sub procFunc {
    my($env,$block,$com)=@_;
    my($obj,$type,$args,$name,$const,$throw,$namespace,$fullname);
    my($bigblock) = $block;
    ($block)=split("\n",$block,2);
    $block=~s/\s+\*/* /g;
    $block=~s/\s+\&/& /g;
    $block=~s/\s+/ /g;

    #Exceptions that should be ignored
    if ($block =~/^\s*catch\s*[\(]/)
    {
	return "";
    }
    # normal function
    elsif ($block=~/^\s*([^)]*)\s+((($Enum::SYM)::)*$Enum::SYM)\s*\(([^\)]*)\)\s*(const|)\s*($::Regex{throw})?\s*($::Regex{pure_specifier}|try)?\s*[:{;]/) {
	$type=$1;
	$fullname=$2;
	$args=&unmask($5);
	$const=$6;
	$throw=&unmask($8);
	$fullname =~ /^((($Enum::SYM)::)*)(\~*$Enum::SYM)/;
	$namespace = $1;
	$name = $4;
	if (($block =~ /^.*$::Regex{throw}.*$/) && ($throw =~ /^\s*$/))
	{
	    $throw = " ";
	}
    }
    
    # ctor
    elsif ($block=~/^\s*($::Regex{function_specifier}\s+)*((($Enum::SYM)::)*(\~*$Enum::SYM))\s*\(([^)]*)\)\s*(const)*\s*($::Regex{throw})*\s*[:{;]/) {
	my ($offset) = &main::regexDepth($::Regex{funciton_specifier});
	$type=$1;
	$offset += 3;
	$fullname=eval("\$$offset");
	$offset += 4;
	$args=&unmask(eval("\$$offset"));
	$offset++;
	$const=eval("\$$offset");
	$offset += 2;
	$throw=&unmask(eval("\$$offset"));
	$fullname =~ /^((($Enum::SYM)::)*)(\~*$Enum::SYM)/;
	$namespace = $1;
	$name = $4;
	if (($block =~ /^.*$::Regex{throw}.*$/) && ($throw =~ /^\s*$/))
	{
	    $throw = " ";
	}
	print STDERR "CTOR: ", join("-opt-", ($type, $namespace,$name,$args,$const,$throw)),"\n";
    }

    #operator
    elsif ($block=~/^([^)]*)\s+((($Enum::SYM)::)*)$::Regex{operator_func_id}\s*\(([^\)]*)\)\s*(const)*\s*($::Regex{throw})?\s*($::Regex{pure_specifier}|try)?\s*[\{;]/) {
	# Some optional characters followed by optional space(s)
	# ex: ooo operator[] const ...
	$type=$1;
	$namespace = $4;
	$name="operator $6";
	$args=&unmask($7);
	$const=$8;
	$throw=&unmask($10);
	if (($block =~ /^.*$::Regex{throw}.*$/) && ($throw =~ /^\s*$/))
	{
	    $throw = " ";
	}
	print STDERR "DEBUG: operator: $name - $type - $com\n";
    }
    else
    {
	($type,$namespace,$name,$args, $const,$throw) = &procFunc2($block);
	if ($name eq "")
	{
	    print STDERR "ERROR: function:\n$block\n\n"; 
	    return "";
	}
    }

    $obj=Function::update($env,$name,$com,$type,$args,$throw,$const,$namespace);
    if ($::code_blocks && $obj)
    {
	my ($cb) =   &extract($bigblock,"{","}");
	$cb = "$block $cb }";
	$cb =~ s/\n/\<br\>/mg;
	$cb =~ s/\s+/ /g;
	$cb =~ s/(\s*(\<br\>)+)+/\<br\>/g;
	$cb =~ s/\<br\>;/;/g;
	$$obj{codeblock} = $cb if ($cb !~ /^\s*$/);
    }
    return $obj;
}

sub procFunc2
{
    my ($block) = @_;
    my ($oldblock) = $block;
    my ($type, $namespace, $name, $parameters, $const, $throw);
    my (@answer);
    my ($offset, $tmp);

    #--------------------------------------------------------------------
    # Function Specifier
    #--------------------------------------------------------------------
    $block =~ s/^\s+//o;
    if ($block =~ s/^($::Regex{function_specifier}\s+)//o)
    {
	$type = $1;
    }
    #--------------------------------------------------------------------
    # Declarator Id
    #--------------------------------------------------------------------
    $block =~ s/^\s+//o;
    if ($block =~ s/^((\:\:)?$::Regex{nested_templated_name_specifier}\s*$::Regex{templated_type_name})//o)
    {
	$offset = &main::regexDepth($::Regex{nested_templated_name_specifier})
	    + &main::regexDepth($::Regex{templated_type_name}) + 3;
	$tmp .= $1;
    }
    elsif ($block =~ s/^((\:\:)?$::Regex{id_expression})//o)
    {
	$type .= $1;
    }
    #--------------------------------------------------------------------
    # Pointer
    #--------------------------------------------------------------------
    if ($block =~ s/^\s+//o)
    {
	$type .= $tmp;
	$tmp = "";
    }
    if ($block =~ s/^([\*\&]+)//o)
    {
	my ($match) = ($1);
	$match =~ s/\s//g;
	$type .= $tmp . $match;
    }
    else
    {
	$block = $tmp . $block;
    }
    #--------------------------------------------------------------------
    # Namespace and Name 
    #--------------------------------------------------------------------
    $block =~ s/^\s+//o;
    if ($block =~ s/^($::Regex{nested_templated_name_specifier}?(\~?$::Regex{identifier}))//o)
    {
	$namespace = $2;
	$offset = &main::regexDepth($::Regex{nested_templated_name_specifier}) + 2;
	$name = eval("\$$offset");
    }
    #--------------------------------------------------------------------
    # Parse argument list
    #--------------------------------------------------------------------
    $block =~ s/^\s+//o;
    if ($block =~ s/^\(([^\)]*)\)//o)
    {
	$parameters = &unmask($1);
    }
    #--------------------------------------------------------------------
    # const
    #--------------------------------------------------------------------
    $block =~ s/^\s+//;
    if ($block =~ s/^(const)//o)
    {
	$const = $1;
    }
    #--------------------------------------------------------------------
    # throw
    #--------------------------------------------------------------------
    $block =~ s/^\s+//o;
    if ($block =~ s/^$::Regex{throw}//o)
    {
	$throw = &unmask($1);
	if ($throw =~ /^\s*$/)
	{
	    $throw = " ";
	}
    }
    #--------------------------------------------------------------------
    # Pure Virtual
    #--------------------------------------------------------------------
    $block =~ s/^\s*$::Regex{pure_specifier}?//o;
    #--------------------------------------------------------------------
    # Remove templates from namespace
    #--------------------------------------------------------------------
    while($namespace =~ /<[^>]*>/)
    {
	$namespace =~ s/<[^>]*>//g;
    }
    if ($name eq "")
    {
	$name = $type;
	$type = "";
    }
    @answer = ($type, $namespace, $name, $parameters, $const, $throw);
    return @answer;
}

sub procVar {
  my($env,$block,$com)=@_;
  ($block)=split("\n",$block,2);
  $block=~s/\s+/ /g;
  my($name,$namespace,$value,$type);
  my($ref) = "(.*\\s+[\\*&]*)";
  my($local_env) = $env;
  
  if ($block=~/^\s*${ref}((($Enum::SYM\:\:)*$Enum::SYM)\:\:)?($Enum::SYM)\s*(\[.*\])*\s*(=\s*(.*)\s*)*;/) {
      print STDERR "DEBUG: procVar - 1\n";
      print STDERR "DEBUG: procVar - 1- env:$env->{fullname} 1:$1 2:$2 3:$3 4:$4 5:$5 \n";
      $type = $1;
      $namespace = $2;
      $name = $5;
      $value = $6;

      if ($namespace !~ /^\s*$/)
      {
	  print STDERR "DEBUG: Creating namespace $3 inside of $env->{fullname}\n";
	  $local_env = Namespace::new($env, $namespace, "");
      }
      return &Variable::update($local_env,$name,$com,"$type$value");
  }
  elsif ($block=~/^\s*${ref}($Enum::SYM)\s*(\[.*\])*\s*(=\s*\S+\s*)*;/) { 
      print STDERR "DEBUG: procVar - 2";
    return Variable::new($env,$2,$com,"$1$3");
  }
  elsif ($block=~/^\s*(.*\**)\s+($Enum::SYM)\s*(\[.*\])*\s*(=\s*\S+\s*)*;/) { 
      print STDERR "DEBUG: procVar - 3";
    return Variable::new($env,$2,$com,"$1$3");
  }
  elsif ($block=~/^\s*(.*\**)\s+($Enum::SYM\:\:)+($Enum::SYM)\s*(\[.*\])*\s*(=\s*\S+\s*)*;/) { 
      print STDERR "DEBUG: procVar - 4";
      return &Variable::update($env, $3, $com, "$1$4", $2);
  }
  else {
    print STDERR "ERROR: variable:\n$block\n\n"; 
  }
  return "";
}

sub procDef {
  my($env,$block,$com)=@_;
  $block =~ s/\s+/ /mg;
  if ($block=~/^\s*typedef\s+(.*)\s+(\S+)\s*;/) { 
    return Typedef::new($env,$2,$com);
  }
  elsif ($block =~ /^\s*typedef\s+\S+\s*{}\s*(\S+);/) {
    return Typedef::new($env,$2,$com);
  } else {
    print STDERR "ERROR: typedef:\n$block\n\n"; 
  }
  return "";  
}

sub procEnum {
  my($env,$block,$com)=@_;
  &parse($env,&extract($block,"{","}"));
  return "";
}

sub procFriend {
  my($env,$block,$com)=@_;
  if ($block=~/^\s*friend\s+(.*)\s*;/) { 
    return Friend::new($env,$2,$com);
  }
  else {
    print STDERR "ERROR: friend:\n$block\n\n"; 
  }
  return "";
}

sub procMacro {
  my($env,$block,$com)=@_;
  return "";
}

sub procExtern {
  my($env,$block,$com)=@_;
  if ($block=~/^\s*extern\s*%%QUOTDC%%QUOTD\s*{/) {
    &parse($env,&extract($block,"{","}"));
    return "";
  }
  elsif ($block=~/^\s*extern\s*%%QUOTDC%%QUOTD\s*/) {
    $block=~s/^extern\s*%%QUOTDC%%QUOTD\s*//;
    &parse($env,$block);
    return "";
  }
  else {
    print STDERR "ERROR: extern:\n$block\n\n"; 
  }
  return "";
}

sub procTemplate {
  my($env,$block,$comments)=@_;
  my($obj,$type,$args,$namespace,$name,$const,$rest);
  ($block, $rest)=split("\n",$block,2);
  $block=~s/\s+\*/* /g;
  $block=~s/\s+\&/& /g;
  $block=~s/\s+/ /g;

  if ($block =~ /^\s*template\s*<\s*>\s*$::Regex{class}\s+((($Enum::SYM\:\:)*$Enum::SYM)\:\:)?(($Enum::SYM)\s*<\s*$::Regex{template_arg_list}\s*>)/)
  {
      my($local_env) = $env;
      if ($3 !~ /^$/)
      {
	  $local_env = Namespace::new($env, $3, "");
      }
      $obj=Class::new($local_env,$5,$comments,$1,"");
    }
  elsif ($block=~/^\s*template\s*<([^>]*)>\s*(class|union|struct)\s+(\S+)\s*:(.*)\{/) { 
      # Derived Class
      $obj=Class::new($env,$3,$comments,$2,$4,$1);
  }
  elsif ($block=~/^\s*template\s*<([^>]*)>\s*(class|union|struct)\s+(\S+)\s*\{/) { 
      # Base Class
      # $type = "template<" . &unmask($1) . "> " . $2;
      $type = $2;
      $obj=Class::new($env,$3,$comments,$type,"",$1);
  }
  elsif ($block=~/^\s*template\s*<[^>]*>\s*(class|union|struct)\s+(\S+)\s*;/) { 
      # forward decl (ignore)
      return "";
  }
  elsif ($block=~/^\s*$::Regex{template_declaration_only}(.*)/)
  {
      my ($offset) = &main::regexDepth($::Regex{template_declaration_only});

      $offset += 1;
      $obj=&procFunc($env, eval("\$$offset"), $comments);
      if ($obj)
      {
	  $$obj{template}=1;
	  # $$obj{type} = "template<" . &unmask($1) . ">" . $$obj{type};
      }
      else
      {
	  print STDERR "ERROR: template:",eval("\$$offset"),"\n$block\n\n";
	  return "";
      }
  }
  elsif ($block=~/^\s*template[^<]+<[^>]*>(\s*\([^\)]*\))?\s*;/)
  {
      # Template instantiation
      return "";
  }
  elsif ($block=~/^\s*template[^<]+<.*>\s*;/)
  {
      # Template instantiation
      return "";
  }
  else
  {
      print STDERR "ERROR: template:\n$block\n\n";
      return "";
  }
  $block .= $rest;
  &parse($obj,&extract($block,"{","}")) if ( ! $obj->is_function );
  return $obj;
}


sub procComments {
  my ($comments)=@_;
  my ($short,$long,$str);
  my (@plugins);		# Things that need to be processed by plugins
  my ($long_completed)=0;
  my ($state)=0;
  my ($cont)=0;

  $short = "";
  $long  = "";
  $comments=~s/%%CPCOMM/\/\//g;
  foreach (split("\n",$comments))
  {
      $cont = 0;
      $cont = 1 if (/^\+/ || /\+$/);
      if (/^\:|\-|\!|\+|\.|\s/ || $cont)
      {
          /^.(.*)$/;
	  $str = "$1";
	  $str =~ s/(.*)\+$/$1/;
          $str .= "\n";

          if (/^(-|\s)\s*$/ || ($cont && ($state == 1)) ) {
	    $state=1;
            $long.= "\n" if (!$long_completed);
          }
          elsif (/^(-|\s)/ || ($cont && ($state == 1)) ) {
	    $state=1;
            $long.=" $str" if (!$long_completed);
          }
          elsif (/^:/ || ($cont && ($state == 2)) ) {
	    $state=2;
            $long="";
            $short.= " $str";
	    $long_completed=0;
          }
	  elsif (/^![^:]*:/ || ($cont && ($state == 3)) ) {
	    $state=3;
	    if ($cont)
	    {
		chop($plugins[$#plugins]);
		$plugins[$#plugins] .= $str;
	    }
	    else
	    {
		$plugins[++$#plugins] = $str;
	    }
	  }
	  elsif (/^+/) {
	  }
	  else {
	    $long_completed=1;
	    $state=0;
	  }
       }
#       else
#       {
#          $short = "";
#          $long  = "";
#       }
    }
  ($short,$long,@plugins);
}


##################################################  
### crossRef
#
# This establishes all the parent and child relationships between classes
# after data is extracted.
sub crossRef {
  my $space=shift;
  my $access="public";
  my $class;
  my $parent;
  my $pname;
  my $pstr;
  foreach $class (classes $space) {
    $pstr=$class->{parent_str};
    $pstr=~s/<[^>]*>//g;
    foreach (split(",",$pstr)) {
      $access="private";
      $access=$1 if ( s/^\s*((public)|(private)|(protected))\s+// );
      $access.=$1 if ( s/^\s*(virtual\s)// );
      if ( /^\s*(\S+)\s*$/) {
        $pname=$1;
        if ($pname =~ /::/)
	{
	  $parent=Object::find($pname);
	}
        else
	{
	  $parent=$class->{space}->lookdown($pname);
	}
	$parent=$::unknown->lookup($pname) if (!$parent);
	$parent=Class::new($::unknown,$pname,"","class") if (!$parent);
	if ($parent)
	{
	  my $parents=$class->{parents};
	  push(@$parents,$parent);
	  my $children=$parent->{children};
	  push(@$children,$class);
	}
      }
      else {
        print "can't parse $_\n";
      
      }
    }
  }
  foreach (spaces $space) {
    crossRef($_);
  }
}

##################################################  
### crossArgs
#
# This establishs the html args with syntax highlighting
#
# This uses a dumb, dumb heristic to do the dirty work, needs fixing
#
sub crossArgs {
  my $global=shift;
  my $intrensic=::buildRE(@Html::intrensics);
  my $specifier=::buildRE(@Html::specifiers);
  my $item;

  foreach $item ($global->all) {
    next if (!$item->is_function()&&!$item->is_variable());

    # handle return type
    my $ret;
    foreach (split(/([^A-z0-9:])/,$$item{type})) {
      next if ($_ eq "");
      if ($_ !~ /^[A-z0-9_:]+$/) {
        $ret.=$_;
      }
      elsif ($_ =~ /${intrensic}/) {
        $ret.="${Html::INTRENSIC}$_${Html::INTRENSIC_}";
      }
      elsif ($_ =~ /${specifier}/) {
        $ret.="${Html::SPECIFIER}$_${Html::SPECIFIER_}";
      }
      else {
        my $i;
        $i=$item->lookdown($_);

        if ($i) {
          $ret.=$i->href(); 
        }
        else {
          $ret.="${Html::TYPE}$_${Html::TYPE_}";
        }
      }
    }
    $item->{html_type}=$ret;

    next if (!$item->is_function());
    my $args;
    my $drinks=0;
    foreach (split(/([^A-z0-9:])/,$$item{args})) {
      next if ($_ eq "");

      # we use a drinking game style guesser.
      $drinks=0 if ($_ =~ /[,)<]/);
      $drinks=-100 if ($_ =~ /[=]/);

      if ($_ !~ /^[A-z_0-9:]+$/) {
        $args.=$_;
        next;
      }
      elsif ($_ =~ /${intrensic}/) {
        $args.="${Html::INTRENSIC}$_${Html::INTRENSIC_}";
      }
      elsif ($_ =~ /${specifier}/) {
        $args.="${Html::SPECIFIER}$_${Html::SPECIFIER_}";
        next;
      } 
      elsif ($drinks < 0) {
        $args.=$_;
        next;
      }
      elsif ($drinks == 0 || $_ =~ /::/ ) {
        my $i;
        $i=$item->lookdown($_);
        
        if ($i) {
          $args.=$i->href(); 
        } 
        else {
          $args.="${Html::TYPE}$_${Html::TYPE_}";
        }
      }
      elsif ($drinks > 0) {
        $args.="${Html::VARIABLE}$_${Html::VARIABLE_}";
      }
      else {
        $args.=$_;
      }

      # take a drink
      $drinks++;
    }
    $item->{html_args}=$args;
  }
}

##################################################  
### markup
#
# Markup the comments must happen after the crossRef
#
sub markup {
  my $global=shift;
  my $item;

  foreach $item ($global->all) {
    $$item{short}=Plugin::exec("desc",$$item{short},$item) if ($$item{short});
    $$item{long}=Plugin::exec("desc",$$item{long},$item) if ($$item{long});
  }
}

package main;

sub to_xml {
  my $str=join("",@_);
  $str=~s/&/&amp;/g;
  $str=~s/</&lt;/g;
  $str=~s/>/&gt;/g;
  $str=~s/\'/&\#39;/g;
  $str=~s/\"/&\#34;/g;
  $str;
}

#######################################################################
#### 2.0 Plugin
#######################################################################
#
# Plugins represent mini perl files that can get pulled in to enhance
# the capablities of pce2.  At minumum, you will need to define one
# plugin to dump our extracted information.
#
# All plugin's must have a subroutine called plugin without a package.
# they can have their own package at their option to protect their
# varables.  By default, they are loaded into the namespace Plugin.
# You should take care to avoid the following globals located in that
# namespace.
#
#  GLOBALS:
#    %has_
#    @directory_
#    &has
#    &load
#    &exec
#

package main;

# stub to call Plugin::exec from the main space.
sub PLUGIN {
  return Plugin::exec(@_);
}

package Plugin;
BEGIN { @Plugin::ISA=qw(main); }

BEGIN {
  %Plugin::has_;
  push(@Plugin::directory_,".");
  push(@Plugin::directory_,"./plugins");
}

sub hash_ {
  my $file=shift;
  $file=~s/\.plg$//;
  $file=~tr/\/./__/;
  return $file;
  
}

sub has {
  my $name=shift;
  return ($Plugin::has_{$name});
}

sub load {
  my $plugin=shift;
  my $hash=&hash_($plugin);
  my $buffer;
  my $line;
  if (!has($plugin)) {
    $Plugin::has_{$plugin}=1;
    foreach (@Plugin::directory_) {
      if ( -e "$_/$plugin.plg" ) {
        open(FILE,"<$_/$plugin.plg");
        while ($line=<FILE>) {
          $line=~s/sub +plugin/sub plugin_$hash/;
          $buffer.=$line;
        }
        close(FILE);
        eval($buffer);
	return 1;
      }
    }

    # if it isn't found, fake it.
    print STDERR "warning: can't find plugin $plugin, using default\n" 
      if ($::debug);
    eval("sub plugin_$hash {return shift;}");
    return 1;
  }
  return 0;
}

sub exec {

  my $plugin=shift;
  my $hash=hash_($plugin);

#  print STDERR "PLUGIN $plugin\n" if ($::debug);
  load($plugin) if (!has($plugin));

  eval("return &plugin_$hash(\@_);");
}

##################################################  
### Reporting globals
sub byname { $a->{name} cmp $b->{name}; }
sub byfullname { $a->{fullname} cmp $b->{fullname}; }

sub alter {
  my $self=shift;
  my $str=shift;
  $str=~s/\${/\$\$self{/g;
  $str=~s/\\n/\n/g;
  $str=~s/"/\\"/g;
  eval("\$str=\"$str\";");
  $str;
}


#######################################################################
##### 3.0 Tree
#######################################################################
#
# These Perl objects represent the extracted information
# taken from the C++ header.  
# 
# In here your will find the various reporting functions, you will
# use to dump the extracted information
#

package main;

sub buildHash { my %hash; foreach (@_) {$hash{$_}=$_;} %hash; }

sub buildRE   { 
  my $str='^(('; 
  $str.=join(')|(',@_); 
  $str.="))\$";		# Use double quotes for emacs syntax highlighting
  return $str;
}


##################################################  
### Object
package Object;
use strict;
BEGIN { @Namespace::ISA=qw(main); }

BEGIN { $Object::refnum=1;}
#
# $name   - name in the class
# $space  - namespace/class/struct/union that contains this object
# $access - type of access in that space
# $ntype  - numerical type number
# @items  - things contained in this space
# %items_hash  - things contained in this space
# $refnum - unique number used for referencing
#
# $html_name - name using syntax highlighting
#

sub new($$$) {
  my ($space_,$name_,$comments_)=@_;
  my ($plugin);
  my $self={};
  bless $self;
  $self->{name}=$name_;
  $self->{html_name}=$name_;
  $self->{comments}=$comments_;
  $self->{space}=$space_;
  $self->{ntype}=$Enum::NONE;
  $self->{access}=$Enum::PUBLIC;
  $self->{items}=[];
  $self->{items_hash}={};
  $self->{file}=$::currentfile;
  $self->{fileprefix}=$::currentfileprefix;
  $self->{refnum}=$Object::refnum++;
  $self->{fullname}=$self->make_fullname();
  $self->{member_access}=$Enum::PUBLIC;
  my ($short,$long,@plugins) = &Extract::procComments($comments_);

  $self->{short}=$short; # Plugin::exec("desc",$short,$self);
  $self->{long}=$long; # Plugin::exec("desc",$long,$self);
  $self->Object::add_plugins(@plugins);
  $space_->Object::add($self) if ($space_);

  print STDERR "DEBUG: Created: $name_: $space_ - $short - $long\n";
  return $self;
}

# (internal) used to generate fullname
sub make_fullname {
  my $self=shift;
  my $name_;
  if ($self->{space}) {
    $name_=$self->{space}->get_pathname() ;
  }
  else {
    return "global";
  }
  $name_.=$self->{name};
}

sub get_pathname {
  my $self=shift;
  my $name_;
  if ($self->{space}) {
    $name_=$self->{space}->get_pathname() ;
  }
  $name_.="$self->{name}::" if ($self->{name});
  $name_;
}

sub dump_xml {
  my ($self,$sp) = @_;
  my $sp1="$sp  " if ($::ws_verbose);
  my $nl="\n" if ($::ws_verbose);
  printf "$sp<%s name='%s'>$nl", $self->type_name(), &::to_xml($self->name());
  $self->dump_xml_($sp1,$nl);
  printf "$sp</%s>$nl", $self->type_name();
}

sub dump_xml_ {
  my ($self,$sp,$nl) = @_;

  # Access level
  printf "$sp<%s/>$nl", $self->access_name();
  # Comments
  printf "$sp<description>%s</description>$nl", &::to_xml($self->{short}) if $self->{short};
  printf "$sp<comments>%s</comments>$nl", &::to_xml($self->{long}) if $self->{long};
  # File
  printf "$sp<sourcefile>%s</sourcefile>$nl", &::to_xml($self->{file});

  # Parent objects
  my $parents = $self->{parents};
  if ($parents && @$parents) {
    print "$sp<parents>$nl";
    foreach (@$parents) {
      printf "$sp<parent>%s</parent>$nl", &::to_xml($_->{name});
    }
    print "$sp</parents>$nl";
  }

  # Process sub-items
  my $items = $self->{items};
  if ($items && @$items) {
    foreach (@$items) {
      $_->dump_xml($sp);
    }
  }  
}


sub add {
  my $self=shift;
  my $child=shift;
  my $items=$self->{items};
  my $items_hash=$self->{items_hash};
  push(@$items,$child);
  $$items_hash{$child->{name}}=$child;
  $child->{access}=$self->{member_access};
}

sub add_plugins {
    my $self=shift;
    my ($plugin);
    foreach $plugin (@_)
    {
	$plugin =~ /^\s*([^:]*):\s*(.*)$/;
	my ($key, $data) =("plugin_$1", "$2");
	if (!defined($self->{$key}))
	{
	    $self->{$key}=[];
	}
	my ($plugin_hash) = $self->{$key};
	push(@$plugin_hash, $data);
    }
}

sub get_by_type {
  my $self=shift;
  my %hash=&::buildHash(@_);
  my $wild=!(@_);
  my $items=$self->{items};
  my @group;
  foreach (@$items) {
    push(@group,$_) if ($hash{$_->{ntype}} || $wild);
  } 
  return @group;
}

sub get_by_access {
  my $self=shift;
  my %hash=&::buildHash(@_);
  my $items=$self->{items};
  my @group;
  foreach (@$items) {
    push(@group,$_) if ($hash{$_->{access}} || !@_);
  } 
  return @group;
}

sub get_plugin_data {
  my $self=shift;
  my ($plugin)=shift;
  my ($key) = "plugin_$plugin";
  my @group;
  return @group if (!defined($self->{$key}));

  my ($plugin_ref) = $self->{$key};
  return @$plugin_ref;
}

sub all {
  my $space=shift;
  my @l;
  foreach ($space->items()) {
    push(@l,$_);
    push(@l,all($_)) if ($_->{ntype}==$Enum::NAMESPACE);
    push(@l,all($_)) if ($_->{ntype}==$Enum::CLASS);
    push(@l,all($_)) if ($_->{ntype}==$Enum::STRUCT);
    push(@l,all($_)) if ($_->{ntype}==$Enum::UNION);
    }
  return @l;
}

sub compare_args
{
    my ($left, $right) = @_;

    $left =~ s/^\s+$//g;
    $right =~ s/^\s+$//g;

    my (@args_left) = split(/,/, $left);
    my (@args_right) = split(/,/, $right);

    print STDERR "DEBUG: Left: @args_left Right: @args_right\n";

    if ($#args_left < 0)
    {
	push @args_left, "void";
    }
    if ($#args_right < 0)
    {
	push @args_right, "void";
    }
    if ($#args_left != $#args_right)
    {
	return 0;
    }
    

    foreach (@args_left)
    {
	my ($left_arg) = $_;
	my ($right_arg) = shift @args_right;
	$left_arg =~ s/=.*$//;          # Remove default values
	$right_arg =~ s/=.*$//;         # Remove default values
	$left_arg =~ s/(^\s+|\s+$)//g;  # Remove leading/trailing spaces
	$right_arg =~ s/(^\s+|\s+$)//g; # Remove leading/trailing spaces
	$left_arg =~ s/\s*(([&\*]+)\s+)/$2/g;
	$right_arg =~ s/\s*(([&\*]+)\s+)/$2/g;
	$left_arg =~ s/([&\*]+)/$1 /;
	$right_arg =~ s/([&\*]+)/$1 /;
	$left_arg =~ s/<\s+/</g;  # Remove spaces from template decl
	$right_arg =~ s/<\s+/</g; # Remove spaces from template decl
	$left_arg =~ s/\s+>/>/g;  # Remove spaces from template decl
	$right_arg =~ s/\s+>/>/g; # Remove spaces from template decl
	my (@left_arg_parts) = split /\s+/, $left_arg;
	my (@right_arg_parts) = split /\s+/, $right_arg;
	
	print STDERR "DEBUG: Left: $left_arg Right: $right_arg\n";

	$left_arg = shift(@left_arg_parts); # . " " . shift(@left_arg_parts);
        $left_arg .= " " . shift(@left_arg_parts) if $left_arg =~ /const/;
	$right_arg = shift(@right_arg_parts); # . " " . shift(@right_arg_parts);
        $right_arg .= " " . shift(@right_arg_parts) if $right_arg =~ /const/;

	print STDERR "DEBUG: Left: $left_arg Right: $right_arg\n";
	if ($left_arg ne $right_arg)
	{
	    return 0;
	}
    }
    return 1;
}

sub compare_type
{
    my ($left, $right) = @_;

    $left =~ s/^\s*($::Regex{storage_class_specifier}|$::Regex{function_specifier}\s*)*//g;
    $right =~ s/^\s*($::Regex{storage_class_specifier}|$::Regex{function_specifier}\s*)*//g;
    return $left eq $right;
}

#places an html reference
sub href {
  my $self=shift;
  my $str=shift;
  my $r;
  my $s;
  my $filename;
  $str=$$self{html_name} if (!$str);
  return $str if (!$self->is_known());
  $r="<a href=\"";
  if ($self->{ntype}==$Enum::CLASS ||
         $self->{ntype}==$Enum::STRUCT ||
         $self->{ntype}==$Enum::NAMESPACE ||
         $self->{ntype}==$Enum::UNION) {
      $filename = $self->{fullname};
      $filename =~ s/[\:\<\>\|]/_/g;
    $r.=$filename;
    $r.=".html";
  }
  else {
    $s=$self->{space};
    $filename = $s->{fullname};
    $filename =~ s/[\:\<\>\|]/_/g;
    $r.=$filename;
    $r.=".html#";
    $r.=$self->{refnum};
  }
  $r.="\">";
  $r=~s/\:/%3A/g;
  $r.=$str;
  $r.="</a>";
}

sub full_href {
  my $self=shift;
  my $out=$self->href();
  my $str;
  my $space=$self->{space};
  while ($space!=$::global) {
    $str=$space->href();
    $str.="::$out";
    $out=$str;
    $space=$space->{space};
  }
  $out="<tt>$out</tt>";
  return $out;
}


# searchs by name in the child array
sub lookup {
  my $self=shift;
  my $name=shift;
  my $items=$self->{items_hash};
  $name=~s/^:://;
  if ($name =~ /::/) {
    foreach (split(/::/,$name)) {
      $self=$self->lookup($_);
      if (!$self) {return "";}
    }
    return $self;
  }
  return $$items{$name};
}

# search from this level for a matching function
sub lookup_function {
    my $self = shift;
    my ($name, $const, $type, $args) = @_;
    
    foreach ($self->functions())
    {
	if (($_->{name} eq $name)
	    && ($_->{const} == $const)
	    # && (&compare_type($_->{type},$type))
	    && (&compare_args($_->{args},$args)))
	{
	    return $_;
	}
    }
    return "";
}

# search from this level back to root space for a name
sub lookdown {
  my $self=shift;
  my $name=shift;
  my $parent=$self->{space};
  my $items=$self->{items_hash};
  if ($name =~/::/)
    {
     $name=~s/^:://;
     my @path=split(/::/,$name,2);
     my $place=$self->lookdown(shift(@path));
     return "" if (!$place);
     return $place->lookup(shift(@path));
    }
  return $$items{$name} if ($$items{$name});
  return $parent->lookdown($name) if ($parent);
  return "";
}

# lookup using full path name
sub find {
  my $name=shift;
  my $space=$::global;
  return $space->lookup($_);
}

#######################
# Utility functions for reporting

sub type_name { my $self=shift; $Enum::TYPE_NAMES[$self->{ntype}];}
sub access_name { my $self=shift; $Enum::ACCESS_NAMES[$self->{access}];}

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

sub children   { my $self=shift; my $children=$self->{children}; return @$children; }
sub parents    { 
  my $self=shift; 
  my $parents=$self->{parents}; 
  return @$parents; 
}

sub known_parents { 
  my $self=shift; 
  my @parents;
  foreach ($self->parents()) {
    push (@parents,$_) if $_->is_known();
  } 
  return @parents; 
}

sub items      { return get_by_type(shift); }
sub spaces     { my $self=shift; return $self->get_by_type($Enum::NAMESPACE,$Enum::CLASS,$Enum::STRUCT,$Enum::UNION); }

sub classes    { my $self=shift; return $self->get_by_type($Enum::CLASS,$Enum::STRUCT); }
sub unions     { my $self=shift; return $self->get_by_type($Enum::UNION); }
sub namespaces { my $self=shift; return $self->get_by_type($Enum::NAMESPACE); }
sub friends    { my $self=shift; return $self->get_by_type($Enum::FRIEND); }
sub variables  { my $self=shift; return $self->get_by_type($Enum::VARIABLE); }
sub functions  { my $self=shift; return $self->get_by_type($Enum::FUNCTION); }
sub typedefs   { my $self=shift; return $self->get_by_type($Enum::TYPEDEF); }
sub macros     { my $self=shift; return $self->get_by_type($Enum::MACRO); }

sub public     { my $self=shift; return $self->get_by_access($Enum::PUBLIC); } 
sub private    { my $self=shift; return $self->get_by_access($Enum::PRIVATE); } 
sub protected  { my $self=shift; return $self->get_by_access($Enum::PROTECTED); } 
sub plugin  { my $self=shift; return $self->get_plugin(shift); } 

sub is_known   { my $self=shift; return $self->{space}!=$::unknown; }
sub is_class   { 
  my $self=shift; 
  return $self->{ntype}==$Enum::CLASS || $self->{ntype}==$Enum::STRUCT; 
}

sub is_namespace { my $self=shift; return $self->{ntype}==$Enum::NAMESPACE; }
sub is_union     { my $self=shift; return $self->{ntype}==$Enum::UNION; }
sub is_variable  { my $self=shift; return $self->{ntype}==$Enum::VARIABLE; }
sub is_function  { my $self=shift; return $self->{ntype}==$Enum::FUNCTION; }
sub is_typedef   { my $self=shift; return $self->{ntype}==$Enum::TYPEDEF; }
sub is_friend    { my $self=shift; return $self->{ntype}==$Enum::FRIEND; }
# sub is_template {}

##################################################  
### Namespace
package Namespace;
use strict;
BEGIN { @Namespace::ISA=qw(Object); }

sub new($$$) {
  my ($space_,$name_,$comments_)=@_;
  my $other;
  $other=$space_->lookup($name_) if ($space_);
  return $other if ($other);
  my $self=Object::new($space_,$name_,$comments_);
  $self->{ntype}=$Enum::NAMESPACE;
  $self->{html_name}="${Html::NAMESPACE}$name_${Html::NAMESPACE_}";
  bless $self;
}

##################################################  
### Class
#
# $parent_str        -  raw parent data
# @parents           -  referenced parent list 
# @children          -  referenced child list
#
package Class;
use strict;
BEGIN {
  @Class::ISA=qw(Object);
}

sub new {
  my ($space_,$name_,$comments_,$typename,$pstr,$template_args)=@_;
  my $self=Object::new($space_,$name_,$comments_);

  $self->{ntype}=$Enum::CLASS if ($typename eq "class");
  $self->{ntype}=$Enum::STRUCT if ($typename eq "struct");
  $self->{ntype}=$Enum::UNION if ($typename eq "union");

  $self->{html_name}="${Html::CLASS}$name_${Html::CLASS_}";

  $self->{member_access}=$Enum::PUBLIC ;
  $self->{member_access}=$Enum::PRIVATE if ($typename eq "class");

  $self->{parents}=[];
  $self->{children}=[];

  $self->{parent_str}=$pstr;
  if ($template_args ne "")
  {
      $self->{template_args} = $template_args;
  }

  print STDERR "DEBUG: Adding $name_";
  print STDERR " to $space_->{fullname}" if ($space_);
  print STDERR "\n";
  bless $self;
}

sub set_public    { my $self=shift; $self->{member_access}=$Enum::PUBLIC ; }
sub set_private   { my $self=shift; $self->{member_access}=$Enum::PRIVATE ; }
sub set_protected { my $self=shift; $self->{member_access}=$Enum::PROTECTED ; }


##################################################  
### Function
package Function;
use strict;
BEGIN {
  @Function::ISA=qw(Object);
}

sub new {
  my ($space_,$name_,$comments_,$type_,$args_,$throw_)=@_;
  my $self=Object::new($space_,$name_,$comments_);

  $type_=" $type_ ";
  $type_=~s/^\s(explicit)\s/ /; $self->{explicit}=1 if ($1 eq "explicit");
  $type_=~s/^\s(virtual)\s/ /;  $self->{virtual}=1 if ($1 eq "virtual");
  $type_=~s/^\s(static)\s/ /;  $self->{static}=1 if ($1 eq "static");
  $type_=~s/^\s(inline)\s/ /;   $self->{inline}=1 if ($1 eq "inline");
  $type_=~s/^\s+//;
  $type_=~s/\s+$//;

  $args_=~s/\,/, /g;
  $args_=~s/\s+/ /g;
  $args_=~s/^\s+//;
  $args_=~s/\s+$//;

  $self->{ntype}=$Enum::FUNCTION;

  $self->{type}=$type_;
  $self->{html_type}=$type_;

  $self->{args}=$args_;
  $self->{html_args}=$args_;
  if ($throw_ ne "")
  {
      $self->{throw}=$throw_;
      $self->{html_throw}=::to_xml($throw_);
  }

  if ($name_ =~/^operator\s(.*)$/) {
    $self->{html_name}="${Html::KEYWORD}operator${Html::KEYWORD_}<tt> ";
    $self->{html_name}.=::to_xml($1);
    $self->{html_name}.="</tt>";
  }
  else {
    $self->{html_name}="${Html::FUNCTION}${name_}${Html::FUNCTION_}";
  }

  bless $self;
}

sub decl {
  my $self=shift;
  my $ret;
  my $args;
  $ret.="inline " if $$self{inline};
  $ret.="explicit " if $$self{explicit};
  $ret.="virtual " if $$self{virtual};
  $ret.="static " if $$self{static};
  $ret.=$$self{type};
  $ret.=" ";
  $args="(";
  $args=$$self{args};
  $args=")";
  $args.=" const" if $$self{const};
  return ($ret,$$self{name},$$self{args});
}

sub html_decl {
  my $self=shift;
  my $ret;
  my $name;
  my $args;
  $ret="<tt>";
  $ret.="${Html::SPECIFIER}inline${Html::SPECIFIER_} " if $$self{inline};
  $ret.="${Html::SPECIFIER}explicit${Html::SPECIFIER_} " if $$self{explicit};
  $ret.="${Html::SPECIFIER}virtual${Html::SPECIFIER_} " if $$self{virtual};
  $ret.="${Html::SPECIFIER}static${Html::SPECIFIER_} " if $$self{static};
  $ret.=$$self{html_type};
  $ret.="</tt> ";
  $name.=$self->href(); #&Plugin::href($self,$$self{html_name});
  $args="<tt>(";
  $args.=$$self{html_args};
  $args.=")";
  $args.=" ${Html::SPECIFIER}const${Html::SPECIFIER_}" if $$self{const};
  $args.=" throw ($$self{html_throw})" if $$self{html_throw};
  $args.="</tt>;";
  return ($ret,$name,$args);
}

sub dump_xml_ {
  my ($self,$sp,$nl) = @_;
  Object::dump_xml_($self,$sp,$nl);  
  print "$sp<ctor/>$nl"     if $self->is_ctor();
  print "$sp<dtor/>$nl"     if $self->is_dtor();
  print "$sp<const/>$nl"    if $self->{const};
  print "$sp<explicit/>$nl" if $self->{explicit};
  print "$sp<virtual/>$nl"  if $self->{virtual};
  print "$sp<static/>$nl"   if $self->{static};
  printf "$sp<returntype>%s</returntype>$nl", &::to_xml($self->{type});
  printf "$sp<args>%s</args>$nl", &::to_xml($self->{args});  
}

sub is_ctor {
  my ($self)=@_;
  return !$$self{type};
}

sub is_dtor {
  my ($self)=@_;
  return $$self{name}=~/^~/;
}

sub update {
    my ($env, $name, $comments, $type, $args, $throw, $const, $namespace) = @_;
    my ($const_bool) = ($const eq "const");
    my ($origional_env) = $env;
    
    $namespace =~ s/::$//;
    $env = $env->Object::lookup($namespace) if ($namespace ne "");
    if ($env eq "")
    {
	$env = &Object::find($namespace);
	if ($env eq "")
	{
	    print STDERR "ERROR: Unable to get namespace: $namespace\n";
	    return "";
	}
    }

    my $function = $env->Object::lookup_function($name,$const_bool,$type,$args);

    if ($function eq "")
    {
	$function = &new($env,$name,$comments,$type,$args,$throw);
	$function->{const}=1 if ($const eq "const");
    }
    else
    {
	my ($short, $long, @plugins) = &Extract::procComments($comments);
	$function->{short} = $short if ($short ne "");
	$function->{long} = $long if ($long ne "");
	$function->Object::add_plugins(@plugins);

	print STDERR "DEBUG: Modify Function: $name: $env - $short - $long\n";
    }

    $type =" $type ";
    $type =~s/^\s(explicit)\s/ /; $function->{explicit}=1 if ($1 eq "explicit");
    $type =~s/^\s(virtual)\s/ /;  $function->{virtual}=1 if ($1 eq "virtual");
    $type =~s/^\s(static)\s/ /;  $function->{static}=1 if ($1 eq "static");
    $type =~s/^\s(inline)\s/ /;   $function->{inline}=1 if ($1 eq "inline");
    $type =~s/^\s+//;
    $type =~s/\s+$//;

    return $function;
}

##################################################  
### Variable
package Variable;
use strict;
BEGIN {
  @Variable::ISA=qw(Object);
}

sub new {
  my ($space_,$name_,$comments_,$type_)=@_;
  my $self=Object::new($space_,$name_,$comments_);

  $self->{ntype}=$Enum::VARIABLE;
  $self->{type}=$type_;
  $self->{html_name}="${Html::VARIABLE}$name_${Html::VARIABLE_}";

  bless $self;
}

sub html_decl {
  my $self=shift;
  my $ret;
  my $name;
  $ret="<tt>";
  $ret.=$$self{html_type};
  $ret.="</tt> ";
  $name.="<tt>";
  $name.=$self->href();
  $name.=";</tt>";
  ($ret,$name);
}

sub dump_xml_ {
  my ($self,$sp,$nl) = @_;
  Object::dump_xml_($self,$sp,$nl);
  printf "$sp<type>%s</type>$nl", &::to_xml($self->{type});
}

sub update {
    my ($env, $name, $comments, $type, $namespace) = @_;
    my $variable = Object::find("$namespace\:\:$name");

    if ($variable eq "")
    {
	$env = $env->Object::lookup("$namespace") if ($namespace ne "");
	print STDERR "DEBUG: update: namespace: $env->{fullname}\n";
	$variable = &new($env,$name,$comments,$type);
    }
    else
    {
	my ($short, $long, @plugins) = &Extract::procComments($comments);
	$variable->{short} = $short if ($short ne "");
	$variable->{long} = $long if ($long ne "");
	$variable->Object::add_plugins(@plugins);
	$variable;
    }
    return $variable;
}

##################################################  
### Typedef
package Typedef;
use strict;
BEGIN {
  @Typedef::ISA=qw(Object);
}

sub new {
  my ($space_,$name_,$comments_)=@_;
  my $other;
  $other=$space_->lookup($name_) if ($space_);
  return $other if ($other);

  my $self=Object::new($space_,$name_,$comments_);
  $self->{ntype}=$Enum::TYPEDEF;

  bless $self;
}

##################################################  
### Friend
package Friend;
use strict;
BEGIN {
  @Friend::ISA=qw(Object);
}

sub new {
  my ($space_,$name_,$comments_)=@_;
  my $self=Object::new($space_,$name_,$comments_);

  $self->{ntype}=$Enum::FRIEND;

  bless $self;
}

