Sophie

Sophie

distrib > Fedora > 15 > i386 > by-pkgid > e67ff766e6ce3cfb88a0987cf5b93cad > files > 14

examiner-0.5-7.fc15.noarch.rpm

#!/usr/bin/perl
# Makes a function hierarchy from output from the Examiner

use strict;
use vars qw(%functions $COMMENT $depth $VERSION @parents $verbose);
use Getopt::Std;

my $VERSION="0.1";		# Version info
my $COMMENT="#";		# Default comment char
my $depth=8;			# Max DEPTH Default
my $file;			# Target file
my $line;			# Generic var
my $args;			# Arguments passed to functions
my $level;			# Current depth level
my $current;			# Current function
my $start_funct;		# Starting function
my $call;			# Function call
my $verbose;			# Verbosity level
my %options;			# Command line options

getopts("vc:d:f:",\%options) || usage();

if ($options{"c"}) { $COMMENT=$options{"c"}; }
if ($options{"d"}) { $depth=$options{"d"}; }
if ($options{"f"}) { $file=$options{"f"}; }
if ($options{"v"}) { $verbose++; }

usage() if !$file;

open OBJFILE, $file || die " Couldn't open $file:$!\n";
print "$COMMENT$COMMENT\n";
print "$COMMENT$COMMENT Hierarchy of $file\n";
print "$COMMENT$COMMENT\n";
while(<OBJFILE>) {
   	$line=$_;
	if ($line=~/Disassembly of section \.text/) {
		$current=".TEXT_FUNCT";
		$start_funct="1";
	}
   	if($line=~/$COMMENT \[(.*)\]/) {
		$current=$1;
		$start_funct=$current if $start_funct eq "1";
	} elsif($line=~/$COMMENT CALL (.*)/) {
		next if !$current;
		$start_funct = $current if !$start_funct;
		$call=$1;
		if($call=~/(\S*)\((.*)\)/) {
			$call=$1;
			$args=$2;
		}
		$args="($args)";
		# Pushes both the CALLS and ARGS to the hashref
		push @{ $functions{$current} }, $call, $args;
		
		# Speical rules for LIBC_START_MAIN
		if($call eq "__LIBC_START_MAIN_FUNCT") {
			push @{ $functions{$current} }, "_START_MAIN_FUNCT", "()";
		}
	}
}
close OBJFILE;

$level=0;
print "$start_funct\n";
print_funct($level, $start_funct);

exit(0);
#### SUBS ###

# Recursive function to print out funcion calls
sub print_funct {
  my $level=shift;
  my $funct=shift;
  my $call;
  my $args;
  my $total_calls= $#{ $functions{$funct} };
  my $count;
  return if !$functions{$funct};

  push @parents, $funct;
  for($count=0; $count <= $total_calls; $count+=2) {
  	$call=@{ $functions{$funct} }[$count];
	$args=@{ $functions{$funct} }[$count+1];
	print "|" x $level;
	print "+ ";
	if (is_parent($call, @parents))  {
		print "$call";
		print "$args" if $verbose;
		print "<- Recursive call\n";
	} elsif ($level > $depth) {
		print "$call";
		print "$args" if $verbose;
		print "...\n";
	} else {
		print "$call";
		print "$args" if $verbose;
		print "\n";
		print_funct($level+1, $call);
	}
  }
  pop @parents;
}

# Check array for a value
sub is_parent {
   my $call=shift;
   my @parents = @_;
   my $parent;
   foreach $parent (@parents) {
	return 1 if $parent eq $call;
   }
   return 0;
}

# Usage: statement
sub usage {
   print "$0 v$VERSION\n";
   print "$0 [Options] -f commented_file\n";
   print "Prints function hierarchy of commented files generated by the Examiner\n";
   print "\n";
   print "\tOptions\tDescription\n";
   print "\t-v\tIncrease verbosity (enables arguement printing)\n";
   print "\t-d #\tDepth to traverse functions (Default: $depth)\n";
   print "\t-c char\tComment char (Default: '$COMMENT')\n";
   print "\t-f file\tCommented file to parse\n";
   exit(1);
}