view release on metacpan or  search on metacpan

lib/App/File/Grepper.pm  view on Meta::CPAN

Pass each file where the pattern is found to the vi editor.

=item view

Pass each file where the pattern is found to the less viewer.

=item filter

A list of perl patterns to select which files must be processed. Note
that these patterns are applied to the basename of each file, not the
full path.

=item exclude

A list of perl patterns to select which files must be rejected. Note
that these patterns are applied to the basename of each file, not the
full path. Also, these pattern are applied before the filter patterns.

Version control directories C<RCS>, C<CVS>, C<.svn>, C<.git> and
C<.hg> are always excluded, as are common editor backups.

=back

=cut

use File::Find;
use Term::ANSIColor;

sub main {

    my $self = shift;
    unshift(@_, $self) unless UNIVERSAL::isa( $self, __PACKAGE__ );
    my $opts = shift;
    my @dirs = @_;

    my $pat = $opts->{pattern};
    my $edit = "";
    if ( $opts->{'edit-with-emacs'} ) {
	$edit = 'emacs';
    }
    elsif ( $opts->{'edit-with-vi'} ) {
	$edit = 'vi';
    }
    elsif ( $opts->{'view'} ) {
	$edit = 'less';
    }

    my $ignorecase =
      defined($opts->{ignorecase})
      ? $opts->{ignorecase}
      : $pat !~ /[A-Z]/;

    my $opat = $pat;

    $pat = $pat =~ m;^/(.*);
      ? $ignorecase ? qr/$1/i : qr/$1/
      : $ignorecase ? qr/\Q$pat\E/i : qr/\Q$pat\E/;
    warn("PAT:  $pat\n") if $opts->{debug};

    *hilite = ( !$edit && -t STDOUT )
      ? sub { color('red bold').$_[0].color('reset') }
	: sub { $_[0] };

    my $filter;
    if ( defined $opts->{filter} && @{$opts->{filter}} ) {
	$filter = '(?:' . join('|', @{$opts->{filter}}) . ')';
	$filter = qr/$filter/;
    }
    my $exclude;
    if ( defined $opts->{exclude} && @{$opts->{exclude}} ) {
	$exclude = '(?:' . join('|', @{$opts->{exclude}}) . ')';
	$exclude = qr/$exclude/;
    }
    else {
	$exclude = qr{ (?: ^\# | ^\.(?>\.?)(?!/) | ~$ ) }x;
    }

    binmode( STDOUT, ":utf8" );

    my $grepper = sub {

	# Prune VC dirs. Always.
	if ( -d $_ && $_ =~ /^(RCS|CVS|\.svn|\.git|\.hg)$/ ) {
	    $File::Find::prune = 1;
	    return;
	}

	# Files only.
	return unless -f $_;

	# Handle include/exclude filters.
	if ( $exclude && ( $_ =~ $exclude ) ) {
	    warn("EXCL: $_ ($exclude)\n") if $opts->{debug};
	    return;
	}
	if ( $filter && ( $_ !~ $filter ) ) {
	    warn("FLTR: $_\n") if $opts->{debug};
	    return;
	}
	warn("FILE: $_\n") if $opts->{debug};

	my $file = $_;

	# Okay, we've got one.
	open( my $fh, '<', $file )
	  or warn("$File::Find::name: $!\n"), return;

	unless ( -T $fh ) {
	    warn("[Binary: $File::Find::name]\n") if $opts->{verbose};
	    return;
	}

	binmode( $fh, 'raw' );

	use Encode qw(decode);

	while ( <$fh> ) {

	    eval {
		$_ = decode( 'UTF-8', $_, 1 );
	    }