Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
#!/usr/local/bin/perl =head1 NAME cgrep - print lines matching a pattern =head1 SYNOPSYS B<cgrep> [I<options>] I<PATTERN> [I<FILES>] =head1 DESCRIPTION B<Cgrep> searches for I<PATTERN> in text files, and prints matching li +nes. I<PATTERN> can be a perl regular expression, or a fixed string. B<Cgrep> reads all files specified in I<FILES>, or stdin if no I<FILES +> are given. Directories are ignored. Every line is matched with I<PATTERN> separately. I<PATTERN> is interpreted as a perl regular expression by default, but as a fixed string if the B<-F> flag is set. In normal operation mode, B<cgrep> p +rints matching lines. Exit code is 0 if any matches are found, 1 if no matc +hes were found. =head1 OPTIONS Long options can be abbreviated to a unique prefix, and can be negated with a B<no-> prefix. A double hyphen stops option processing +, allowing you to use filenames starting with a minus. =over =item B<-A> I<NUM1>, B<--after-context=>I<NUM1>; B<-B> I<NUM2>, B<--before-context=>I<NUM2> Print context lines around matches, as with B<-C>. These options, however, set the number of context lines after and before matches to I<NUM1> and I<NUM2> respectively. If only one of the options is given, context lines will be printed only after or only before the match resp. =item B<-C> I<NUM>, B<--context=>I<NUM> Print I<NUM> lines of context before and after each match. Also, print a line with a lone dash between continuous chunks of lines. If any of B<-n>, B<-h>, B<-p>, B<-P> is enabled, the separator before the line and the prefixes will be a colon on matching lines, and a hyphen in context lines. =item B<-e> I<PATTERN>, B<--pattern=>I<PATTERN> A different way to specify I<PATTERN>. If this option is used, all non-option arguments are filenames. If not used, the first non-option argument is the I<PATTERN>. =item B<-E>, B<--perl-regexp> Interpret I<PATTERN> as a perl regexp. This is the default. Perl regexps are NFA, see L<perlre(1)> for details of syntax and seman +tics. =item B<-F>, B<--fixed-strings> Interpret I<PATTERN> as fixed string, not a regexp. =item B<-h>, B<--with-no-filename> Do not print filename before each line printed. This is the default if there is only one I<FILE> given. =item B<-H>, B<--with-filename> Print filename before each line. This is the default if more than one I<FILES> are given. =item B<-i>, B<--fold-case> Interpret I<PATTERN> case insensitively. Works with both regexp pattern and fixed strings. =item B<-l>, B<--files-with-match> Print the lists of files that have any matching lines. Stop reading the file at the first match. This supresses normal operation mode, that is, printing matching lines. The options B<-ABChHnpP> do not make sense in combination with B<-l>. =item B<-L>, B<--files-without-match> Prints the lists of files having no matching lines. Similar to B<-l> otherwise. =item B<-n>, B<--line-number> Print line number before each line printed. =item B<-p>, B<--show-function> Prints current function name before each line. =item B<-P> I<REGEXP>, B<--function-regexp=>I<REGEXP> Defines how function names are found. Implies B<-p>. Lines matching I<REGEXP> are taken to be function headers. I<REGEXP> is a perl regexp, unaffected by B<-F>, B<-i>, B<-v>. The last matching capture in it should return the function name. The default regexp is C<^(\w+)>, suitable for C. =item B<-s>, B<--no-messages> Do not print warnings about files that can't be opened. =item B<-q>, B<--silent> Do not print anything, just give the return value. Stops execution at very first match. =item B<-v>, B<--invert-match> Inverts the sense of the match, that is, searches for line not matching I<PATTERN> =back =head1 SEE ALSO L<egrep(1)>, L<perlre(1)> =head1 AUTHOR <> =cut use warnings; use strict; use Getopt::Long; use IO::Handle; { my($cregexp, @filenames, $complement, $found_any, $match, $endfile, $print_filename, $print_lineno, $before_context, $after_context, $context, $hush_messages, $print_func, $func_cregexp, $file, $filename, $anyoutput, $lastoutput); sub main { parseopts(); $found_any = 0; !@filenames and @filenames = undef; for my $n (@filenames) { $filename = $n; if (defined($filename)) { open $file, "<", $n or do { $hush_messages or warn qq[error opening file "$n": $!] +; next; }; } else { $file = *STDIN; } -d $file and next; process_file(); close $file; } !$found_any; } sub process_file { my($line, $func, $m, @before, $b, $after); ($after, $func, $lastoutput) = (0, undef, -1); READ: { while (defined($line = <$file>)) { chomp $line; $print_func and $line =~ /$func_cregexp/ and $func = $+; $m = $line =~ /$cregexp/; if ($m xor $complement) { $found_any = 1; $context and do { for $b (@before) { &$match(@$b[0, 1, 2]), 0 } @before = (); $after = $after_context; }; &$match($line, input_line_number $file, $func, 1); } else { $context and do { if (0 < $after) { &$match($line, input_line_number $file, $func, 0); $after--; } else { push @before, [$line, input_line_number $file, $fu +nc]; $before_context < @before and shift @before; } }; } } &$endfile() } } sub nextfile { no warnings "exiting"; last READ; } sub print_match { my($line, $lineno, $func, $m) = @_; $context and do { $lastoutput != $lineno - 1 && $anyoutput and print "--\n"; $anyoutput = 1; $lastoutput = $lineno; }; $print_filename and print $filename, $m ? ":" : "-"; $print_func and defined($func) and print $func, $m ? ":" : "-"; $print_lineno and print $lineno, $m ? ":" : "-"; print $line, "\n"; } sub print_name_exit { $_[3] or return; print $filename, "\n"; nextfile; } sub found_exit { $_[3] or return; nextfile; } sub found_exit_zero { $_[3] or return; return 0; } sub print_filename { print $filename, "\n"; } sub noop { } sub parseopts { my($regexp, $plain, $ignorecase, $mods, $mode); ($before_context, $after_context, $mode, $func_cregexp) = (0, 0, " +", qr/^(\w+)/); Getopt::Long::Configure "bundling", "gnu_compat", "prefix_pattern= +(--|-)"; GetOptions( "fixed-strings|F!", sub { $plain = $_[1] }, "extended-regexp|perl-regexp|E!", sub { $plain = !$_[1] }, "pattern|e=s", sub { $regexp = $_[1] }, "invert-match|complement-match|v!", sub { $complement = $_[1] +}, "filename|with-filename|H!", sub { $print_filename = $_[1] }, "with-no-filename|h!", sub { $print_filename = !$_[1] }, "igore-case|fold-case|y|i!", sub { $ignorecase = $_[1] }, "line-number|n!", sub { $print_lineno = $_[1]; }, "context|C=n", sub { $after_context = $before_context = $_[1] +}, "after-context|A=n", sub { $after_context = $_[1] }, "before-context|B=n", sub { $before_context = $_[1] }, "files-with-match|list|l!", sub { $mode = $_[1] ? "l" : "" }, "file-without-match|missing|L!", sub { $mode = $_[1] ? "L" : " +" }, "quiet|silent|q", sub { $mode = $_[1] ? "q" : "" }, "no-messages|hush-messages|s", sub { $hush_messages = $_[1] }, "show-function|function|p!", sub { $print_func = $_[1] }, "function-regexp|P=s", sub { $func_cregexp = qr/$_[1]/; $print +_func = 1 }, ); defined($regexp) or $regexp = shift @ARGV; defined($regexp) or die 'required argument missing; usage: cgrep [ +options] regexp [filenames]'; !$plain && $regexp=~/\<|\>/ and do { $hush_messages or warn 'warning: \< and \> are not special i +n perl regexen' }; $plain and $regexp = quotemeta $regexp; $mods = $ignorecase ? "i" : ""; $cregexp = qr/(?$mods:$regexp)/; @filenames = @ARGV; defined($print_filename) or $print_filename = 1 < @filenames; 0 < $before_context || 0 < $after_context and do { $context = 1; $before_context ||= 0; $after_context ||= 0; }; $endfile = \&noop; if ($mode eq "l") { $match = \&print_name_exit } elsif ($mode eq "L") { ($match, $endfile) = (\&found_exit, \&print_filename) } elsif ($mode eq "q") { $match = \&found_exit_zero } elsif ($mode eq "") { $match = \&print_match } else { die "internal error: invalid mode: $mode" } } exit main(); } __END__

In reply to cgrep: Egrep clone with function name display by ambrus

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

  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?

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

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (2)
As of 2023-03-29 20:25 GMT
Find Nodes?
    Voting Booth?
    Which type of climate do you prefer to live in?

    Results (72 votes). Check out past polls.