warn "$0: warning, can't underline-safe ``$regex''.\n";	     } else {		$regex = join($underline_glue, split(//, $regex));	     }	  }	  ## If nothing special in the regex, just use index...	  ## is quite a bit faster.	  if (($iflag eq '') && ($words == 0) &&			$regex !~ m/[?*+{}()\\.|^\$[]/)	  {	      push(@regex_tests, "(index(\$_, q+$regex+)>=0)");	  } else {	      $regex =~ s#[\$\@\/]\w#\\$&#;	      if ($words) {		  if ($regex =~ m/\|/) {		      ## could be dangerous -- see if we can wrap in parens.		      if ($regex =~ m/\\\d/) {			  warn "warning: -w and a | in a regex is dangerous.\n"		      } else {			  $regex = join($regex, '(', ')');		      }		  }		  $regex = join($regex, '\b', '\b');	      }	      $CAN_USE_FAST_LISTONLY = 0 if substr($regex, "[^") >= 0;	      push(@regex_tests, "m/$regex/$iflag$mflag");	  }	  ## If we're done, but still have @extra to do, get set for that.	  if (@ARGV == 0 && @extra) {	      @ARGV = @extra;   ## now deal with the extra stuff.	      $underlineOK = 0; ## but no more of this.	      undef @extra;     ## or this.	  }      }      if (@regex_tests) {	  $REGEX_TEST = join('||', @regex_tests);	  ## print STDERR $REGEX_TEST, "\n"; exit;      } else {	  ## must be doing -find -- just give something syntactically correct.	  $REGEX_TEST = 1;      }  }  ##  ## Make sure we can read the first item(s).  ##  foreach $start (@todo) {      $! = 2, die qq/$0: can't stat "$start"\n/	  unless ($dev,$inode) = (stat($start))[$STAT_DEV,$STAT_INODE];      if (defined $dir_done{"$dev,$inode"}) {	  ## ignore the repeat.	  warn(qq/ignoring "$start" (same as "$dir_done{"$dev,$inode"}").\n/)		if $VERBOSE;	  next;      }      ## if -xdev was given, remember the device.      $xdev{$dev} = 1 if $XDEV;      ## Note that we won't want to do it again      $dir_done{"$dev,$inode"} = $start;  }}#### See the comment above the __END__ above the 'sub dodir' below.##sub import_program{    sub bad {	print STDERR "$0: internal error (@_)\n";	exit 2;    }    ## Read from data, up to next __END__. This will be &dodir.    local($/) = "\n__END__";    $prog = <DATA>;    close(DATA);    $prog =~ s/\beval\b//g;       ## remove any 'eval'    ## Inline uppercase $-variables by their current values.    if ($] >= 5) {	$prog =~ s/\$([A-Z][A-Z0-9_]{2,}\b)/		    &bad($1) if !defined ${$main::{$1}}; ${$main::{$1}};/eg;    } else {	$prog =~ s/\$([A-Z][A-Z0-9_]{2,}\b)/local(*VAR) = $_main{$1};		    &bad($1) if !defined $VAR; $VAR;/eg;    }    eval $prog;  ## now do it. This will define &dodir;    $!=2, die "$0 internal error: $@\n" if $@;}############################################################################### Read the .search file:##    Blank lines and lines that are only #-comments ignored.##    Newlines may be escaped to create long lines##    Other lines are directives.####    A directive may begin with an optional tag in the form <...>##    Things inside the <...> are evaluated as with:##	   <(this || that) && must>##    will be true if##       -xmust -xthis   or   -xmust -xthat##    were specified on the command line (order doesn't matter, though)##    A directive is not done if there is a tag and it's false.##    Any characters but whitespace and &|()>,! may appear after an -x##    (although "-xdev" is special).  -xmust,this is the same as -xmust -xthis.##    Something like -x~ would make <~> true, and <!~> false.####    Directives are in the form:##      option: STRING##	magic : NUMBYTES : EXPR####    With option:##      The STRING is parsed like a Bourne shell command line, and the##      options are used as if given on the command line.##      No comments are allowed on 'option' lines.##	Examples:##	    # skip objects and libraries##	    option: -skip '.o .a'##	    # skip emacs *~ and *# files, unless -x~ given:##	    <!~> option: -skip '~ #'####    With magic:##	EXPR can be pretty much any perl (comments allowed!).##      If it evaluates to true for any particular file, it is skipped.##      The only info you'll have about a file is the variable $H, which##      will have at least the first NUMBYTES of the file (less if the file##      is shorter than that, of course, and maybe more). You'll also have##      any variables you set in previous 'magic' lines.##	Examples:##	    magic: 6 : ($x6 = substr($H, 0, 6)) eq 'GIF87a'##	    magic: 6 :  $x6                     eq 'GIF89a'####          magic: 6 : (($x6 = substr($H, 0, 6)) eq 'GIF87a' ## old gif \##		                         || $x6  eq 'GIF89a' ## new gif##	(the above two sets are the same)##	    ## Check the first 32 bytes for "binarish" looking bytes.##	    ## Don't blindly dump on any high-bit set, as non-ASCII text##	    ## often has them set. \x80 and \xff seem to be special, though.##	    ## Require two in a row to not get things like perl's $^T.##	    ## This is known to get *.Z, *.gz, pkzip, *.elc and about any##	    ## executable you'll find.##	    magic: 32 : $H =~ m/[\x00-\x06\x10-\x1a\x1c-\x1f\x80\xff]{2}/##sub read_rc{    local($file, $show) = @_;    local($line_num, $ln, $tag) = 0;    local($use_default, @default) = 0;    { package magic; $^W= 0; } ## turn off warnings for when we run EXPR's    unless (open(RC, "$file")) {	$use_default=1;	$file = "<internal default startup file>";	## no RC file -- use this default.	@default = split(/\n/,<<'--------INLINE_LITERAL_TEXT');            magic: 32 : $H =~ m/[\x00-\x06\x10-\x1a\x1c-\x1f\x80\xff]{2}/	    option: -skip '.a .COM .elc .EXE .gz .o .pbm .xbm .dvi'	    option: -iskip '.tarz .zip .z .lzh .jpg .jpeg .gif .uu'	    <!~> option: -skip '~ #'--------INLINE_LITERAL_TEXT    }    ##    ## Make an eval error pretty.    ##    sub clean_eval_error {	local($_) = @_;	s/ in file \(eval\) at line \d+,//g; ## perl4-style error	s/ at \(eval \d+\) line \d+,//g;     ## perl5-style error	$_ = $` if m/\n/;                    ## remove all but first line	"$_\n";    }    print "reading RC file: $file\n" if $show;    while (defined($_ = ($use_default ? shift(@default) : <RC>))) {	$ln = ++$line_num;			     ## note starting line num.        $_ .= <RC>, $line_num++ while s/\\\n?$/\n/;  ## allow continuations	next if /^\s*(#.*)?$/;          ## skip blank or comment-only lines.        $do = '';		## look for an initial <...> tag.	if (s/^\s*<([^>]*)>//) {	    ## This simple s// will make the tag ready to eval.	    ($tag = $msg = $1) =~		s/[^\s&|(!)]+/			$seen_opt{$&}=1;         ## note seen option			"defined(\$opt{q>$&>})"  ## (q>> is safe quoting here)		/eg;	    	    ## see if the tag is true or not, abort this line if not.	    $dothis = (eval $tag);	    $!=2, die "$file $ln <$msg>: $_".&clean_eval_error($@) if $@;	    if ($show) {	        $msg =~ s/[^\s&|(!)]+/-x$&/;	        $msg =~ s/\s*!\s*/ no /g;	        $msg =~ s/\s*&&\s*/ and /g;	        $msg =~ s/\s*\|\|\s*/ or /g;		$msg =~ s/^\s+//; $msg =~ s/\s+$//;		$do = $dothis ? "(doing because $msg)" :				"(do if $msg)";	    } elsif (!$dothis) {	        next;	    }	}	if (m/^\s*option\s*:\s*/) {	    next if $all && !$show; ## -all turns off these checks;	    local($_) = $';            s/\n$//;	    local($orig) = $_;	    print " $do option: $_\n" if $show;	    local($0) = "$0 ($file)"; ## for any error message.	    local(@ARGV);	    local($this);	    ##	    ## Parse $_ as a Bourne shell line -- fill @ARGV	    ##	    while (length) {		if (s/^\s+//) {		    push(@ARGV, $this) if defined $this;		    undef $this;		    next;		}		$this = '' if !defined $this;		$this .= $1 while s/^'([^']*)'// ||				  s/^"([^"]*)"// ||				  s/^([^'"\s\\]+)//||				  s/^(\\[\D\d])//;		die "$file $ln: error parsing $orig at $_\n" if m/^\S/;	    }	    push(@ARGV, $this) if defined $this;	    &check_args;	    die qq/$file $ln: unused arg "@ARGV".\n/ if @ARGV;	    next;	}	if (m/^\s*magic\s*:\s*(\d+)\s*:\s*/) {	    next if $all && !$show; ## -all turns off these checks;	    local($bytes, $check) = ($1, $');	    if ($show) {		$check =~ s/\n?$/\n/;		print " $do contents: $check";	    }	    ## Check to make sure the thing at least compiles.	    eval  "package magic; (\$H = '1'x \$main'bytes) && (\n$check\n)\n";	    $! = 2, die "$file $ln: ".&clean_eval_error($@) if $@;	    $HEADER_BYTES = $bytes if $bytes > $HEADER_BYTES;	    push(@magic_tests, "(\n$check\n)");	    next;	}	$! = 2, die "$file $ln: unknown command\n";    }    close(RC);}sub message{    if (!$STDERR_IS_TTY) {	print STDERR $_[0], "\n";    } else {	local($text) = @_;	$thislength = length($text);	if ($thislength >= $last_message_length) {	    print STDERR $text, "\r";	} else {	    print STDERR $text, ' 'x ($last_message_length-$thislength),"\r";	}		$last_message_length = $thislength;    }}sub clear_message{    print STDERR ' ' x $last_message_length, "\r" if $last_message_length;    $vv_print = $vv_size = $last_message_length = 0;}#### Output a copy of this program with comments, extra whitespace, and## the trailing man page removed. On an ultra slow machine, such a copy## might load faster (but I can't tell any difference on my machine).##sub strip {    seek(DATA, 0, 0) || die "$0: can't reset internal pointer.\n";    while(<DATA>) {      print, next if /INLINE_LITERAL_TEXT/.../INLINE_LITERAL_TEXT/;      ## must mention INLINE_LITERAL_TEXT on this line!      s/\#\#.*|^\s+|\s+$//; ## remove cruft      last if $_ eq '.00;';      next if ($_ eq '') || ($_ eq "'di'") || ($_ eq "'ig00'");      s/\$stripped=0;/\$stripped=1;/;      s/\s\s+/ /;  ## squish multiple whitespaces down to one.      print $_, "\n";    }    exit(0);}#### Just to shut up -w. Never executed.##sub dummy {    1 || &dummy || &dir_done || &bad || &message || $NEXT_DIR_ENTRY ||    $DELAY || $VV_SIZE || $VV_PRINT_COUNT || $STDERR_SCREWS_STDOUT ||    @files || @files || $magic'H || $magic'H || $xdev{''} || &clear_message;}#### If the following __END__ is in place, what follows will be## inlined when the program first starts up. Any $ variable name## all in upper case, specifically, any string matching##	\$([A-Z][A-Z0-9_]{2,}\b## will have the true value for that variable inlined. Also, any 'eval' is## removed#### The idea is that when the whole thing is then eval'ed to define &dodir,## the perl optimizer will make all the decisions that are based upon## command-line options (such as $VERBOSE), since they'll be inlined as## constants#### Also, and here's the big win, the tests for matching the regex, and a## few others, are all inlined. Should be blinding speed here.#### See the read from <DATA> above for where all this takes place.## But all-in-all, you *want* the __END__ here. Comment it out only for## debugging....##__END__#### Given a directory, check all "appropriate" files in it.## Shove any subdirectories into the global @todo, so they'll be done## later.#### Be careful about adding any upper-case variables, as they are subject## to being inlined. See comments above the __END__ above.##sub dodir{  local($dir) = @_;  $dir =~ s,/+$,,; ## remove any trailing slash.  unless (opendir(DIR, "$dir/.")) {      &clear_message if $VERBOSE && $STDERR_SCREWS_STDOUT;      warn qq($0: can't opendir "$dir/".\n);      return;  }  if ($VERBOSE) {      &message($dir);      $vv_print = $vv_size = 0;  }  @files = sort readdir(DIR) if $DO_SORT;  while (defined($name = eval $NEXT_DIR_ENTRY))  {    next if $name eq '.' || $name eq '..'; ## never follow these.    ## create full relative pathname.    $file = $dir eq '.' ? $name : "$dir/$name";    ## if link and skipping them, do so.    if ($NOLINKS && -l $file) {	warn qq/skip (symlink): $file\n/ if $WHY;	next;    }    ## skip things unless files or directories    unless (-f $file || -d _) {	if ($WHY) {	    $why = (-S _ && "socket")       ||		   (-p _ && "pipe")         ||		   (-b _ && "block special")||		   (-c _ && "char special") || "somekinda special";	    warn qq/skip ($why): $file\n/;	}	next;    }    ## skip things we can't read    unless (-r _) {	if ($WHY) {	    $why = (-l $file) ? "follow" : "read";	    warn qq/skip (can't $why): $file\n/;	}	next;    }    ## skip things that are empty    unless (-s _ || -d _) {	warn qq/skip (empty): $file\n/ if $WHY;	next;    }    ## Note file device & inode. If -xdev, skip if appropriate.    ($dev, $inode) = (stat(_))[$STAT_DEV, $STAT_INODE];    if ($XDEV && defined $xdev{$dev}) {	warn qq/skip (other device): $file\n/ if $WHY;	next;    }    $id = "$dev,$inode";    ## special work for a directory    if (-d _) {	## Do checks for directory file endings.	if ($DO_DSKIP_TEST && (eval $DSKIP_TEST)) {	    warn qq/skip (-dskip): $file\n/ if $WHY;	    next;	}	## do checks for -name/-regex/-path tests	if ($DO_DGLOB_TESTS && !(eval $DGLOB_TESTS)) {	    warn qq/skip (dirname): $file\n/ if $WHY;	    next;	}	## _never_ redo a directory	if (defined $dir_done{$id} and $^O ne 'MSWin32') {	    warn qq/skip (did as "$dir_done{$id}"): $file\n/ if $WHY;	    next;	}	$dir_done{$id} = $file;     ## mark it done.	unshift(@todo, $file);	    ## add to the list to do.	next;    }    if ($WHY == 0  && $VERBOSE > 1) {      if ($VERBOSE>2||$vv_print++>$VV_PRINT_COUNT||($vv_size+=-s _)>$VV_SIZE){	  &message($file);	  $vv_print = $vv_size = 0;      }    }    ## do time-related tests    if ($NEWER || $OLDER) {	$_ = (stat(_))[$STAT_MTIME];	if ($NEWER && $_ < $NEWER) {	    warn qq/skip (too old): $file\n/ if $WHY;	    next;	}	if ($OLDER && $_ > $OLDER) {	    warn qq/skip (too new): $file\n/ if $WHY;	    next;	}    }    ## do checks for file endings    if ($DO_SKIP_TEST && (eval $SKIP_TEST)) {	warn qq/skip (-skip): $file\n/ if $WHY;	next;    }