view release on metacpan or  search on metacpan

script/tcgrep  view on Meta::CPAN

	}
	close PATFILE;
    }
    else {                        # make sure pattern is valid
	$pattern = $opt{e} || shift(@ARGV) || usage();
        unless ($no_re) {
	    eval qq{ 'foo' =~ /$pattern/, 1 } or
	        die "$Me: bad pattern: $@";
        }
	@patterns = ($pattern);
    }

    if ($no_re) {
        for (@patterns) {
            # XXX: quotemeta?
            s/(\W)/\\$1/g;
        }
    }

    # mumble mumble DeMorgan mumble mumble
    if ($opt{v}) {
        @patterns = join '|', map "(?:$_)", @patterns;
    }

    if ($opt{H} || $opt{u}) {     # highlight or underline
	my $term = $ENV{TERM} || 'vt100';
	my $terminal;

	eval {                    # try to look up escapes for stand-out
	    require POSIX;        # or underline via Term::Cap
	    use Term::Cap;

	    my $termios = POSIX::Termios->new();
	    $termios->getattr;
	    my $ospeed = $termios->getospeed;

	    $terminal = Tgetent Term::Cap { TERM=>undef, OSPEED=>$ospeed }
	};

	unless ($@) {             # if successful, get escapes for either
	    local $^W = 0;        # stand-out (-H) or underlined (-u)
	    ($SO, $SE) = $opt{H}
		? ($terminal->Tputs('so'), $terminal->Tputs('se'))
		: ($terminal->Tputs('us'), $terminal->Tputs('ue'));
	}
	else {                    # if use of Term::Cap fails,
	    ($SO, $SE) = $opt{H}  # use tput command to get escapes
		? (`tput -T $term smso`, `tput -T $term rmso`)
		: (`tput -T $term smul`, `tput -T $term rmul`)
	}
    }

    if ($opt{i}) {
	@patterns = map {"(?i)$_"} @patterns;
    }

    if ($opt{p} || $opt{P}) {
	@patterns = map {"(?m)$_"} @patterns;
    }

    $opt{p}   && ($/ = '');
    $opt{P}   && ($/ = eval(qq("$opt{P}")));     # for -P '%%\n'
    $opt{w}   && (@patterns = map {'\b' . $_ . '\b'} @patterns);
    $opt{'x'} && (@patterns = map {"^$_\$"} @patterns);
    if (@ARGV) {
	$Mult = 1 if ($opt{r} || (@ARGV > 1) || -d $ARGV[0]) && !$opt{h};
    }
    $opt{1}   += $opt{l};                   # that's a one and an ell
    $opt{H}   += $opt{u};
    $opt{c}   += $opt{C};
    $opt{'s'} += $opt{c};
    $opt{1}   += $opt{'s'} && !$opt{c};     # that's a one

    @ARGV = ($opt{r} ? '.' : '-') unless @ARGV;
    $opt{r} = 1 if !$opt{r} && grep(-d, @ARGV) == @ARGV;

    $match_code  = '';
    $match_code .= 'study;' if @patterns > 5; # might speed things up a bit

    foreach (@patterns) { s(/)(\\/)g }

    if ($opt{H}) {
	foreach $pattern (@patterns) {
	    $match_code .= "\$Matches += s/($pattern)/${SO}\$1${SE}/g;";
	}
    }
    elsif ($opt{v}) {
	foreach $pattern (@patterns) {
	    $match_code .= "\$Matches += !/$pattern/;";
	}
    }
    elsif ($opt{C}) {
	foreach $pattern (@patterns) {
	    $match_code .= "\$Matches++ while /$pattern/g;";
	}
    }
    else {
	foreach $pattern (@patterns) {
	    $match_code .= "\$Matches++ if /$pattern/;";
	}
    }

    $matcher = eval "sub { $match_code }";
    die if $@;

    return (\%opt, $matcher);
}

###################################

sub matchfile {
    $opt = shift;                 # reference to option hash
    $matcher = shift;             # reference to matching sub

    my ($file, @list, $total, $name);
    local($_);
    $total = 0;

FILE: while (defined ($file = shift(@_))) {

	if (-d $file) {