Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/usr/bin/perl ## no critic VersionVar use strict; use warnings; use Getopt::Long 'GetOptions'; use autouse 'File::Find' => 'find'; use autouse 'Pod::Usage' => 'pod2usage'; use autouse 'Term::ANSIColor' => 'colored'; use autouse 'IPC::Open3' => 'open3'; $SIG{CHLD} = 'IGNORE'; use vars qw( $TextOnly ); main(); exit; sub main { # Fetch parameters. GetOptions( man => sub { pod2usage( -verbose => 2 ) }, help => sub { pod2usage( -verbose => 1 ) }, t => \$TextOnly, l => \my ($filename_only), w => \my ($word), i => \my ($ignore_case), Q => \my ($quotemeta), h => \my ($no_filename), n => \my ($line_no), R => \my ($no_recursive), v => \my ($invert_match), plain => \my ($no_ansicolor), 'name=s' => \my ($filename_rx), ) or pod2usage( -verbose => 0 ); my ( $match, @srcs ) = @ARGV; if ( not @srcs ) { @srcs = '.'; ## no critic Noisy } # Validate parameters. if ( not defined $match ) { pod2usage( -verbose => 0 ); } # Pre-process the pattern and then compile it. if ($quotemeta) { $match = quotemeta $match; } if ($word) { $match = "\\b$match\\b"; } if ($ignore_case) { $match = "(?i)$match"; } my $match_rx = qr/$match/; # Get a function which formats the output for whatever was # requested. All info is passed through the globals # $File::Find::rel_name, $., and $_. The input will contain # whatever linebreak is currently active so most things don't need # to add one. my $prev_file = ''; my $formatter = ( $line_no && $no_filename ? sub { "$.:" . shift } : $line_no ? sub { if ( $File::Find::name ne $prev_file ) { $prev_file = $File::Find::name; return ( ( $prev_file eq '' ? '' : "\n" ) . colored( $File::Find::name, 'bold green' ) . "\n +$.:" . shift ); } else { return "$.:" . shift; } } : $no_filename ? sub {shift} : $filename_only ? sub { if ( $File::Find::name ne $prev_file ) { $prev_file = $File::Find::name; return ( ( $prev_file eq '' ? '' : "\n" ) . colored( $File::Find::name, 'bold green' ) . "\n" ); } else { return; } } : sub { if ( $File::Find::name ne $prev_file ) { $prev_file = $File::Find::name; return ( ( $prev_file eq '' ? '' : "\n" ) . colored( $File::Find::name, 'bold green' ) . "\n +" . shift ); } else { return shift; } } ); my $grep_file_fn = sub { grep_file( ignore_rcs => 1, plain => $no_ansicolor, match_rx => $match_rx, filename_rx => $filename_rx, formatter => $formatter, invert_match => $invert_match, match_once => $filename_only ); }; # Here's the main loop. For each source directory/file, search it. for my $src (@srcs) { # Examine all files in $src. if ($no_recursive) { # Mimic the API of File::Find for grep_file(). # local $File::Find::dir = unimplemented ## no critic local $File::Find::name = $src; local $_ = $src; $grep_file_fn->(); } else { find( $grep_file_fn, $src ); } } return 0; } sub open_file_harder { my ($filename) = @_; return if not defined $filename; if ( my ($extension) = $filename =~ /(\.[^.]+)\z/mx ) { my @readers = ( [ qr/\.t(?:ar\.)?gz\z/ => qw( gzcat ), $filename ], [ qr/\.zip\z/, => qw( unzip -p ), $filename ], [ qr/\.Z\z/ => qw( zcat ), $filename ], [ qr/\.gz\z/ => qw( gzcat ), $filename ], [ qr/\.bz2\z/ => qw( bzcat ), $filename ], ); for my $reader (@readers) { my ( $pattern, @command ) = @{$reader}; if ( $extension =~ $pattern ) { open3( undef, my $fh, undef, @command ); return $fh; } } } open my $fh, '<', $filename or die "Couldn't open $filename: $!"; return $fh; } sub grep_file { my %p = @_; my $match_rx = $p{match_rx}; my $formatter = $p{formatter}; my $invert_match = $p{invert_match}; my $plain = $p{plain}; my $match_once = $p{match_once}; my $filename = $_; # Ignore CVS stuff. return if $File::Find::name =~ m{/CVS/?}; # If there is a pattern required of filenames, try that one # first. This requires no checks to the FS so I'm doing this # before the next stuff. return if defined $p{filename_rx} and not $filename =~ $p{filename_rx}; # Ignore non-existant files. return if not -f $filename; # Ignore non-text files if that's what was requested. return if $TextOnly and not -T _; eval { my $fh = open_file_harder($filename); LINE: while ( my $line = <$fh> ) { # If the line matches the pattern print it as a formatted # line. my $matched; if ($plain) { $matched = ( $line =~ /$match_rx/mx ); } else { $matched = ( $line =~ /$match_rx/mx ); $line =~ s/((?:$match_rx)+)/ colored( "$1", 'yellow on_b +lack' ) /gemx; } # Given Match then exclusive or is great here. # 0 1 # +---+---+ # Invert 0 | | X | # 1 | X | | if ( $matched xor $invert_match ) { print $formatter->($line); last LINE if $match_once; } } }; return 1; } __END__ =head1 NAME dgrep - A recursive grep that uses perl regular expressions. =head1 SYNOPSIS dgrep [options] [file ...] Options: -help Prints this help message -man Prints the manual -t Searches only `text' files -w Matches only "words" using \b...\b -i Case-insensitive matching -Q Ignore perl meta-characters -v Invert output, match lines that don't match the pattern -h Exclude filename from output -n Include line number in output -R Disable recursion, no directories. -plain Disable highliting of matched text -name EXPR Only open files matching this regular expression =head1 OPTIONS =over 4 =item B<-help> Prints a simple message on usage and then exits. =item B<-man> Prints the manual and then exits. =item B<-t> Only `text' files are searched. =item B<-w> When matching, the pattern is surrounded by perl\'s \b assertion. That is, the match must be on a "word" boundary, either starting or finishing. To perl, "word" is locale specific but generally means any alphanumeric character and underscore. =item B<-i> Match without regard to casing. This is affected by locale. =item B<-Q> Pattern is a literal string. All regex metacharacters will be escaped using the quotemeta() function. =item B<-v> Print only lines which do B<not> match the pattern. This is equivalent to grep\'s -v parameter. =item B<-h> Omit the filename from the output when a line is matched. This is semi-equivalent to grep\'s -h parameter. =item B<-n> Print the line number. =item B<-R> Do not recurse into any subdirectories. =item B<-plain> C<dgrep> automatically inserts ANSI escape codes to highlight matched text. Use the C<-plain> option to disable that. =item B<-name> EXPR C<dgrep> usually searches every file and directory, recursively. When C<-name EXPR> is used, only filenames matching this regular expression are searched. =back =head1 DESCRIPTION B<dgrep> is an "improved" version of the grep that comes with the Sun box. It is normally recursive, accepts perl regular expressions, and optionally prints the filename the match was found in. =cut

In reply to diotalevi's grep by diotalevi

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others chilling in the Monastery: (8)
    As of 2015-07-04 16:21 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (60 votes), past polls