home *** CD-ROM | disk | FTP | other *** search
- @REM=(qq!
- @perl286 %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
- @goto end !) if 0 ;
- #
- # MS-DOS batch header and footer material added by Duane Paulson.
- #
- # Note that the compressed file feature mentioned below refers to the Unix
- # compression program. Rgrep, _as written_, will not handle such things as
- # ZIP or ARC files.
- #
- # ------------------------------------------------------------------------
- # Path: tut.cis.ohio-state.edu!pacific.mps.ohio-state.edu!zaphod.mps.ohio-state.edu!sdd.hp.com!decwrl!uunet!mcsun!hp4nl!ruuinf!piet
- # From: piet@cs.ruu.nl (Piet van Oostrum)
- # Newsgroups: comp.lang.perl
- # Subject: Recursive grep in perl
- # Message-ID: <3985@ruuinf.cs.ruu.nl>
- # Date: 8 Oct 90 17:03:21 GMT
- # Sender: news@ruuinf.cs.ruu.nl
- # Reply-To: piet@cs.ruu.nl (Piet van Oostrum)
- # Organization: Dept of Computer Science, Utrecht University, The Netherlands
- # Lines: 191
- #
- # This is my 'recursive grep'. At first sight it is a "find -exec egrep"
- # replacement. Actually it does things that can't be done with the find/egrep
- # combination:
- # It silently skips binary files (unless told not to)
- # It uncompresses compressed file while scanning
- # It allows / in filename patters e.g. search in all files src/*.c
- # It allows real perl regexps for filename patterns
- # ------------------------------------------------------------------------
-
-
-
- die "Usage: rgrep [-iredblL] regexp filepat ...\n rgrep -h for help\n"
- if $#ARGV < $[;
-
- # Written by Piet van Oostrum <piet@cs.ruu.nl>
- # This is really free software
-
- $nextopt = 1;
- $igncase = '';
- $regpat = 0;
- $links = 0;
- $error = 0;
- $skipbin = 1;
- $debug = 0;
-
- do { $regexp = shift (@ARGV); } while &checkopt ($regexp);
- $icreg = $igncase;
- $igncase = '';
-
- eval 'sub grep_file {
- while (<F>) {
- $ln++;
- if (/$regexp/o' . $icreg .') {
- print "$file:$ln:$_";
- print "\n" if substr($_, -1, 1) ne "\n";
- }
- }
- }';
-
- for (@ARGV) {
- if (! &checkopt ($_)) {
- if ($igncase || $regpat || /[?*[]/ || ! -e) {
- if ($regpat) {
- s/#/\\#/g;
- $_ = "#$_#";
- } else { # translate File pattern into regexp
- $re = '#($|/)'; $save = $_;
- while (/[[*?+()|.^$#]/) {
- $re .= $`;
- $c = $&;
- $_ = $';
- if ($c eq '*') { $c = '[^/]*'; }
- elsif ($c eq '?') { $c = '[^/]'; }
- elsif ($c eq '[') {
- if (/.\]/) { $c = "[$`$&"; $_ = $'; }
- else {
- $error++;
- printf stderr "Illegal filepattern %s\n", $save;
- }
- } else { $c = "\\$c"; }
- $re .= $c;
- }
- $_ = "$re$_\$#$igncase";
- }
- print "filepat: $_\n" if $debug;
- push (@filepat, $_);
- }
- else { push (@files, $_); print "file: $_\n" if $debug; }
- }
- }
-
- exit 1 if $errors ;
-
- if ($#filepat < $[) {
- eval "sub in_pat {1;}" ;
- }
- else {
- $subtxt = 'sub in_pat { local ($f) = @_;';
- $or = "";
- for (@filepat) {
- $subtxt .= $or . '$f =~ m' . $_;
- $or = " || ";
- }
- $subtxt .= ';};1';
-
- if (! eval $subtxt) {
- print $@;
- exit 1;
- }
- }
-
- @files = (".") if $#files < $[;
-
- for $file (@files) {
- &do_grep ($file);
- }
-
- sub do_grep {
- local ($file) = @_;
- local (*F, $ln, $f, $g, @dirfiles);
- if (-f $file) {
- if (open (F, $file)) {
- if (-B F) { # binary file -- may be compressed/compacted
- if (($cx1 = getc(F)) eq "\377" && (getc(F) eq "\037")) {
- open (F, "uncompact < $file|");
- if ($skipbin && -B F) { close (F); return; }
- }
- elsif ($cx1 eq "\037" && (getc(F) eq "\235")) {
- open (F, "uncompress < $file|");
- if ($skipbin && -B F) { close (F); return; }
- }
- elsif ($skipbin) {
- close (F); return;
- }
- }
- print "Reading $file\n" if $debug;
- &grep_file;
- } else {
- print stderr "Cannot open $file\n";
- }
- }
- elsif (-d $file) {
- print "Entering $file\n" if $debug;
- if (opendir (F, $file)) {
- @dirfiles = readdir (F);
- closedir (F);
- for $f (@dirfiles) {
- next if ($f eq '.' || $f eq '..');
- $g = "$file/$f";
- next if (-l $g && ($links < 1 || $links == 1 && -d $g));
- if (-f $g && &in_pat ($g) || -d _) {
- &do_grep ($g);
- }
- }
- } else {
- print stderr "Can't open $file\n";
- }
- }
- }
-
- sub checkopt {
- local ($_) = $_[0];
- if (/^-/ && $nextopt) {
- $nextopt = 1;
- @opt = split (/-*/,$_); shift (@opt);
- for $opt (@opt) {
- if ($opt eq 'i') { $igncase = 'i'; }
- elsif ($opt eq 'd') { $debug = 1; }
- elsif ($opt eq 'l') { $links = 1; }
- elsif ($opt eq 'L') { $links = 2; }
- elsif ($opt eq 'b') { $skipbin = 0; }
- elsif ($opt eq 'r') { $regpat = 1; }
- elsif ($opt eq 'e') { $nextopt = 0; }
- elsif ($opt eq 'h' || $opt eq 'H') { & help; }
- else { $error++; printf stderr "Unknown option -%s\n", $opt; }
- }
- return 1;
- }
- $nextopt = 1;
- return 0;
- }
-
- sub help {
- print <<'HELP'; exit 0;
- Usage: rgrep [-iredblL] regexp filepat ...
- regexp = perl regular expression to search
- filepat ... = a list of files and directories to be searched or
- file patterns to match filenames.
- filepat will be interpreted as file or directory name if it exists
- as such, and does not contain the metacharacters [ ] ? or *. After
- the options -i and -r all filepats will be considered patterns.
- rgrep will search all files in any of the directories given (and its
- subdirectories) that match any of the filepats, except binary files.
- Compressed files will be searched in uncompressed form.
- Note: filepats may contain / contrary to find usage.
- -b Don't skip binary files.
- -i Ignore case, either in the regexp or in filename matching (depending
- on the location). Before the regexp only applies to the regexp,
- otherwise to the filepats following it.
- -r The following filepats are treated as real perl regexps rather than
- shell style filename patterns. In this case / is not a special
- character, i.e. it is matched by . and matching is not anchored (you
- must supply ^ and $ yourself). E.g. a.b matches the file /xa/by/zz.
- -l Do follow symbolic links only for files (default is do not follow).
- -L Do follow symbolic links for files and directories.
- -e Do not interpret following argument as option. Useful if regexp or
- filepat starts with a -.
- -d Debugging: Give a lot of output on what happens.
- -h print this message and exit.
- Piet van Oostrum <piet@cs.ruu.nl>
- HELP
- }
-
- @REM=(qq!
- :end !) if 0 ;