#!/usr/local/bin/perl -w'di';'ig00';################################################################################## search#### Jeffrey Friedl (jfriedl@omron.co.jp), Dec 1994.## Copyright 19.... ah hell, just take it.#### BLURB:## A combo of find and grep -- more or less do a 'grep' on a whole## directory tree. Fast, with lots of options. Much more powerful than## the simple "find ... | xargs grep ....". Has a full man page.## Powerfully customizable.#### This file is big, but mostly comments and man page.#### See man page for usage info.## Return value: 2=error, 1=nothing found, 0=something found.##$version = "950918.5";#### "950918.5";##	Changed all 'sysread' to 'read' because Linux perl's don't seem##	to like sysread()#### "941227.4";##	Added -n, -u#### "941222.3"##      Added -nice (due to Lionel Cons <Lionel.Cons@cern.ch>)##	Removed any leading "./" from name.##      Added default flags for ~/.search, including TTY, -nice, -list, etc.##	Program name now has path removed when printed in diagnostics.##	Added simple tilde-expansion to -dir arg.##	Added -dskip, etc. Fixed -iregex bug.##	Changed -dir to be additive, adding -ddir.##	Now screen out devices, pipes, and sockets.##	More tidying and lots of expanding of the man page###### "941217.2";##	initial release.$stripped=0;&init;if (exists $ENV{'HOME'}) {    $rc_file = join('/', $ENV{'HOME'}, ".search");}else {    $rc_file = "";}&check_args;## Make sure we've got a regex.## Don't need one if -find or -showrc was specified.$!=2, die "expecting regex arguments.\n"	if $FIND_ONLY == 0 && $showrc == 0 && @ARGV == 0;&prepare_to_search($rc_file);&import_program if !defined &dodir; ## BIG key to speed.## do search while there are directories to be done.&dodir(shift(@todo)) while @todo;&clear_message if $VERBOSE && $STDERR_IS_TTY;exit($retval);###############################################################################sub init{  ## initialize variables that might be reset by command-line args  $DOREP=0; 		## set true by -dorep (redo multi-hardlink files)  $DOREP=1 if $^O eq 'MSWin32';  $DO_SORT=0;           ## set by -sort (sort files in a dir before checking)  $FIND_ONLY=0;         ## set by -find (don't search files)  $LIST_ONLY=0;		## set true by -l (list filenames only)  $NEWER=0;             ## set by -newer, "-mtime -###"  $NICE=0;              ## set by -nice (print human-readable output)  $NOLINKS=0; 		## set true by -nolinks (don't follow symlinks)  $OLDER=0;             ## set by -older, "-mtime  ###"  $PREPEND_FILENAME=1;  ## set false by -h (don't prefix lines with filename)  $REPORT_LINENUM=0;    ## set true by -n (show line numbers)  $VERBOSE=0;		## set to a value by -v, -vv, etc. (verbose messages)  $WHY=0;		## set true by -why, -vvv+ (report why skipped)  $XDEV=0;		## set true by -xdev (stay on one filesystem)  $all=0;		## set true by -all (don't skip many kinds of files)  $iflag = '';		## set to 'i' by -i (ignore case);  $norc=0;              ## set by -norc (don't load rc file)  $showrc=0;            ## set by -showrc (show what happens with rc file)  $underlineOK=0;       ## set true by -u (watch for underline stuff)  $words=0;             ## set true by -w (match whole-words only)  $DELAY=0;		## inter-file delay (seconds)  $retval=1;            ## will set to 0 if we find anything.  ## various elements of stat() that we might access  $STAT_DEV   = 1;  $STAT_INODE = 2;  $STAT_MTIME = 9;  $VV_PRINT_COUNT = 50;  ## with -vv, print every VV_PRINT_COUNT files, or...  $VV_SIZE = 1024*1024;  ## ...every VV_SIZE bytes searched  $vv_print = $vv_size = 0; ## running totals.  ## set default options, in case the rc file wants them  $opt{'TTY'}= 1 if -t STDOUT;    ## want to know this for debugging message stuff  $STDERR_IS_TTY = -t STDERR ? 1 : 0;  $STDERR_SCREWS_STDOUT = ($STDERR_IS_TTY && -t STDOUT) ? 1 : 0;  $0 =~ s,.*/,,;  ## clean up $0 for any diagnostics we'll be printing.}#### Check arguments.##sub check_args{  while (@ARGV && $ARGV[0] =~ m/^-/)  {      $arg = shift(@ARGV);      if ($arg eq '-version' || ($VERBOSE && $arg eq '-help')) {	  print qq/Jeffrey's file search, version "$version".\n/;	  exit(0) unless $arg eq '-help';      }      if ($arg eq '-help') {	  print <<INLINE_LITERAL_TEXT;usage: $0 [options] [-e] [PerlRegex ....]OPTIONS TELLING *WHERE* TO SEARCH:  -dir DIR       start search at the named directory (default is current dir).  -xdev          stay on starting file system.  -sort          sort the files in each directory before processing.  -nolinks       don't follow symbolic links.OPTIONS TELLING WHICH FILES TO EVEN CONSIDER:  -mtime #       consider files modified > # days ago (-# for < # days old)  -newer FILE    consider files modified more recently than FILE (also -older)  -name GLOB     consider files whose name matches pattern (also -regex).  -skip GLOB     opposite of -name: identifies files to not consider.  -path GLOB     like -name, but for files whose whole path is described.  -dpath/-dregex/-dskip versions for selecting or pruning directories.  -all           don't skip any files marked to be skipped by the startup file.  -x<SPECIAL>    (see manual, and/or try -showrc).  -why           report why a file isn't checked (also implied by -vvvv).OPTIONS TELLING WHAT TO DO WITH FILES THAT WILL BE CONSIDERED:  -f  | -find    just list files (PerlRegex ignored). Default is to grep them.  -ff | -ffind   Does a faster -find (implies -find -all -dorep)OPTIONS CONTROLLING HOW THE SEARCH IS DONE (AND WHAT IS PRINTED):  -l | -list     only list files with matches, not the lines themselves.  -nice | -nnice print more "human readable" output.  -n             prefix each output line with its line number in the file.  -h             don't prefix output lines with file name.  -u             also look "inside" manpage-style underlined text  -i             do case-insensitive searching.  -w             match words only (as defined by perl's \\b).OTHER OPTIONS:  -v, -vv, -vvv  various levels of message verbosity.  -e             end of options (in case a regex looks like an option).  -showrc        show what the rc file sets, then exit.  -norc          don't load the rc file.  -dorep         check files with multiple hard links multiple times.INLINE_LITERAL_TEXT	print "Use -v -help for more verbose help.\n" unless $VERBOSE;	print "This script file is also a man page.\n" unless $stripped;	print <<INLINE_LITERAL_TEXT if $VERBOSE;If -f (or -find) given, PerlRegex is optional and ignored.Otherwise, will search for files with lines matching any of the given regexes.Combining things like -name and -mtime implies boolean AND.However, duplicating things (such as -name '*.c' -name '*.txt') implies OR.-mtime may be given floating point (i.e. 1.5 is a day and a half).-iskip/-idskip/-ipath/... etc are case-insensitive versions.If any letter in -newer/-older is upper case, "or equal" isinserted into the test.You can always find the latest version on the World Wide Web in   http://www.wg.omron.co.jp/~jfriedl/perl/INLINE_LITERAL_TEXT	  exit(0);      }      $DOREP=1,             next if $arg eq '-dorep';   ## do repeats      $DO_SORT=1,           next if $arg eq '-sort';    ## sort files      $NOLINKS=1,           next if $arg eq '-nolinks'; ## no sym. links      $PREPEND_FILENAME=0,  next if $arg eq '-h';       ## no filename prefix      $REPORT_LINENUM=1,    next if $arg eq '-n';       ## show line numbers      $WHY=1,               next if $arg eq '-why';     ## tell why skipped      $XDEV=1,              next if $arg eq '-xdev';    ## don't leave F.S.      $all=1,$opt{'-all'}=1,next if $arg eq '-all';     ## don't skip *.Z, etc      $iflag='i',           next if $arg eq '-i';       ## ignore case      $norc=1,              next if $arg eq '-norc';    ## don't load rc file      $showrc=1,            next if $arg eq '-showrc';  ## show rc file      $underlineOK=1,       next if $arg eq '-u';       ## look throuh underln.      $words=1,             next if $arg eq '-w';       ## match "words" only      &strip                     if $arg eq '-strip';   ## dump this program      last                       if $arg eq '-e';      $DELAY=$1,            next if $arg =~ m/-delay(\d+)/;      $FIND_ONLY=1,         next if $arg =~/^-f(ind)?$/;## do "find" only      $FIND_ONLY=1, $DOREP=1, $all=1,                            next if $arg =~/^-ff(ind)?$/;## fast -find      $LIST_ONLY=1,$opt{'-list'}=1,		            next if $arg =~/^-l(ist)?$/;## only list files      if ($arg =~ m/^-(v+)$/) { ## verbosity	$VERBOSE =length($1);	foreach $len (1..$VERBOSE) { $opt{'-'.('v' x $len)}=1 }	next;      }      if ($arg =~ m/^-(n+)ice$/) { ## "nice" output        $NICE =length($1);	foreach $len (1..$NICE) { $opt{'-'.('n' x $len).'ice'}=1 }	next;      }      if ($arg =~ m/^-(i?)(d?)skip$/) {	  local($i) = $1 eq 'i';	  local($d) = $2 eq 'd';	  $! = 2, die qq/$0: expecting glob arg to -$arg\n/ unless @ARGV;	  foreach (split(/\s+/, shift @ARGV)) {	      if ($d) {		  $idskip{$_}=1 if $i;		   $dskip{$_}=1;	      } else {		  $iskip{$_}=1 if $i;		   $skip{$_}=1;	      }	  }	  next;      }      if ($arg =~ m/^-(i?)(d?)(regex|path|name)$/) {	  local($i) = $1 eq 'i';	  $! = 2, die qq/$0: expecting arg to -$arg\n/ unless @ARGV;	  foreach (split(/\s+/, shift @ARGV)) {	      $iname{join(',', $arg, $_)}=1 if $i;	       $name{join(',', $arg, $_)}=1;	  }	  next;      }      if ($arg =~ m/^-d?dir$/) {	  $opt{'-dir'}=1;	  $! = 2, die qq/$0: expecting filename arg to -$arg\n/ unless @ARGV;	  $start = shift(@ARGV);	  $start =~ s#^~(/+|$)#$ENV{'HOME'}$1# if defined $ENV{'HOME'};	  $! = 2, die qq/$0: can't find ${arg}'s "$start"\n/ unless -e $start;	  $! = 2, die qq/$0: ${arg}'s "$start" not a directory.\n/ unless -d _;	  undef(@todo), $opt{'-ddir'}=1 if $arg eq '-ddir';	  push(@todo, $start);	  next;      }      if ($arg =~ m/^-(new|old)er$/i) {	  $! = 2, die "$0: expecting filename arg to -$arg\n" unless @ARGV;	  local($file, $time) = shift(@ARGV);	  $! = 2, die qq/$0: can't stat -${arg}'s "$file"./		  unless $time = (stat($file))[$STAT_MTIME];	  local($upper) = $arg =~ tr/A-Z//;	  if ($arg =~ m/new/i) {	     $time++ unless $upper;	     $NEWER = $time if $NEWER < $time;	  } else {	     $time-- unless $upper;	     $OLDER = $time if $OLDER == 0 || $OLDER > $time;	  }	  next;      }      if ($arg =~ m/-mtime/) {	  $! = 2, die "$0: expecting numerical arg to -$arg\n" unless @ARGV;	  local($days) = shift(@ARGV);	  $! = 2, die qq/$0: inappropriate arg ($days) to $arg\n/ if $days==0;	  $days *= 3600 * 24;	  if ($days < 0) {	      local($time) = $^T + $days;	      $NEWER = $time if $NEWER < $time;	  } else {	      local($time) = $^T - $days;  	      $OLDER = $time if $OLDER == 0 || $OLDER > $time;	  }	  next;      }      ## special user options      if ($arg =~ m/^-x(.+)/) {	  foreach (split(/[\s,]+/, $1)) {  $user_opt{$_} = $opt{$_}= 1;  }	  next;      }      $! = 2, die "$0: unknown arg [$arg]\n";  }}#### Given a filename glob, return a regex.## If the glob has no globbing chars (no * ? or [..]), then## prepend an effective '*' to it.##sub glob_to_regex{    local($glob) = @_;    local(@parts) = $glob =~ m/\\.|[*?]|\[]?[^]]*]|[^[\\*?]+/g;    local($trueglob)=0;    foreach (@parts) {	if ($_ eq '*' || $_ eq '?') {	    $_ = ".$_";	    $trueglob=1;  ## * and ? are a real glob	} elsif (substr($_, 0, 1) eq '[') {	    $trueglob=1;  ## [..] is a real glob	} else {	    s/^\\//;     ## remove any leading backslash;	    s/\W/\\$&/g; ## now quote anything dangerous;	}    }    unshift(@parts, '.*') unless $trueglob;    join('', '^', @parts, '$');}sub prepare_to_search{  local($rc_file) = @_;  $HEADER_BYTES=0;          ## Might be set nonzero in &read_rc;  $last_message_length = 0; ## For &message and &clear_message.  &read_rc($rc_file, $showrc) unless $norc;  exit(0) if $showrc;  $NEXT_DIR_ENTRY = $DO_SORT ? 'shift @files' : 'readdir(DIR)';  $WHY = 1 if $VERBOSE > 3; ## Arg -vvvv or above implies  -why.  @todo = ('.') if @todo == 0; ## Where we'll start looking  ## see if any user options were specified that weren't accounted for  foreach $opt (keys %user_opt) {      next if defined $seen_opt{$opt};      warn "warning: -x$opt never considered.\n";  }  die "$0: multiple time constraints exclude all possible files.\n"      if ($NEWER && $OLDER) && ($NEWER > $OLDER);  ##  ## Process any -skip/-iskip args that had been given  ##  local(@skip_test);  foreach $glob (keys %skip) {      $i = defined($iskip{$glob}) ? 'i': '';      push(@skip_test, '$name =~ m/'. &glob_to_regex($glob). "/$i");  }  if (@skip_test) {      $SKIP_TEST = join('||',@skip_test);      $DO_SKIP_TEST = 1;  } else {      $DO_SKIP_TEST = $SKIP_TEST = 0;  }  ##  ## Process any -dskip/-idskip args that had been given  ##  local(@dskip_test);  foreach $glob (keys %dskip) {      $i = defined($idskip{$glob}) ? 'i': '';      push(@dskip_test, '$name =~ m/'. &glob_to_regex($glob). "/$i");  }  if (@dskip_test) {      $DSKIP_TEST = join('||',@dskip_test);      $DO_DSKIP_TEST = 1;  } else {      $DO_DSKIP_TEST = $DSKIP_TEST = 0;  }  ##  ## Process any -name, -path, -regex, etc. args that had been given.  ##  undef @name_test;  undef @dname_test;  foreach $key (keys %name) {      local($type, $pat) = split(/,/, $key, 2);      local($i) = defined($iname{$key}) ? 'i' : '';      if ($type =~ /regex/) {	  $pat =~ s/!/\\!/g;	  $test = "\$name =~ m!^$pat\$!$i";      } else {	  local($var) = $type eq 'name' ? '$name' : '$file';	  $test = "$var =~ m/". &glob_to_regex($pat). "/$i";      }      if ($type =~ m/^-i?d/) {	  push(@dname_test, $test);      } else {	  push(@name_test, $test);      }  }  if (@name_test) {      $GLOB_TESTS = join('||', @name_test);      $DO_GLOB_TESTS = 1;  } else {      $GLOB_TESTS = $DO_GLOB_TESTS = 0;  }  if (@dname_test) {      $DGLOB_TESTS = join('||', @dname_test);      $DO_DGLOB_TESTS = 1;  } else {      $DGLOB_TESTS = $DO_DGLOB_TESTS = 0;  }  ##  ## Process any 'magic' things from the startup file.  ##  if (@magic_tests && $HEADER_BYTES) {      ## the $magic' one is for when &dodir is not inlined      $tests = join('||',@magic_tests);      $MAGIC_TESTS = " { package magic; \$val = ($tests) }";      $DO_MAGIC_TESTS = 1;  } else {      $MAGIC_TESTS = 1;      $DO_MAGIC_TESTS = 0;  }  ##  ## Prepare regular expressions.  ##  {      local(@regex_tests);      if ($LIST_ONLY) {	 $mflag = '';	 ## need to have $* set, but perl5 just won''t shut up about it.	 if ($] >= 5) {	      $mflag = 'm';	 } else {	      eval ' $* = 1 ';	 }      }      ##      ## Until I figure out a better way to deal with it,      ## We have to worry about a regex like [^xyz] when doing $LIST_ONLY.      ## Such a regex *will* match \n, and if I'm pulling in multiple      ## lines, it can allow lines to match that would otherwise not match.      ##      ## Therefore, if there is a '[^' in a regex, we can NOT take a chance      ## an use the fast listonly.      ##      $CAN_USE_FAST_LISTONLY = $LIST_ONLY;      local(@extra);      local($underline_glue) = ($] >= 5) ? '(:?_\cH)?' : '(_\cH)?';      while (@ARGV) {          $regex = shift(@ARGV);	  ##	  ## If watching for underlined things too, add another regex.	  ##	  if ($underlineOK) {	     if ($regex =~ m/[?*+{}()\\.|^\$[]/) {