#!/usr/bin/perl -w
use strict;
@ARGV && shift =~ /^-([sahgc]+)$/ or die << "USAGE";
usage: $0 -[sahg] name1 name2 -- input
-s scalar
-a array
-h hash
-g glob (same as -sah)
-c suppress lines starting with a #
nameN symbol name
input file to search
USAGE
my %mode = map +($_, 1), split //, $1;
my (@vars,@matches,$format);
push @vars, shift while @ARGV and $ARGV[0] ne '--';
shift;
my $name = qr{ @{[ join('|', @vars) ]} }x;
my $scalar = qr{ \$ $name (?= [^\w\[\{] ) }x;
my $array = qr{ \@ $name (?= \W ) | \$ $name \[ }x;
my $hash = qr{ % $name (?= \W ) | [\@\$] $name \{ }x;
my $glob = qr{ [\$\@%*] $name (?= \W) }x;
my ($flen,$llen) = (0,0);
while (<>) {
next if $mode{c} and /^\s*#/;
if (
($mode{g} and /$glob/) or
($mode{s} and /$scalar/) or
($mode{a} and /$array/) or
($mode{h} and /$hash/)
) {
push @matches, [ $ARGV, $., $_ ];
$flen = length($ARGV) if length($ARGV) > $flen;
$llen = length($.) if length($.) > $llen;
}
}
exit unless @matches;
$format =
'@' . ('>' x ($flen - 1)) . ':' .
'@' . ('#' x ($llen - 1)) . ':~' .
'^' . ('<' x (80 - $flen - $llen - 4)) .
' ' x ($flen + $llen + 3) . '^' . ('<' x (80 - $flen - $llen - 4)) .
+ "\n";
formline($format, $_->[0], $_->[1], $_->[2], $_->[2]) for @matches;
print $^A;
|