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 perl pattern to select which files must be processed. Note that this
pattern is applied to the basename of each file, not the full path.

=item exclude

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

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} ) {
	$filter = $opts->{filter};
	$filter = qr/$filter/;
    }
    my $exclude;
    if ( defined $opts->{exclude} ) {
	$exclude = $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: $_\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 );
	    }