Regular Expressions

Real World Example (4)

Solution Perl Script

#!/serve/bin/perl5.00502 -w

use strict;

my (%methodHash, $token, $nextLine, $profSource, @profEntries);
my ($candidateSource);

unless (@ARGV == 2) {
    die "Usage:  reportprof candidatemethodsfile profoutput\n";
}

$candidateSource = $ARGV[0];
$profSource = $ARGV[1];

print "Correlation report for $candidateSource methods in $profSource\n";
print '='x78;
print "\n";

# First load up the list of candidate methods
open ( CANDIDATES, "$candidateSource") || 
    die "Could not open $candidateSource ($!).  Aborting";

# Now load up a hash with these methods (hash saves us the hassle of
# looping later to see if a method exists).
while ( $nextLine = <CANDIDATES> ) {
    chomp $nextLine;
    if ( ( $token = extractMethods( $nextLine ) ) ){
        $methodHash{$token} = 1;  # Just flag exists...
    }
}

close(CANDIDATES);

# Now open the prof results file ( made with prof -C )

open ( PROFRESULTS, "$profSource" ) || 
    die "Could not launch the prof process ($!)";

# Now parse each line of the prof output, and report
# lines that correlate to our candidate list.

$nextLine = <PROFRESULTS>;  # Get header line
print "$nextLine";

while ( $nextLine = <PROFRESULTS> ) {
    chomp $nextLine;
    
    # Split the line into fields
    @profEntries = split ( ' ', $nextLine );

    # Look if the method is in our reference hash
    if ( defined($profEntries[5]) ) {
        $token = $profEntries[5];
        $token = extractMethods($token);
        if ( defined ( $methodHash{$token} ) ) {
            print "$nextLine\n";
        }
    }

}

close( PROFRESULTS ); 
print "\n\n";

#########################
### Support Functions ###
#########################


# Simple function to extract a method from a given line if possible
sub extractMethods {
    my ($parseLine, $result);

    $result = "";

    $parseLine = $_[0];

    # Case 1:  Look for...
    #   0 or more anythings
    #   followed by 1 or more whitespace
    #   followed by any number of word characters (extract this)
    #   followed by "::" (extract this)
    #   followed by any number of word characters (extract this)
    #   followed by anything
    # This should catch stuff of the form "void blah::blah(yadda, yadda..."

    if ($parseLine =~ s/.*\W+(\w+::\w+).*/$1/ ) {
        $result = $parseLine;
    } 

    # Case 2:  Look for...
    #   0 or more whitespace
    #   0 or 1 "~" characters (handle destructor)
    #   followed by word chars (extract this)
    #   followed by "::" (extract this)
    #   followed by word chars (extract this)
    #   followed by non word characters
    #   followed by anything
    # This should catch stuff of the form "blah::blah(yadda, yadda"
    # This should catch stuff of the form "blah::~blah(yadda, yadda"
    
    elsif ($parseLine =~ s/\W*(\w+::~?\w+)\W*.*/$1/ ) {
        $result = $parseLine;
    }
    
    return $result;
}