#!/usr/bin/perl

=begin metadata

Name: grep
Description: search for regular expressions and print
Author: Tom Christiansen, tchrist@perl.com
Author: Greg Bacon, gbacon@itsc.uah.edu
Author: Paul Grassie
License: perl

=end metadata

=cut

###
### DON'T FORGET TO UPDATE THE POD IF YOU ADD TO THE HISTORY!!!
###

# tcgrep: tom christiansen's rewrite of grep
# v1.0: Thu Sep 30 16:24:43 MDT 1993
# v1.1: Fri Oct  1 08:33:43 MDT 1993
#
# Revision by Greg Bacon <gbacon@cs.uah.edu>
# Fixed up highlighting for those of us trapped in terminfo
# implemented -f
# v1.2: Fri Jul 26 13:37:02 CDT 1996
#
# Revision by Greg Bacon <gbacon@cs.uah.edu>
# Avoid super-inefficient matching (almost twice as fast! :-)
# v1.3: Sat Aug 30 14:21:47 CDT 1997
#
# Revision by Paul Grassie <grassie@worldnet.att.net>
# Removed vestiges of Perl4, made strict
# v1.4: Mon May 18 16:17:48 EDT 1998
#
# Revision by Greg Bacon <gbacon@cs.uah.edu>
# Add fgrep functionality for PPT
# v1.5: Mon Mar  8 12:05:29 CST 1999
#
# Revision by Bill Benedetto <bbenedetto@goodyear.com>
# Added CLOSE after each file is done to reset counters
# v1.6: Sat Mar 20 23:05:35 1999
#
# Revision by Paul Johnson <paul@pjcj.net>
# Add support for bzip2 and zip files
# File names are printed by default when using -r and supplying no directory
# v1.7: Thu May 27 00:25:30 BST 1999

use strict;

use File::Basename qw(basename);
use File::Spec;
use Getopt::Std;

our $VERSION = '1.006';

$| = 1;                   # autoflush output

my $Me = basename($0);
my $Errors = 0;
my $Grand_Total = 0;
my $Matches;
my $Mult = '';

my %Compress = (
	'z'   => 'zcat <',        # for uncompressing
	'gz'  => 'zcat <',
	'Z'   => 'zcat <',
	'bz2' => 'bzcat <',
	'zip' => 'unzip -c',
);

my ($opt, $matcher) = parse_args();    # get command line options and patterns
matchfile( $opt, $matcher, @ARGV );   # process files

exit(2) if $Errors;
exit(0) if $Grand_Total;
exit(1);

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

sub VERSION_MESSAGE {
	print "$Me version $VERSION\n";
	exit 0;
}

sub usage {
	die <<EOF;
usage: $Me [-inCcwsxvHhLlF1gurpaqT] [-e pattern]
        [-f pattern-file] [-P sep] [pattern] [file...]

Options:
	-i   case insensitive
	-n   number lines
	-c   give count of lines matching
	-C   ditto, but >1 match per line possible
	-w   word boundaries only
	-q   quiet; nothing is written to standard output
	-x   exact matches only
	-v   invert search sense (lines that DON'T match)
	-H   show filenames
	-h   hide filenames
	-e   expression (for exprs beginning with -)
	-f   file with expressions
	-l   list filenames matching
	-L   list filenames which do not match
	-F   search for fixed strings (disable regular expressions)
	-1   1 match per file
	-g   highlight matches
	-u   underline matches
	-r   recursive on directories or dot if none
	-p   paragraph mode (default: line mode)
	-P   ditto, but specify separator, e.g. -P '%%\\n'
	-a   all files, not just plain text files
	-s   suppress errors for failed file and dir opens
	-T   trace files as opened

May use GREP_OPTIONS environment variable to set default options.
EOF
	}

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

sub parse_args {
	my (%opt, $pattern, @patterns, $match_code, $SO, $SE);

	if ( defined( $_ = $ENV{'GREP_OPTIONS'} ) ) {
		s/^([^\-])/-$1/;    # add leading - if missing
		unshift @ARGV, $_;
		}

	$opt{'p'} = $opt{'P'} = ''; # argument to print()
	getopts('inCcwsxvHhe:f:Ll1gurpP:aqTF', \%opt) or usage();

	$opt{'l'} = 0 if $opt{'L'};
	my $no_re = $opt{F} || ( $Me =~ /\bfgrep\b/ );
	$match_code = '';

	if (defined $opt{'f'}) {           # -f patfile
		my $path = $opt{'f'};
		my $patfile;
		die "$Me: $path: is a directory\n" if -d $path;
		open($patfile, '<', $path) or die "$Me: Can't open '$path': $!\n";

		# make sure each pattern in file is valid
		while ( defined( $pattern = <$patfile> ) ) {
			chomp $pattern;
			unless ($no_re) {
				eval { 'foo' =~ /$pattern/, 1 }
					or die "$Me: $path: $.: bad pattern: $@\n";
				}
			push @patterns, $pattern;
			}
		close $patfile;
		}
	else {    # make sure pattern is valid
		$pattern = $opt{'e'};
		$pattern = shift(@ARGV) unless length $pattern;
		usage() unless defined $pattern;
		unless ($no_re) {
			eval { 'foo' =~ /$pattern/, 1 }
				or die "$Me: bad pattern: $@\n";
			}
		@patterns = ($pattern);
		}
	if ($opt{'H'}) {
		$Mult = 1;
	}
	elsif ($opt{'h'}) {
		$Mult = 0;
	}
	else {
		$Mult = $opt{'r'} || (scalar(@ARGV) > 1);
	}
	@ARGV = ($opt{'r'} ? '.' : '-') unless @ARGV;

	if ($opt{'g'} || $opt{'u'}) {    # highlight or underline
		my $terminal;

		eval {                     # try to look up escapes for stand-out
			require POSIX;         # or underline via Term::Cap
			require Term::Cap;

			my $termios = POSIX::Termios->new();
			$termios->getattr;
			my $ospeed = $termios->getospeed;

			$terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
			};

		unless ($@) {    # if successful, get escapes for either
			local $^W = 0;    # stand-out (-g) or underlined (-u)
			( $SO, $SE ) =
				$opt{'g'}
				? ( $terminal->Tputs('so'), $terminal->Tputs('se') )
				: ( $terminal->Tputs('us'), $terminal->Tputs('ue') );
			}
		else {                # if use of Term::Cap fails,
			my $term = $ENV{'TERM'} || 'vt100';
			( $SO, $SE ) = $opt{'g'}    # use tput command to get escapes
				? ( `tput -T $term smso`, `tput -T $term rmso` )
				: ( `tput -T $term smul`, `tput -T $term rmul` );
			}
		}

	if ($no_re) {
		if ($opt{'g'} || $opt{'u'} || $opt{'w'}) {
			die "$Me: -g, -u and -w are incompatible with -F\n";
		}
		if ($opt{'x'}) { # exact match
			my $testop = $opt{'v'} ? 'ne' : 'eq';
			if ($opt{'i'}) {
				$match_code = "my \$c=\$_; chomp \$c; for my \$pat (\@patterns) {\$Matches++ if (lc(\$c) $testop lc(\$pat)) }";
			}
			else { # case sensitive
				$match_code = "my \$c=\$_; chomp \$c; for my \$pat (\@patterns) {\$Matches++ if (\$c $testop \$pat) }";
			}
		}
		else { # regular match
			my $testop = $opt{'v'} ? '==' : '!=';
			if ($opt{'i'}) {
				$match_code = "for my \$pat (\@patterns) { \$Matches++ if (index(lc \$_, lc \$pat) $testop -1) }";
			}
			else { # case sensitive
				$match_code = "for my \$pat (\@patterns) { \$Matches++ if (index(\$_, \$pat) $testop -1) }";
			}
		}
		$matcher = eval "sub { $match_code }";
		die if $@;
		return (\%opt, $matcher);
	}

	# mumble mumble DeMorgan mumble mumble
	if ( $opt{v} ) {
		@patterns = join '|', map "(?:$_)", @patterns;
		}

	if ( $opt{i} ) {
		@patterns = map {"(?i)$_"} @patterns;
		}

	if ( $opt{p} || $opt{P} ) {
		@patterns = map {"(?m)$_"} @patterns;
		}

	$opt{p}   && ( $/        = '' );
	$opt{P}   && ( $/        = eval(qq("$opt{P}")) );                                         # for -P '%%\n'
	$opt{w}   && ( @patterns = map { '(?:\b|(?!\w))' . $_ . '(?:\b|(?<!\w))' } @patterns );
	$opt{'x'} && ( @patterns = map {"^$_\$"} @patterns );
	$opt{'1'} ||= $opt{'l'}; # that's a one and an ell
	$opt{'g'} ||= $opt{'u'};
	$opt{'c'} ||= $opt{'C'};

	foreach (@patterns) {s(/)(\\/)g}

	if ( $opt{'g'} ) {
		for my $pattern (@patterns) {
			$match_code .= "\$Matches += s/($pattern)/${SO}\$1${SE}/g;";
			}
		}
	elsif ( $opt{v} ) {
		for my $pattern (@patterns) {
			$match_code .= "\$Matches += !/$pattern/;";
			}
		}
	elsif ( $opt{C} ) {
		for my $pattern (@patterns) {
			$match_code .= "\$Matches++ while /$pattern/g;";
			}
		}
	else {
		for my $pattern (@patterns) {
			$match_code .= "\$Matches++ if /$pattern/;";
			}
		}

	$matcher = eval "sub { $match_code }";
	die if $@;

	return ( \%opt, $matcher );
	}

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

sub matchfile {
	$opt     = shift;    # reference to option hash
	$matcher = shift;    # reference to matching sub

	my ( $file, @list, $total, $name );
	local ($_);
	$total = 0;

FILE: while ( defined( $file = shift(@_) ) ) {
		my $compressed = 0;

		if ( $file eq '-' ) {
			$name = '<STDIN>';
			}
		elsif ( -d $file ) {
			if ( -l $file && @ARGV != 1 ) {
				warn qq($Me: "$file" is a symlink to a directory\n)
					if $opt->{T};
				next FILE;

				}
			if ( !$opt->{r} ) {
				warn qq($Me: "$file" is a directory\n);
				next FILE;
				}
			my $dh;
			unless (opendir $dh, $file) {
				unless ( $opt->{'s'} ) {
					warn "$Me: can't opendir $file: $!\n";
					$Errors++;
					}
				next FILE;
				}
			@list = ();
			for (readdir $dh) {
				next if $_ eq '.' or $_ eq '..';
				push @list, File::Spec->catfile($file, $_);
				}
			closedir $dh;
			@list = sort @list;
			matchfile( $opt, $matcher, @list );    # process files
			next FILE;
			}
		else {
			$name = $file;
			unless ( -e $file ) {
				warn qq($Me: "$file" does not exist\n) unless $opt->{'s'};
				$Errors++;
				next FILE;
				}
			unless ( -f $file || $opt->{a} ) {
				warn qq($Me: skipping non-plain file "$file"\n) if $opt->{T};
				next FILE;
				}

			my ($ext) = $file =~ /\.([^.]+)$/;
			if ( defined $ext && exists $Compress{$ext} ) {
				$file       = "$Compress{$ext} $file |";
				$compressed = 1;
				}
			elsif (!$opt->{'a'} && -B $file) {
				warn qq($Me: skipping binary file "$file"\n) if $opt->{T};
				next FILE;
				}
			}

		warn "$Me: checking $name\n" if $opt->{'T'};

		my $fh;
		if ( $file eq '-' ) {
			$fh = *STDIN;
			}
		else {
			my $ok;
			if ($compressed) {
				$ok = open $fh, $file;    # pipe
				}
			else {
				$ok = open $fh, '<', $file;
				}
			if (!$ok) {
				warn "$Me: $file: $!\n" unless $opt->{'s'};
				$Errors++;
				next FILE;
				}
			}

		$total = $Matches = 0;

	LINE: while (<$fh>) {
			$Matches = 0;

			##############
			&{$matcher}();    # do it! (check for matches)
			##############

			next LINE unless $Matches;

			$total += $Matches;
			last FILE if $opt->{'q'}; # single match for all files
			last LINE if $opt->{'L'}; # one match is enough

			if ( $opt->{p} || $opt->{P} ) {
				s/\n{2,}$/\n/ if $opt->{p};
				chomp         if $opt->{P};
				}
			if ($opt->{'l'}) {
				print $name, "\n";
				last LINE;
			}
			unless ($opt->{'c'}) {
				print($name, ':') if $Mult;
				print $opt->{n} ? "$.:" : "", $_,
					( $opt->{p} || $opt->{P} ) && ( '-' x 20 ) . "\n";
			}

			last LINE if $opt->{'1'}; # single match per file
			}
			close $fh;
		}
	continue {
		if ($opt->{'c'}) {
			print($name, ':') if $Mult;
			print $total, "\n";
		}
		if ($opt->{'L'} && !$total) {
			print $name, "\n";
		}
		}
	$Grand_Total += $total;
	}

__END__

=pod

=head1 NAME

grep - search for regular expressions and print

=head1 SYNOPSIS

B<grep> [ B<-[incCwsxvhHlLF1igurpaqT]> ] [ B<-e> I<pattern> ]
[ B<-f> I<pattern-file> ] [ B<-P> I<sep> ] [ I<pattern> ] [ I<files> ... ]

=head1 DESCRIPTION

B<grep> searches for lines (or, optionally, paragraphs) in files
that satisfy the criteria specified by the user-supplied patterns.
Because this B<grep> is a Perl program, the user has full access to
Perl's rich regular expression engine.  See L<perlre>.

The first argument after the options (assuming the user did not specify
the B<-e> option or the B<-f> option) is taken as I<pattern>.
If the user does not supply a list of file or directory names to
search, B<tcgrep> will attempt to search its standard input.

With no arguments, B<grep> will output its option list and exit.

=head1 OPTIONS

The following options are accepted:

=over 4

=item B<-1>

Allow at most one match per file.

=item B<-a>

Search all files.  The default is to only search plain text files
and compressed files.

=item B<-C>

Output the count of the matching lines or paragraphs.  This is similar
to the B<-c> option (in fact, it implies the B<-c> option), except more
than one match is possible in each line or paragraph.

=item B<-c>

Output the count of the matching lines or paragraphs.

=item B<-e> I<pattern>

Treat I<pattern> as a pattern.  This option is most useful when
I<pattern> starts with a C<-> and the user wants to avoid confusing
the option parser.

The B<-f> option supercedes the B<-e> option.

=item B<-F>

B<fgrep> mode.  Disable regular expressions and perform Boyer-Moore
searches.  (Whether it lives up to the 'f' in B<fgrep> is another
issue).

=item B<-f> I<pattern-file>

Treat I<pattern-file> as a newline-separated list of patterns to use
as search criteria.

the B<-f> option supercedes the B<-e> option.

=item B<-g>

Highlight matches.  This option causes B<grep> to attempt to use
your terminal's stand-out (emboldening) functionality to highlight
those portions of each matching line or paragraph that actually
triggered the match.  This feature is very similar to the way the
less(1) pager highlights matches.  See also B<-u>.

=item B<-H>

Always include filename headers for matching lines or paragraphs.

=item B<-h>

Hide filenames.  Only print matching lines or paragraphs.

=item B<-i>

Ignore case while matching.  This means, for example, that the pattern
C<unix> would match C<unix> as well as C<UniX> (plus the other fourteen
possible capitalizations).  This corresponds to the C</i> Perl regular
expression switch.  See L<perlre>.

=item B<-L>

List files which do no match any pattern.  This option takes precedence
over B<-l>.

=item B<-l>

List files containing matches.  This option tells B<grep> not to
print any matches but only the names of the files containing matches.
This option implies the B<-1> option.

=item B<-n>

Number lines or paragraphs.  Before outputting a given match, B<grep>
will first output its line or paragraph number corresponding to the
value of the Perl magic scalar $. (whose documentation is in L<perlvar>).

=item B<-P> I<sep>

Put B<grep> in paragraph mode, and use I<sep> as the paragraph
separator.  This is implemented by assigning I<sep> to Perl's magic
$/ scalar.  See L<perlvar>.

=item B<-p>

Paragraph mode.  This causes B<grep> to set Perl's magic $/ to C<''>.
(Note that the default is to process files in line mode.)  See L<perlvar>.

=item B<-s>

Suppress diagnostic messages to the standard error.

=item B<-r>

Recursively scan directories.  This option causes B<grep> to
descend directories in a left-first, depth-first manner and search
for matches in the files of each directory it encounters.  The
presence of B<-r> implies a file argument of F<.>, the current
directory, if the user does not provide filenames on the command line.
See L<"EXAMPLES">.

=item B<-q>

Quiet mode.  Do not write to the standard output.  This option would
be useful from a shell script, for example, if you are only interested
in whether or not there exists a match for a pattern.

=item B<-T>

Trace files as processed.  This causes B<grep> to send diagnostic
messages to the standard error when skipping symbolic links to directories,
when skipping directories because the user did not give the B<-r> switch,
when skipping non-plain files (see L<perlfunc/-f>),
when skipping non-text files (see L<perlfunc/-T>), and
when opening a file for searching

=item B<-u>

Underline matches.  This option causes B<grep> to attempt to use
your terminal's underline functionality to underline those portions of
each matching line or paragraph that actually triggered the match.
See also B<-H>.

=item B<-v>

Invert the sense of the match, i.e. print those lines or paragraphs
that do B<not> match.  When using this option in conjunction with B<-f>,
keep in mind that the entire set of patterns are grouped together in
one pattern for the purposes of negation.  See L<"EXAMPLES">.

=item B<-w>

Matches must start and end at word boundaries.  This is currently
implemented by surrounding each pattern with a pair of C<\b>, the
Perl regular expression word boundary metasequence.  See L<perlre>
for the precise definition of C<\b>.

=item B<-x>

Exact matches only.  The pattern must match the entire line or paragraph.

=back

=head1 ENVIRONMENT

The GREP_OPTIONS environment variable is taken as the default set of
options to grep, placed at the front of any explicit options.

=head1 EXAMPLES

Search all files under F</etc/init.d> for a particular pattern:

    % grep -r tcgrep /etc/init.d

Use of B<-v> and B<-f> options in conjunction with one another:

    % cat fruits
    pomme
    banane
    poire
    % cat pats
    pomme
    poire
    % grep -vf pats fruits
    banane

=head1 TODO

=over 4

=item *

Add more cool examples. :-)

=item *

Perhaps allow the user to provide an exclusion pattern for skipping over
files whose names match the pattern.

=back

=head1 AUTHOR

B<tcgrep> was written by Tom Christiansen with updates by Greg Bacon
and Paul Grassie.

=head1 COPYRIGHT and LICENSE

Copyright (c) 1993-1999. Tom Christiansen.

This program is free and open software. You may use, copy, modify, distribute,
and sell this program (and any modified variants) in any way you wish,
provided you do not restrict others from doing the same.

=cut
