#!/usr/bin/perl -w

my $rcsid  = '$Id: perlgrep,v 1.4 2006/04/25 22:55:31 vogelke Exp $';

=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

use strict;
use subs qw(usage version);
use vars qw($opt_d $opt_m $opt_v $pattern);
use File::Basename;
use Getopt::Std;

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

#
# Handle command line arguments (if any).
#

usage() unless getopts('dmv');
version() if $opt_v;
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(INPUT, "<&STDIN") || die "can't redirect stdin: $!\n";

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

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

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

        close(INPUT);
    }
}

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);
}

#---------------------------------------------------------------------
# Return the current version.

sub version {
    $_ = $rcsid;
    s/,v / /;
    @_ = split;
    warn "$_[1]  v$_[2]  $_[3] $_[4]\n";
    exit(0);
}