Article 6311 of comp.lang.perl:
Xref: feenix.metronet.com comp.unix.questions:11535 alt.sources:1956 comp.lang.perl:6311
Newsgroups: comp.unix.questions,alt.sources,comp.lang.perl
Path: feenix.metronet.com!news.utdallas.edu!hermes.chpc.utexas.edu!cs.utexas.edu!uunet!pipex!unipalm!ian
From: ian@unipalm.co.uk (Ian Phillipps)
Subject: Re: grep with highlight capability anyone?
Message-ID: <1993Oct1.121148.2549@unipalm.co.uk>
Followup-To: comp.lang.perl
Organization: Unipalm Ltd., 216 Cambridge Science Park, Cambridge CB4 4WA, UK
References: <1993Sep28.173028.27194@bellahs.com> <CE5G42.77u@Colorado.EDU> <28erlu$ste@senator-bedfellow.MIT.EDU> <CE6uHM.Iwq@Colorado.EDU>
Date: Fri, 1 Oct 1993 12:11:48 GMT
Lines: 88

Archive-name: grope

Tom Christiansen <tchrist@cs.Colorado.EDU> writes:

>Archive-name: tcgrep

Here's mine. Less polished than Tom's, but has a "-a" option to print
all the lines in the file.  It's designed to pipe into "less" or some
other backspace-filtering backend.

Read the date and work out which Perl it was for ... admire in
particular the gyrations needed to overcome the fact that /../o hasn't
been invented yet.

Followups to comp.lang.perl.


#!/usr/local/bin/perl -s
$usage = "usage: grope [-help] [-a] [-h] [-p] [-v] [-i] [-n] 're' [files] | [filter]\n";

$helptext = 'This is a replacement for grep; it underlines the strings it finds
using backspace-underline in the manner of nroff.
The regular expression syntax is that of perl(l); it\'s most like egrep(1),
but also supports word-boundaries and sundry other goodies.

The program is most useful in the form of "grope ... | less".
You could also pipe to more, ul or lpr according to taste.

FLAGS:
  -a	prints out all lines in the input; other flags are as for egrep.
  -p	prints out the filenames in the manner of "more"
The -v flag is supported, but you may as well use egrep(1) for this.
Flags have to be separate: "-ni" does not work.

@(#)grope	1.6 88/12/12 /home/titan/igp/cmd/SCCS/s.grope
';

if ($help) { print stderr $usage . $helptext; exit 2; }

if ( $#ARGV < 0 )
    {	print stderr $usage;
	exit;
    }


$h = 1 if $p;				# Don't have both sorts of names

$| = 1;					# Instant action on output pipes
($re = shift ) =~ s/#/\\#/;		# Escape any '#' in the r.e.

# Self-modifying code (look away now if you don't like this sort of thing)
$Whether = $a ? ';' : $v ? '||' : '&&';	# Support for -v and -a flags
$Opts = 'i' if $i;			# Case-ignore

$Format = '$_';
$Format = '$.:' . $Format if $n;	# line numbers
$Format = '$ARGV:' . $Format if $#ARGV >= 0 && ! $h;

# We set $expr to be the whole loop, then execute it: that way, the r.e.
# only gets compiled once. Note there's careful control over when the '$' are
# substituted.

# The following form of the substitute command produces optimised output.
# Regrettably, neither more nor less can cope with these!
# s#$re# '_' x length(\$&) . '\b' x length(\$&) . \$&  #ge$Opts

# The first arg to 'split' is arbitrary, and is assumed to be something not
# in the required r.e.

# Iterate over standard input or all files in ARGV; perl issues any 'cant open'
# messages itself
$expr = "
while(<>)
    {
    print '-' x length( \$ARGV ) . \"\n\$ARGV\n\" .
	'-' x length( \$ARGV ) . \"\n\" if \$p && \$. == 1;
    s#$re# '_\b'.join('_\b',split(/\b*/,\$&)) #ge$Opts
	$Whether print stdout \"$Format\";
    close ARGV if eof;			# resets line number for each file
    }";

eval $expr;
print stderr $@;	# error from the "eval" if any (usually r.e. syntax)
-- 
--- 
Ian Phillipps. Tech support manager, Unipalm.	If you ask me, all conspiracy
Phone +44 223 250103, Fax 250101		theories are put about by the
Pipex phone +44 223 250120. Internic: IP4.	same bunch of people.