Grep for PowerBuilder Code

# pbgrep.pl - Grep like utility for a PoweBuilder Application
# Usage: pbgrep.pl ....

# Author: Sam Varadarajan
# Date: 12/01/2009
# Purpose: Script to grep PB export files to find patterns; Each find will show the function name and line #s.

# Modification History:
#
# Copyright, Sam Varadarajan, 2009 - 2014

#
# Globals
#
use vars qw/ %opt /;

init();
my $ptrn = $opt{'p'};
my $dir = '';
my $verbos = 0;
$verbos = 1 if $opt{'v'};
my $file_name = '';

if ($opt{'o'})
{
    $file_name = $opt{'o'};

    #oa for automatic file name
    if (!$file_name || $file_name eq "a")
    {
        $file_name = "search_".$ptrn.".txt" ;
    }
    $file_name =~ s/ /_/g;
    $file_name =~ s/[^a-zA-Z0-9_.\-]*//g; #derive the name from the pattern
}
else {
    $file_name = '-'; #stdout
}

open FILE, ">$file_name";

#my $bare = 0;
# see below $bare = 1 if $opt{'b'};

my $format = "REPORT"; # default Report
$format = uc($opt{'F'}) if $opt{'F'};

my $delim = "\t";
if ($format eq "CSV")
{
    $delim = ",";
}
elsif ($format eq "TAB")
{
    $delim = "\t" ;
}
elsif ($format eq "LIST")
{
    $delim = "\t" ;
}

usage() if (!$ptrn);

print $ptrn."\n";

$dir = $opt{'d'} if $opt{'d'};
if (!$dir)
{
    $dir = 'Z:\\';
}

if ($ptrn)
{
        process_dir($dir, \&process_file, $ptrn);
}

close(FILE);
#end of main

sub process_dir {
    my ($path, $code_ref, $ptrn) = @_;
    my ($DH, $file);
    #debug print $path;
    if (-d $path) {
        unless (opendir $DH, $path) {
            warn "Couldn't open $path.\n$!\nSkipping!";
            return;
        }
        while ($file = readdir $DH) {
                #DEBUG print "processing $file\n";
            next if $file eq '.' || $file eq '..';
            #recursion.
            process_dir("$path/$file", $code_ref, $ptrn);
        }
    }
    elsif (-f $path && (grep /\.sr[u|w|f]/, $path))
    {
#DEBUG      print $path." ".$ptrn."\n";
        $code_ref->($path, $ptrn);
    }
}

sub process_file()
{
    my $path = @_[0];
    my $ptrn = @_[1];
    my $proto_done = 0;
    my $curr_func = "";
    my @words = ();
    my $end_proto = 0;
    my $func_line_nbr = 0;
    my $file_line_nbr = 0;
    my @lines = ();
    my $in_proto = 0;
    my $cnt = 0;

    open (SRFILE, $path)
    or die "$0: Cannot open $path: $!\n";
    #DEBUG  print "debug*** ".$path." ".$ptrn."\n";

    @lines = ();

    # print "processing $path\n";

    # this assumes every file will have forward prototypes
    while (<SRFILE>) {
        $file_line_nbr++;
        next unless ($_ =~ /forward prototypes/);
        $proto_found = 1;
        last;
    }
    if ($proto_found)
    {
        while (<SRFILE>) {
            $file_line_nbr++;
            next unless ($_ =~ /end prototypes/);
            last;
        }
    }

    LOOP1: while (<SRFILE>)
    {
        chomp;
        s/\t+/   /g;
        s/^[ ]*//g;
        $file_line_nbr++;

        @words = split(/\s+/);

#       if (((/public/i || /protected/i || /private/i) &&  /function/i || /subroutine/i) || (/event/i))
# SV, 3/17, a line with     inv_log.Event ue_closelogfile() caused it to think it was inside an event. Added ^ to event check.
# REDTAG, may be we will have to treat them separately and also, what if there was a function statement or event that
# was commented out?

        if (((@words[0] =~ /public/i || @words[0] =~ /protected/i || @words[0] =~ /private/i) &&
                (@words[1] =~ /function/i || @words[1] =~ /subroutine/i)) ||
            (@words[0] =~ /^event/i   && (@words[1] !~ /Post/i && @words[1] !~ /Trigger/i)))
        {
            if (@words[0] =~ /^event/i)
            {
                $curr_func = @words[1];
            }
            else {
                $curr_func = @words[3];
            }
#           print "found func header@words[3]\n";
            $func_line_nbr = 0;
            next LOOP1;
        }
        if ($_ =~ /^[ |\t]*end function/i || $_ =~ /^[ |\t]*end event/i)
        {
            if ($cnt && ($format eq "LIST"))
            {
                    $path =~ s/sr.[ ]*$//g;
                    print FILE $path.$curr_func."\n";
            } else {
                if (@lines)
                {
                    my $count = scalar(@lines);
                    foreach (my $i=0; $i < $count; $i++)
                    {
                        my $li = $lines[$i];
                        #DEBUG print "*****".{$lines[i]}."\n";
                        if ($format eq "REPORT")
                        {
                            if ($ptrn eq $curr_func)
                            {
                                print FILE "<<Function defition>>\n";
                            }
                            print FILE $path."(".$li->{'FILE_LINE'}."):\n   ".$curr_func."(".$li->{'FUNC_LINE'}."):\n      ".$li->{'LINE'}."\n\n";
                        }
                        else {
                            print FILE $path.$delim.$curr_func.$delim.$li->{'FILE_LINE'}.$delim.$li->{'FUNC_LINE'}.$delim.$li->{'LINE'}."\n";
                        }
                    }
                    #VERBOSE print "****# of items found = ".scalar(@lines)."\n\n";
                }
                else {
                    # VERBOSE print $path."\t".$curr_func." No match found*******\n\n";
                }
            }
            $curr_func = "";
            $end_proto = 0;
            $func_line_nbr = 0;
            @lines = ();
            $cnt = 0;
            next LOOP1;
        }
        # all other lines
        $func_line_nbr++;
        if ($_ =~ /$ptrn/ig) {
            $cnt++;
            my $line_info = {};
            #if (!$bare)
            if ($format ne "LIST")
            {
                # bare format - list of functions (obj.func)
                $line_info->{'FILE_LINE'} = $file_line_nbr;
                $line_info->{'FUNC_LINE'} = $func_line_nbr;
                $line_info->{'LINE'} = $_;
            }
            push(@lines, $line_info);
        }
        next LOOP1;
    }
    close(SRFILE);
}

#
# Command line options processing
#
sub init()
{
    use Getopt::Std;
    my $opt_string = 'hvbd:p:F:o:';
    getopts( "$opt_string", \%opt ) or usage();
#   use Getopt::Long;
#   GetOptions("h"=>\$opt{'h'},
#       "v"=>\$opt{'v'},
#       "b"=>\$opt{'b'},
#       "optional:o"=>\$opt{'o'},
#       "d"=> \$opt{'d'},
#       "p"=> \$opt{'p'},
#       "F"=> \$opt{'F'}
#   );

    usage() if $opt{'h'};
}

#
# Message about this program and how to use it
#
sub usage()
{
  print STDERR << "EOF";

    This program does...

    usage: $0 [-hv] [-d dir] [-p pattern] [-F TAB|CSV|REPORT|LIST*] [-o<filename>|-oa]

    -h          :   this (help) message
    -d dir      :   Directory to search in
    -p <pattern>:   Pattern to search

    -F <format>:    Output can be TAB or CSV delimited or LIST or Report (default)
                        LIST outputs object name and function name where pattern was found.

    -o <filename>: Optional, if missing, the output will be sent screen (STDOUT)
    -oa             :   Optional, when present, pattern is used for name of the file (with special chars removed).

    example: $0 -v -d Z:\LA -p <pattern>
    If <pattern> has spaces or is a regular expression, enclose it in double quotes
EOF
    exit;
}