view release on metacpan or  search on metacpan

bin/podgrep  view on Meta::CPAN

#!/usr/bin/env perl
# podgrep -- grep in pod sections only

# ------ pragmas
use strict;
use warnings;
use Getopt::Std  qw(getopts);

our $VERSION = '2.2.0';

# ------ define variables
my $chunk        = undef;	# chunk count
my $file         = undef;	# file name
my $inmatch      = undef;	# TRUE if inside match
my $inpod        = undef;	# TRUE if inside POD
my $only_header  = undef;	# copy of $opt_h
our $opt_f       = undef;	# output plain text, paged if -p
our $opt_h       = undef;	# output only POD headers
our $opt_i       = undef;	# case-insensitive pattern
our $opt_p       = undef;	# use $ENV{PAGER} to page output
my $orig_pattern = undef;	# original pattern to search for
my $pager        = undef;	# contents of $ENV{PAGER}
my $pattern      = undef;	# pattern to search for


getopts("fhpi") 
  || die "usage: $0 [-i] [-f] [-h] [-p] pattern [podfiles ...]";

$/ = '';
$only_header = $opt_h;
$orig_pattern = $pattern = shift;
$pattern  = '^=.*' . $pattern if $only_header;
$pattern .= '(?i)' if $opt_i;

if ($opt_p) {
    unless ($pager = $ENV{PAGER}) {
    	require Config;
        {
            no warnings qw(once);
    	    $pager = $Config::Config{"pager"} || "more";
        }
    } 
} 

if ($opt_f) {
    if ($opt_p) {
	open(STDOUT, "| pod2text | $pager '+/$orig_pattern'");
    } else {
	open(STDOUT, "| pod2text");
    } 

} 
elsif ($opt_p) {
    open(STDOUT, "| $pager '+/$orig_pattern'");
} 


($file, $chunk) = ('-', 0);

while (<>) {
    if ($inpod && /^=cut/) {
	$inmatch = $inpod = 0;
	next;
    } 

    if (! $inpod && /^=(?!cut)\w+/) {
	$inpod = 1;
    } 

    if ($inmatch && /^=\w+/) {
	$inmatch = 0;
    }

    if ($inpod && !$inmatch && /$pattern/o) {
	print "=head1 $ARGV chunk $.\n\n" 
	    unless $file eq $ARGV && $chunk+1 == $.;
	($file, $chunk) = ($ARGV, $.);
	print;
	$inmatch = 1 if $only_header;
	next;
    } 

    print if $inmatch;


} continue {

    if (eof) {
	$inmatch = $inpod = 0;