view release on metacpan or  search on metacpan

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

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 );
	    }
	    or $_ = decode( 'iso-8859-1', $_ );

	    next unless s/^(.*?)($pat)/"$1".hilite($2)/ge;

	    if ( $edit eq 'vi') {
		system( "vi",
			$ignorecase ? ( "+set ignorecase" ) : (),
			"+/$opat",
			$file );
	    }
	    elsif ( $edit eq 'emacs') {
		system( "emacsclient",
			"+$.:" . (1+length($1)),
			$file );
	    }
	    elsif ( $edit eq 'view') {
		system( "less",
			$ignorecase ? ( "-i" ) : (),
			"+/$opat",
			$file );
	    }
	    last if $edit;

	    print( $File::Find::name, ':',
		   $., ':',
		   1+length($1), ':',
		   $_
		 );
	}

	close($fh);
    };

    find( { wanted => $grepper,
	    no_chdir => 1,
	  }, @dirs );
}

=head1 AUTHOR

Johan Vromans, C<< <jv at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-app-file-grepper at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=App-File-Grepper>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

Development of this module takes place on GitHub:
L<https://github.com/sciurius/afg>.