view release on metacpan or  search on metacpan

examples/app_doxy.pl  view on Meta::CPAN

			else
			{
				# undefined @ISA - try to use the last 'use'
				if ($info{'use'})
				{
					$info{'isa'} = $info{'use'}->[scalar(@{$info{'use'}})-1] ;
					
				}
			}
			print "ISA = $info{'isa'}\n" if $opts{debug};
		}
		
		# Use
		# use NetPacket::Ethernet;
		if ($line =~ /^\s*use\s+([\w+:_]+)/)
		{
			my $use = pkg_name($1, \%opts) ;
			$info{'use'} ||= [] ;
			push @{$info{'use'}}, $use ;
			print "USE = $use\n" if $opts{debug};
		}
		
		# Function definition
		# sub run
		if ($line =~ /^\s*sub\s+(\S+)/)
		{
			$info{'isa'} ||= 'UNIVERSAL' ;
			
			$fn = $1 ;
			$info{'fn_list'} ||= [] ;
			push @{$info{'fn_list'}}, $fn ;
			
			$info{'fn_details'}{$fn} = {
				'args'	=> [],
			} ;
			$info{'fn_calls'}{$fn} = [] ;

		}

		if ($fn)
		{
			# Function args
			# my () = @_ ;
			if ($line =~ /^\s*my\s*\(([^\)]*)\)\s*=\s*\@_\s*;/)
			{
				($args) = ($1) ;
print " + fn my ($args)\n" if $opts{debug} ;
				my @args = split ',', $args ;
				foreach my $arg (@args)
				{
					$arg =~ s/^\s+// ;
					$arg =~ s/\s+$// ;
					$arg =~ s/^[\\\$\@\%]+// ;
				}
print " + + args (@args)\n" if $opts{debug} ;
				$info{'fn_details'}{$fn}{'args'} = \@args ;
			}
						
			# method call
			# $this->access($options_aref) ;
			# $this->SUPER::access($options_aref) ;
			# App::Framework->access($options_aref) ;
			if ($line =~ /^[^#]*(?:\$\w+|[\w_:]+)\->(SUPER::){0,1}([^\s\(]+)\(([^\)]*)/)
			{
				($super, $call, $args) = ($1, $2, $3) ;
print " + fn call <$super>: $call($args)\n" if $opts{debug} ;

				# see if call complete
				if ($line =~ /\)\s*;/)
				{
					my @args = split ',', $args ;
					foreach my $arg (@args)
					{
						$arg =~ s/^\s+// ;
						$arg =~ s/\s+$// ;
						$arg =~ s/^[\\\$\@\%]+// ;
					}
	print " + + args (@args)\n" if $opts{debug} ;
					
					if ($super)
					{
						$call = "$info{'isa'}".":$call" ;
	print " + + call ($call)\n" if $opts{debug} ;
					}
					
					push @{$info{'fn_calls'}{$fn}}, {
						'fn'	=> $call,
						'args'	=> \@args,
					} ;
					$call = undef ;
				}
			}
		}
		
		#	my %FIELDS = (
		#		## Object Data
		#		'saved_app'	=> undef,
		#		'user'		=> 'nobody',
		#		'group'		=> 'nobody',
		#		'pid'		=> undef,
		#	) ;
		if ($line =~ /^\s*my\s+\%FIELDS\s*=\s*\(/)
		{
			++$fields ;
		}
		elsif ($fields)
		{
			if ($line =~ /^\s*['"]{0,1}([\w_]+)['"]{0,1}\s*=>\s*([^,]+),\s*/)
			{
				$info{'fields'} ||= [] ;
				push @{$info{'fields'}}, {
					'var'	=> $1,
					'val'	=> $2,
				} ;
print " + field: $1 => $2\n" if $opts{debug} ;
			}
			if ($line =~ /^\s*\)\s*;/)
			{
				$fields=0 ;
			}
			
		}
	}

examples/app_doxy.pl  view on Meta::CPAN

			{
				# undefined @ISA - try to use the last 'use'
				if ($info{'use'})
				{
					$info{'isa'} = $info{'use'}->[scalar(@{$info{'use'}})-1] ;
					
				}
			}
			print "ISA = $info{'isa'}\n" if $opts{debug};
		}

'/^\s*use\s+([\w+:_]+)/','use||=[]; push @{use}, pkg_name($1, \%opts) ;'	
	
		# Use
		# use NetPacket::Ethernet;
		if ($line =~ /^\s*use\s+([\w+:_]+)/)
		{
			my $use = pkg_name($1, \%opts) ;
			$info{'use'} ||= [] ;
			push @{$info{'use'}}, $use ;
			print "USE = $use\n" if $opts{debug};
		}
		
		# Function definition
		# sub run
		if ($line =~ /^\s*sub\s+(\S+)/)
		{
			$info{'isa'} ||= 'UNIVERSAL' ;
			
			$fn = $1 ;
			$info{'fn_list'} ||= [] ;
			push @{$info{'fn_list'}}, $fn ;
			
			$info{'fn_details'}{$fn} = {
				'args'	=> [],
			} ;
			$info{'fn_calls'}{$fn} = [] ;

		}

'fn:/^\s*my\s*\(([^\)]*)\)\s*=\s*\@_\s*;/','fn_details{$fn}{'args'} = args($1);'
		if ($fn)
		{
			# Function args
			# my () = @_ ;
			if ($line =~ /^\s*my\s*\(([^\)]*)\)\s*=\s*\@_\s*;/)
			{
				($args) = ($1) ;
print " + fn my ($args)\n" if $opts{debug} ;
				my @args = split ',', $args ;
				foreach my $arg (@args)
				{
					$arg =~ s/^\s+// ;
					$arg =~ s/\s+$// ;
					$arg =~ s/^[\\\$\@\%]+// ;
				}
print " + + args (@args)\n" if $opts{debug} ;
				$info{'fn_details'}{$fn}{'args'} = \@args ;
			}

'fn:/^[^#]*(?:\$\w+|[\w_:]+)\->(SUPER::){0,1}([^\s\(]+)\(([^\)]*)/', 'super=$1;call=$2;args=$3;', FILTER_START_IF, CALL
'/\)\s*;/', 'args=args(args);' FILTER_IF, CALL
'super:/\)\s*;/', '$call = "$isa".":$call" ;' FILTER_IF, CALL
'/\)\s*;/', '$call = "$isa".":$call" ;' FILTER_IF, CALL
						
			# method call
			# $this->access($options_aref) ;
			# $this->SUPER::access($options_aref) ;
			# App::Framework->access($options_aref) ;
			if ($line =~ /^[^#]*(?:\$\w+|[\w_:]+)\->(SUPER::){0,1}([^\s\(]+)\(([^\)]*)/)
			{
				($super, $call, $args) = ($1, $2, $3) ;
print " + fn call <$super>: $call($args)\n" if $opts{debug} ;

				# see if call complete
				if ($line =~ /\)\s*;/)
				{
					my @args = split ',', $args ;
					foreach my $arg (@args)
					{
						$arg =~ s/^\s+// ;
						$arg =~ s/\s+$// ;
						$arg =~ s/^[\\\$\@\%]+// ;
					}
	print " + + args (@args)\n" if $opts{debug} ;
					
					if ($super)
					{
						$call = "$info{'isa'}".":$call" ;
	print " + + call ($call)\n" if $opts{debug} ;
					}
					
					push @{$info{'fn_calls'}{$fn}}, {
						'fn'	=> $call,
						'args'	=> \@args,
					} ;
					$call = undef ;
				}
			}
		}
		
		#	my %FIELDS = (
		#		## Object Data
		#		'saved_app'	=> undef,
		#		'user'		=> 'nobody',
		#		'group'		=> 'nobody',
		#		'pid'		=> undef,
		#	) ;
		if ($line =~ /^\s*my\s+\%FIELDS\s*=\s*\(/)
		{
			++$fields ;
		}
		elsif ($fields)
		{
			if ($line =~ /^\s*['"]{0,1}([\w_]+)['"]{0,1}\s*=>\s*([^,]+),\s*/)
			{
				$info{'fields'} ||= [] ;
				push @{$info{'fields'}}, {
					'var'	=> $1,
					'val'	=> $2,
				} ;
print " + field: $1 => $2\n" if $opts{debug} ;
			}
			if ($line =~ /^\s*\)\s*;/)
			{
				$fields=0 ;
			}
			
		}