#! /usr/psup/perl5/bin/perl

$all   = 0;
$coral = 0;
$lob   = 0;
$magic = 0;
$rdb   = 0;
$trans = 0;

$and   = 0;

$line    = 0;
$verbose = 1;
$debug   = 0;
$fast    = 0;

foreach $item (@ARGV){

    if (substr($item,0,1) ne '-'){
        push(@patterns,$item);
    } elsif (($item eq '-a') || ($item eq '-all')){
        $all = 1;
    } elsif ($item eq '-and'){
        $and = 1;
    } elsif (($item eq '-f') || ($item eq '-fast')){
        $fast = 1;
    } elsif (($item eq '-l') || ($item eq '-line')){
        $line = 1;
    } elsif (($item eq '-q') || ($item eq '-quiet')){
        $verbose = 0;
    } elsif (($item eq '-c') || ($item eq '-coral')){
        $coral = 1;
    } elsif ($item eq '-lob'){
        $lob = 1;
    } elsif (($item eq '-m') || ($item eq '-magic')){
        $magic = 1;
    } elsif (($item eq '-r') || ($item eq '-rdb')){
        $rdb = 1;
    } elsif (($item eq '-t') || ($item eq '-trans')){
        $trans = 1;
    } elsif (($item eq '-d') || ($item eq '-debug')){
        $debug = 1;
    } elsif (($item eq '-h') || ($item eq '-help')){
        &show_usage;
    } else {
        print "$item: Unrecognized option\n";
        &show_usage;
    }
}

$coral = 1 if (!$all && !$magic && !$rdb && !$trans && !$lob);

if ($all){
    $coral = 1;
    $lob = 1;
    $magic = 1;
    $rdb = 1;
    $trans = 1;
}

$croot = $ENV{'CORALROOT'};

&show_usage if (! @patterns);

$coral_dir = 'src/coral';
@coral_src = ('arg','binding','builtin','compile','connect',
        'crdb','global','hashtable','index','misc','parser','pipelined',
        'relation','rule', 'scc','sm','socket','solvers',
        'stream','symboltable','tuple');

$lob_dir = 'src/clients/lobster';

$magic_dir = 'src/tools/magic';

$rdb_dir = 'src/class/rdb';
@rdb_src = ('base','ingres','misc','sybase','test');

$trans_dir = 'src/tools/translator';

if ($and) {
    @pats = ($patterns[0]);
} else {
    @pats = @patterns;
}

foreach $pattern (@pats){

    if ($and) {
        print "Searching for intersection of '@patterns'.\n" if ($verbose);
    } else {
        print "Searching for '$pattern'.\n" if ($verbose);
    }

    $tot_file = 0;
    $file_cnt = 0;

    &find_pat($pattern,$coral_dir,@coral_src) if ($coral);
    &find_pat($pattern,$magic_dir) if ($magic);
    &find_pat($pattern,$lob_dir) if ($lob);
    &find_pat($pattern,$rdb_dir,@rdb_src) if ($rdb);
    &find_pat($pattern,$trans_dir) if ($trans);

    $total = 0;
    print "\n Report:\n---------\n\n" if ($line);
    
    foreach $item (sort keys(%find_cnt)){
        $num = $find_cnt{"$item"};
        print "$item: $num\n" if ($num && $line);
        $total += $num;
        $find_cnt{$item} = 0;
    }

  print
     "\n$total occurances of $pattern in $file_cnt files (of $tot_file).\n\n"
            if ($verbose);
}

exit 0;

##########################

sub find_pat {

    my($pattern,$dir,@subdirs) = @_;
    my($sdir,$here,$num);
    my($file,$file_head,@files);

    if (@subdirs){
        chdir("$croot/$dir");
    } else {
        chdir("$croot");
        @subdirs = ($dir);
    }

    # Save this directory
    chop($here = `pwd`);

    foreach $sdir (@subdirs){

        chdir($sdir);

        # Check in all types of source files
        @files = &get_dir('.');

        foreach $file (@files){

            $tot_file++;
            if (! open(FILE,$file)){
                print "Could not open file $sdir/$file.\n";
                next;
            }

            $file_head = 0;

            # Zero the pattern count 
            $find_cnt{"$sdir/$file,$pattern"} = 0;

          file_loop:
            while (<FILE>){
              chop;

              if ($and) {

                if (/$pattern/) {
                    foreach $pat (@patterns) {
                        next file_loop if (! /$pat/);
                    }

                    $find_cnt{"$sdir/$file"}++;
                    if ($fast){
                      print "$sdir/${file}\n";
                      last;
                    }
                    if ($line){
                        if (! $file_head){
                            $file_head = 1;
                            print "\n$sdir/${file}:\n";
                        }
                        print "    $_\n";
                    }
                }

              } else {

                if (/$pattern/){
                    $find_cnt{"$sdir/$file,$pattern"}++;
                    if ($fast){
                      print "$sdir/${file}\n";
                      last;
                    }
                    if ($line){
                        if (! $file_head){
                            $file_head = 1;
                            print "\n$sdir/${file}:\n";
                        }
                        print "    $_\n";
                    }
                }
              }
            }
            close FILE;

            if ($and) {
                $num = $find_cnt{"$sdir/$file"};
            } else {
                $num = $find_cnt{"$sdir/$file,$pattern"};
            }
            print "$sdir/${file}: $num\n" if ($num && !$line && !$fast);
            $file_cnt++ if ($num);
        }
        chdir($here);
    }
}

##########################

sub show_usage {


    print "\nUsage: srcchk [-options] pattern [pattern...]\n\n";
    print "\tChecks for pattern in coral source files.\n\n";
    print "Options:\n";
    print "-all:   Check in ALL source code.\n";
    print "-coral: Check in Coral source code (default).\n";
    print "-lob:   Check in Lobster source code.\n";
    print "-magic: Check in Magic source code.\n";
    print "-rdb:   Check in Rdb source code.\n";
    print "-trans: Check in Translator source code.\n\n";

    print "-and:   Only shows files containing all patterns.\n";
    print "-fast:  Only shows files containing pattern, no occurance counts.\n";
    print "-line:  Show all lines flag (show all lines containing pattern)\n";
    print "-quiet: Quiet flag\n\n";

    print "All options (except -lob) can be abreviated to a single char.\n";
    print "Regular expressions should be perl regular expressions\n";
    print "(very similar to those used by vi and most shells) and should\n";
    print "be placed inside single quotes to protect them from the shell.\n\n";

    print "\tEx:   srcchk -v parseEnv parseStack\n";
    print "\tEx:   srcchk -c 'Incr[LF]'\n";

    die "\n";
}

##########################

sub get_dir {

   my($dir) = @_;
   my(@flist);

   @flist = ();


   opendir(DIR, "$dir");

   # Check in all types of source files
   @flist = grep( /^\w+\.c?[cChlyiS]$/,  sort(readdir(DIR)));

   closedir( DIR );

   return @flist;
}

############################