#!/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;
[download]