#!/usr/bin/perl -w
#<pgrep: use perl regular expressions to search one or more files.

use strict;
use subs qw/usage myuuid where version/;
use vars qw/$opt_d $opt_m $opt_u $opt_v $opt_w $pattern/;
use File::Basename;
use Getopt::Std;

my $myname = basename($0, ".pl");
my $fh;

# Handle command line arguments (if any).

usage()   unless getopts('dmuvw');
myuuid()  if $opt_u;
version() if $opt_v;
where()   if $opt_w;
usage('No pattern') unless $pattern = shift @ARGV;
print "pattern is ($pattern)\n" if $opt_d;

# Set up the record delimiter if we're searching mail files.
#
# The strangeness in the while loop with From is because a multiple-
# character delimiter only uses the first character to match; the
# leading "From" is stripped, and an extra "From" is added to the
# end of the returned record.

$/ = "From " if $opt_m;

if ($#ARGV < 0) {
    print "searching for $pattern in stdin\n" if $opt_d;
    open($fh, "<&STDIN") || die "can't redirect stdin: $!\n";

    if ($opt_m) {
        while (<$fh>) {
            s/From $//g;
            s/^/From /g;
            /${pattern}/io && print;
        }
    }
    else {
        while (<$fh>) {
            /${pattern}/io && print;
        }
    }

    close($fh);
}
else {
    foreach (@ARGV) {
        print "searching for $pattern in $_\n" if $opt_d;
        open($fh, "$_") || die "can't read $_: $!\n";

        if ($opt_m) {
            while (<$fh>) {
                s/From $//g;
                s/^/From /g;
                /${pattern}/io && print;
            }
        }
        else {
            while (<$fh>) {
                /${pattern}/io && print;
            }
        }

        close($fh);
    }
}

exit(0);

#---------------------------------------------------------------------
# Print a usage message from the comment header and exit.

sub usage {
    my ($emsg) = @_;

    require Pod::Usage;
    import Pod::Usage qw(pod2usage);
    warn "$emsg\n" if defined $emsg;
    pod2usage(-verbose => 1);
}

#---------------------------------------------------------------------
# Print the UUID, current version, or source location.

sub myuuid {
    my $UUID = sprintf("%s",
        q$UUID: e7f8f454-9f43-3462-ad0a-ca0db3f98207 $ =~ /UUID: (.*) /);
    print "$UUID\n";
    exit(0);
}

sub version {
    my $VERSION = sprintf("%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/);
    my $DATE =
      sprintf("%s", q$Date: 2012-07-26 17:11:48-04 $ =~ /Date: (.*) /);
    print "$myname $VERSION $DATE\n";
    exit(0);
}

sub where {
    my $HOST = sprintf("%s",
        q$Host: sys7.com $ =~ /Host: (.*) /);
    my $SOURCE = sprintf("%s",
        q$Source: /home/vogelke/bin/RCS/perlgrep,v $ =~ /Source: (.*) /);
    print "$HOST:$SOURCE\n";
    exit(0);
}

__END__

=head1 NAME

 pgrep

=head1 SYNOPSIS

 pgrep [-dmv] pattern [files ...]

=head1 DESCRIPTION

 "pgrep" uses PERL regular expressions to search one or more files.

=head1 OPTIONS

 "-d" Debugging output is printed.
 "-m" We are searching a mail file, so print the whole message
      if we get a hit on one line.
 "-v" The current version is printed.  No processing is done.

=head1 AUTHOR

 Karl Vogel <vogelke@pobox.com>
 Sumaria Systems, Inc.

=cut