#!/usr/bin/perl -w
# NAME: findinlib.pl
# AIM: Uses 'Dump4' utility so is quite specialized
# Find a 'function' in a library, or set of libraries
# 01/04/2011 - Unless verbosity increased, do NOT show __real@ nor ?? items...
# It sould be nice if something could be done about name mangling or name decoration...
# from : http://en.wikipedia.org/wiki/Name_mangling
# Can be split into 2 type - that for C, and another for C++
# Simple C decoration - 3 cases
# int _cdecl    f (int x) { return 0; } - normal default so even without [_cdecl]
# int _stdcall  g (int y) { return 0; }
# int _fastcall h (int z) { return 0; }
# Decorations
# _f   # _g@4   # @h@4
# Name mangling in C++ - NO STANDARD - each compiler does its own thing ;=(( Here MSVC C++ only
# void h(int) void h(int, char) void h(void) 
# ?h@@YAXH@Z  ?h@@YAXHD@Z       ?h@@YAXXZ 
# from : http://en.wikipedia.org/wiki/Microsoft_Visual_C%2B%2B_Name_Mangling
# All mangled C++ names start with ? (question mark).
# The structure of mangled names looks like this: Prefix ? - Optional: Prefix @? - Qualified name - Type
# Qualification is written in reversed order. 
# For example myclass::nested::something becomes something@nested@myclass@@.
# Name with Template Arguments - Name fragments starting with ?$ have template arguments
# For example, we assume the following prototype.
# void __cdecl abc<def<int>,void*>::xyz(void);
# The name of this function can be obtained by the following process:
# abc<def<int>,void*>::xyz - order
# xyz@ abc<def<int>,void*> @ - order reversed
# xyz@ ?$abc@ def<int> void* @ @
# xyz@ ?$abc@ V def<int> @ PAX @ @
# xyz@ ?$abc@ V ?$def@H@ @ PAX @ @
# xyz@?$abc@V?$def@H@@PAX@@
# So the mangled name for this function is 
# ?xyz@?$abc@V?$def@H@@PAX@@YAXXZ.
# Nested Name
# For example, ?nested@??func@@YAXXZ@4HA means variable ?nested@@4HA(int nested) 
# inside ?func@@YAXXZ(void __cdecl func(void)). The UnDecorateSymbolName function returns 
# int 'void __cdecl func(void)'::nested for this input.

use strict;
use warnings;
use File::Basename;  # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] )
use Cwd;
my $perl_dir = 'C:\GTools\perl';
unshift(@INC, $perl_dir);
require 'lib_utils.pl' or die "Unable to load lib_utils.pl ...\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /(\\|\/)/) {
    my @tmpsp = split(/(\\|\/)/,$pgmname);
    $pgmname = $tmpsp[-1];
}
my $outfile = $perl_dir."\\temp.$pgmname.txt";
open_log($outfile);

# user variables
my $load_log = 0;
my $in_file = '';

my $debug_on = 0;
my $def_file = 'def_file';
my @dir_list = ();
my @file_list = ();
my $find_func = '';
my $dump_opts = '-lib:X';
my $verbosity = 0;

sub VERB1() { return ($verbosity >= 1); }
sub VERB2() { return ($verbosity >= 2); }
sub VERB5() { return ($verbosity >= 5); }
sub VERB9() { return ($verbosity >= 9); }

### program variables
my @warnings = ();
my $cwd = cwd();
my $os = $^O;
my $max_max_res = 0;
my $tot_fun_cnt = 0;
my $max_res_fil = '';

# debug
my $dbg_01 = 0; # or VERB9()
my $dbg_02 = 0; # or VERB5()
my $dbg_03 = 0; # or VERB2()
my $dbg_04 = 0;

sub show_warnings($) {
    my ($val) = @_;
    if (@warnings) {
        prt( "\nGot ".scalar @warnings." WARNINGS...\n" );
        foreach my $itm (@warnings) {
           prt("$itm\n");
        }
        prt("\n");
    } else {
        # prt( "\nNo warnings issued.\n\n" );
    }
}

sub pgm_exit($$) {
    my ($val,$msg) = @_;
    if (length($msg)) {
        $msg .= "\n" if (!($msg =~ /\n$/));
        prt($msg);
    }
    show_warnings($val);
    close_log($outfile,$load_log);
    exit($val);
}


sub prtw($) {
   my ($tx) = shift;
   $tx =~ s/\n$//;
   prt("$tx\n");
   push(@warnings,$tx);
}

sub get_dump4_array($) {
    my ($inf) = @_;
    my @arr = ();
    prt("Moment, processing 'dump4 $dump_opts $inf'...\n") if ($dbg_02 || VERB5());
	if (open (DIFF, "dump4 $dump_opts $inf |")) {
		@arr = <DIFF>;
		close DIFF;
    }
    return \@arr;
}


sub process_file_list($) {
    my ($rfl) = @_;
    my $cnt = scalar @{$rfl};
    prt("Processing $cnt files, for [$find_func]...\n");
    my ($file,$ra,$lcnt,$line,$fcnt);
    if ($dbg_04) {
        $line = '';
        foreach $file (@{$rfl}) {
            $file =~ s/^lib\\//;
            if ($file =~ /_aD\.lib/) {
                $line .= ";" if (length($line));
                $line .= $file;
            }
        }
        prt("$line\n");
    }
    $fcnt = 0;
    foreach $file (@{$rfl}) {
        $ra = get_dump4_array($file);
        $lcnt = scalar @{$ra};
        prt("Scanning $lcnt lines from Dump4 scan of [$file]...\n") if ($dbg_03 || VERB9()) ;
        foreach $line (@{$ra}) {
            chomp $line;
            if ($line =~ /$find_func/) {
                prt("Found in [$file] [$line]\n");
                $fcnt++;
                last;
            }
        }
    }
    if ($fcnt == 0) {
        prt("NO FINDS in $cnt searches for [$find_func]\n");
    } else {
        prt("Shown $fcnt finds of [$find_func]...\n");
    }
}

sub process_file_list2($) {
    my ($rfl) = @_;
    my $cnt = scalar @{$rfl};
    prt("Processing $cnt files, for [$find_func] = ALL functions...\n");
    my ($file,$ra,$lcnt,$line,$fcnt,$res,$maxres,$len,$max_fil);
    my (@list);
    foreach $file (@{$rfl}) {
        $ra = get_dump4_array($file);
        $lcnt = scalar @{$ra};
        $fcnt = 0;
        @list = ();
        $maxres = 0;
        foreach $line (@{$ra}) {
            chomp $line;
            if ($line =~ /\s+[A-F0-9]+\s+(.+)$/) {
                $res = $1;
                next if ($res =~ /^bytes, compiled/);
                next if ($res eq 'Bytes.');
                next if ($res eq 'bytes.');
                if (!VERB1()) {
                    next if ($res =~ /^\s*__real\@/);
                    next if ($res =~ /^\s*\?\?/);
                }
                $len = length($res);
                if ($len > $maxres) {
                    $maxres = $len;
                    $max_fil = $file;
                }
                push(@list,$res);
                $fcnt++;
            }
        }
        if ($fcnt == 0) {
            prt("NO functions in [$file]!\n");
        } else {
            prt("List of $fcnt functions in [$file](max=$maxres).\n");
        }
        if ($maxres > $max_max_res) {
            $max_max_res = $maxres;
            $max_res_fil = $max_fil;

        }
        $tot_fun_cnt += $fcnt;
        $fcnt = 0;
        if (VERB1()) {
            foreach $line (@list) {
                $fcnt++;
                $lcnt = sprintf("%4d",$fcnt);
                prt("$lcnt: $line\n");
            }
        } else {
            foreach $line (sort @list) {
                $fcnt++;
                $lcnt = sprintf("%4d",$fcnt);
                prt("$lcnt: $line\n");
            }
        }
    }
    prt("Listed total $tot_fun_cnt functions, from $cnt files, max len $max_max_res in $max_res_fil\n");
}


#########################################
### MAIN ###
parse_args(@ARGV);
if ($find_func eq '*') {
    process_file_list2(\@file_list);
} else {
    process_file_list(\@file_list);
}
pgm_exit(0,"Normal exit(0)");
########################################
sub give_help {
    prt("$pgmname: version 0.0.2 2011-03-28\n");
    prt("\n");
    prt("Usage: $pgmname [options] function_name in_file[s]/in_dir\n");
    prt("\n");
    prt("Options:\n");
    prt(" --help  (-h or -?) = This help, and exit 0.\n");
    prt(" --func <func> (-f) = Function to find. Search is case sensitive.\n");
    prt(" --verb[nn]    (-v) = Bump (or set [nn]) verbosity - Range 1 to 9.\n");
    prt(" --LOG         (-L) = Load log file at end in editor.\n");
    prt(" --lib <lib>   (-l) = Search this library.\n");
    prt(" <lib> Can can be a directory, when all .lib files will be searched.\n");
    prt(" or a wild card file name. That is using '*' and/or '?' chars.\n");
    prt("\n");
    prt("Purpose: To find a 'exported' function in a library, using my Dump4 to get the list.\n");
    prt(" The source (or just the Dump4 exe) can be downloaded from\n");
    prt("    http://geoffair.org/ms/dump.htm#downloads\n");
    prt("                                                    Have FUN ;=))\n");
}

sub need_arg {
    my ($arg,@av) = @_;
    pgm_exit(1,"ERROR: [$arg] must have following argument!\n") if (!@av);
}

sub got_wild($) {
    my $fil = shift;
    my ($nm,$dir) = fileparse($fil);
    return 1 if ($nm =~ /(\*|\?)/);
    return 0;
}

sub process_wild($) {
    my $wild = shift;
    my ($nm,$dir) = fileparse($wild);
    my @files = glob($wild);
    my ($file);
    my @dirs = ();
    foreach $file (@files) {
        next if (($file eq '.')||($file eq '..'));
        if (-d $file) {
            push(@dirs,$file);
        } elsif (-f $file) {
            push(@file_list,$file);
            prt("Added [$file] to file list\n") if ($dbg_01 || VERB9());
        } else {
            pgm_exit(1,"ERROR: Wild card not correctly coded wind [$wild] file [$file]!\n");
        }
    }
}

sub process_in_file($) {
    my $fil = shift;
    if (-d $fil) {
        push(@dir_list,$fil);
        prt("Added [$fil] to directory list\n");
    } elsif (got_wild($fil)) {
        process_wild($fil);
    } elsif (-f $fil) {
        push(@file_list,$fil);
        prt("Added [$fil] to file list\n") if ($dbg_01 || VERB9());
    } else {
        prt("Is NOT a directory. Is NOT a file, and does not have wild cards!\n");
        pgm_exit(1,"ERROR: ABorting in unknown entry [$fil]!\n");
    }
    return 1;
}

sub scan_dir($) {
    my $dir = shift;
    if (!opendir(DIR,$dir)) {
        pgm_exit(1,"ERROR: Unable to open directory [$dir]\n");
    }
    my @files = readdir(DIR);
    my @dirs = ();
    closedir(DIR);
    $dir .= "\\" if ( !($dir =~ /(\\|\/)$/) );
    my ($file,$ff);
    foreach $file (@files) {
        next if ($file eq '.');
        next if ($file eq '..');
        $ff = $dir.$file;
        if (-d $ff) {
            push(@dirs,$ff);
        } elsif ($file =~ /\.lib$/i) {
            process_in_file($ff);
        }
    }
}

sub parse_args {
    my (@av) = @_;
    my ($arg,$sarg,$cnt);
    $cnt = 0;
    while (@av) {
        $arg = $av[0];
        if ($arg =~ /^-/) {
            $sarg = substr($arg,1);
            $sarg = substr($sarg,1) while ($sarg =~ /^-/);
            if (($sarg =~ /^h/i)||($sarg eq '?')) {
                give_help();
                pgm_exit(0,"Help exit(0)");
            } elsif ($sarg =~ /^f/i) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $find_func = $sarg;
                prt("Set to find function [$sarg]\n");
            } elsif ($sarg =~ /^L/) {
                $load_log = 1;
                prt("Set to load log at end.\n");
            } elsif ($sarg =~ /^l/) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                process_in_file($sarg);
            } elsif ($sarg =~ /^v/i) {
                if ($sarg =~ /^v(\d+)$/) {
                    $verbosity = $1;
                    prt("Set verbosity to [$verbosity]\n");
                } else {
                    while ($sarg =~ /^v/i) {
                        $verbosity++;
                        $sarg = substr($sarg,1);
                    }
                    prt("Bumped verbosity to [$verbosity]\n");
                }
            } else {
                pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n");
            }
        } else {
            if ($cnt == 0) {
                $find_func = $arg;
                prt("Set to find function [$arg]\n");
            } elsif ($cnt == 1) {
                process_in_file($arg);
            } else {
                pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n");
            }
            $cnt++;
        }
        shift @av;
    }
    if (@dir_list) {
        prt("Expanding directory list...\n") if ($dbg_01 || VERB9());
        foreach $arg (@dir_list) {
            scan_dir($arg);
        }
    }

    if (length($find_func) == 0) {
        pgm_exit(1,"ERROR: Unable to find function in command! Try -?\n");
    }
    if (! @file_list) {
        pgm_exit(1,"ERROR: Unable to find file list in command! Try -?\n");
    }
}

# eof - findinlib.pl
