home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / vile-src.zip / vile-8.1 / perl / hgrep.pl < prev    next >
Perl Script  |  1998-04-30  |  4KB  |  148 lines
  1. #!/usr/bin/perl -w
  2. #
  3. # hgrep.pl
  4. #
  5. #   This script is meant to be used with [x]vile's perl interface to
  6. #   provide a nifty recursive grep facility complete with hypertext
  7. #   links.
  8. #
  9. #   One of the things which makes it so nifty is that it doesn't
  10. #   search binary files.  (If you want it to, just search for and
  11. #   remove the -T in the code below.)  So it's perfectly safe to
  12. #   just search * in most cases rather than using a restrictive
  13. #   filter like *.[hc]
  14. #
  15. # Installation
  16. # ------------
  17. #   
  18. #   Place hgrep.pl, glob2re.pl, and visit.pl in either ~/.vile/perl
  19. #   or in /usr/local/share/vile/perl.  (The exact location of the
  20. #   latter may vary depending on how you configured [x]vile.
  21. #
  22. # Usage
  23. # -----
  24. #
  25. #   hgrep will be easier to use if the following procedure is defined
  26. #   in your .vilerc file:
  27. #
  28. #   store-procedure hgrep
  29. #       perl "require 'hgrep.pl'"
  30. #       perl hgrep
  31. #    ; uncomment next line to use results with error-finder.
  32. #    ; error-buffer $cbufname
  33. #   ~endm
  34. #
  35. #   Once this procedure, is defined, just type
  36. #
  37. #    :hgrep
  38. #
  39. #   and answer the ensuing questions.
  40. #
  41. #   A new buffer will be created with embedded hypertext commands to
  42. #   vist the places in the files where matched text is found.  These
  43. #   hypertext commands may be activated by double clicking in xvile
  44. #   or using the "execute-hypertext-command" command from vile.  (See
  45. #   the Hypertext section of vile.hlp for some convenient key bindings.)
  46. #
  47. # Additional Notes
  48. # ----------------
  49. #   
  50. #   As not much has been written about it yet, this module is an
  51. #   example of how to use the perl interface.
  52. #
  53. #                - kev (4/3/1998)
  54. #
  55.  
  56.  
  57. use File::Find;
  58. use FileHandle;
  59. use English;
  60. require 'glob2re.pl';
  61. require 'visit.pl';
  62.  
  63. my $rgrep_oldspat = '';
  64. my $rgrep_oldroot = '.';
  65.  
  66. sub hgrep {
  67.  
  68.     my ($spat, $root, $fpat) = @_;
  69.  
  70.     if (!defined($spat)) {
  71.     $spat = Vile::mlreply_no_opts("Pattern to search for? ", $rgrep_oldspat);
  72.     return if !defined($spat);
  73.     }
  74.     $rgrep_oldspat = $spat;
  75.  
  76.     while (!defined($root)) {
  77.     $root = Vile::mlreply_dir("Directory to search in? ", $rgrep_oldroot);
  78.     return if !defined($root);
  79.     }
  80.     $rgrep_oldroot = $root;
  81.  
  82.     while (!defined($fpat)) {
  83.     $fpat = Vile::mlreply_no_opts("File name pattern? ", "*");
  84.     return if !defined($fpat);
  85.     }
  86.  
  87.     my $resbuf = new Vile::Buffer "rgrep $spat $root $fpat";
  88.  
  89.     print $resbuf "Results of searching for /$spat/ in $root with filter $fpat...\n---------------\n";
  90.  
  91.     $fpat = glob2re($fpat);
  92.  
  93.     my $code = '
  94.     find(
  95.     sub { 
  96.         if (-f && -T && $_ ne "tags" && /' 
  97.     .                  $fpat 
  98.     .                      '/) {
  99.         my $fname = $File::Find::name;
  100.         if (open SFILE, "<$_") {
  101.             local($_);
  102.             while (<SFILE>) {
  103.             if (/' 
  104.     .                        $spat
  105.     .                            '/) {
  106.                 chomp;
  107.                 s/^(.*?)('
  108.     .                    $spat
  109.     .                                ')/$1 . "\x01" 
  110.                                            . length($2) 
  111.                                            . q#BHperl "visit(\'#
  112.                        . $fname
  113.                        . qq(\',) 
  114.                        . $INPUT_LINE_NUMBER
  115.                        . q(,)
  116.                        . length($1)
  117.                        . qq#)"\0:#
  118.                        . $2/e;
  119.                 print $resbuf "$fname\[$INPUT_LINE_NUMBER]: $_\n";
  120.             }
  121.             }
  122.             close SFILE;
  123.         }
  124.         else {
  125.             print $resbuf "Warning: Can\'t open $fname\n";
  126.             #print "Warning: Can\'t open $fname\n");
  127.         }
  128.         }
  129.     },
  130.     $root);
  131.     ';
  132.  
  133.     eval $code;
  134.     if (defined($@) && $@) {
  135.     print "$@";
  136.     }
  137.     else {
  138.     print $resbuf "\n\n";
  139.     $Vile::current_buffer = $resbuf;
  140.     $resbuf->setregion(1,'$')
  141.            ->attribute_cntl_a_sequences
  142.            ->unmark
  143.            ->dot(3);
  144.     }
  145. }
  146.  
  147. 1;
  148.