# Please DO NOT EDIT or send patches for it.
#
# Please take a look at the source from
-# http://github.com/petdance/ack2
+# https://github.com/beyondgrep/ack2
# and submit patches against the individual files
# that build ack.
#
+package main;
+
use strict;
use warnings;
+our $VERSION = '2.22'; # Check https://beyondgrep.com/ for updates
use 5.008008;
+use Getopt::Long 2.38 ();
+use Carp 1.04 ();
+use File::Spec ();
-# XXX Don't make this so brute force
-# See also: https://github.com/petdance/ack2/issues/89
-
-use Getopt::Long 2.35 ();
-
-use Carp 1.04 ();
-our $VERSION = '2.04';
-# Check http://beyondgrep.com/ for updates
+# XXX Don't make this so brute force
+# See also: https://github.com/beyondgrep/ack2/issues/89
+
+our $opt_after_context;
+our $opt_before_context;
+our $opt_output;
+our $opt_print0;
+our $opt_color;
+our $opt_heading;
+our $opt_show_filename;
+our $opt_regex;
+our $opt_break;
+our $opt_count;
+our $opt_v;
+our $opt_m;
+our $opt_g;
+our $opt_f;
+our $opt_lines;
+our $opt_L;
+our $opt_l;
+our $opt_passthru;
+our $opt_column;
+
+# Flag if we need any context tracking.
+our $is_tracking_context;
# These are all our globals.
# Do preliminary arg checking;
my $env_is_usable = 1;
- for ( @ARGV ) {
- last if ( $_ eq '--' );
+ for my $arg ( @ARGV ) {
+ last if ( $arg eq '--' );
- # Get the --thpppt and --bar checking out of the way.
- /^--th[pt]+t+$/ && App::Ack::_thpppt($_);
- /^--bar$/ && App::Ack::_bar();
+ # Get the --thpppt, --bar, --cathy checking out of the way.
+ $arg =~ /^--th[pt]+t+$/ and App::Ack::thpppt($arg);
+ $arg eq '--bar' and App::Ack::ackbar();
+ $arg eq '--cathy' and App::Ack::cathy();
# See if we want to ignore the environment. (Don't tell Al Gore.)
- if ( /^--(no)?env$/ ) {
- $env_is_usable = defined $1 ? 0 : 1;
- }
+ $arg eq '--env' and $env_is_usable = 1;
+ $arg eq '--noenv' and $env_is_usable = 0;
}
+
if ( !$env_is_usable ) {
my @keys = ( 'ACKRC', grep { /^ACK_/ } keys %ENV );
delete @ENV{@keys};
sub _compile_descend_filter {
my ( $opt ) = @_;
- my $idirs = $opt->{idirs};
- my $dont_ignore_dirs = $opt->{no_ignore_dirs};
-
- # if we have one or more --noignore-dir directives, we can't ignore
- # entire subdirectory hierarchies, so we return an "accept all"
- # filter and scrutinize the files more in _compile_file_filter
- return if $dont_ignore_dirs;
- return unless $idirs && @{$idirs};
-
- my %ignore_dirs;
+ my $idirs = 0;
+ my $dont_ignore_dirs = 0;
- foreach my $idir (@{$idirs}) {
- if ( $idir =~ /^(\w+):(.*)/ ) {
- if ( $1 eq 'is') {
- $ignore_dirs{$2} = 1;
- }
- else {
- Carp::croak( 'Non-is filters are not yet supported for --ignore-dir' );
- }
+ for my $filter (@{$opt->{idirs} || []}) {
+ if ($filter->is_inverted()) {
+ $dont_ignore_dirs++;
}
else {
- Carp::croak( qq{Invalid filter specification "$idir"} );
+ $idirs++;
}
}
+ # If we have one or more --noignore-dir directives, we can't ignore
+ # entire subdirectory hierarchies, so we return an "accept all"
+ # filter and scrutinize the files more in _compile_file_filter.
+ return if $dont_ignore_dirs;
+ return unless $idirs;
+
+ $idirs = $opt->{idirs};
+
return sub {
- return !exists $ignore_dirs{$_} && !exists $ignore_dirs{$File::Next::dir};
+ my $resource = App::Ack::Resource->new($File::Next::dir);
+ return !grep { $_->filter($resource) } @{$idirs};
};
}
sub _compile_file_filter {
my ( $opt, $start ) = @_;
- my $ifiles = $opt->{ifiles};
- $ifiles ||= [];
+ my $ifiles_filters = $opt->{ifiles};
- my @ifiles_filters = map {
- my $filter;
+ my $filters = $opt->{'filters'} || [];
+ my $direct_filters = App::Ack::Filter::Collection->new();
+ my $inverse_filters = App::Ack::Filter::Collection->new();
- if ( /^(\w+):(.+)/ ) {
- my ($how,$what) = ($1,$2);
- $filter = App::Ack::Filter->create_filter($how, split(/,/, $what));
+ foreach my $filter (@{$filters}) {
+ if ($filter->is_inverted()) {
+ # We want to check if files match the uninverted filters
+ $inverse_filters->add($filter->invert());
}
else {
- Carp::croak( qq{Invalid filter specification "$_"} );
+ $direct_filters->add($filter);
}
- $filter
- } @{$ifiles};
-
- my $filters = $opt->{'filters'} || [];
- my $inverse_filters = [ grep { $_->is_inverted() } @{$filters} ];
- @{$filters} = grep { !$_->is_inverted() } @{$filters};
+ }
my %is_member_of_starting_set = map { (get_file_id($_) => 1) } @{$start};
- my $ignore_dir_list = $opt->{idirs};
- my $dont_ignore_dir_list = $opt->{no_ignore_dirs};
-
- my %ignore_dir_set;
- my %dont_ignore_dir_set;
+ my @ignore_dir_filter = @{$opt->{idirs} || []};
+ my @is_inverted = map { $_->is_inverted() } @ignore_dir_filter;
+ # This depends on InverseFilter->invert returning the original filter (for optimization).
+ @ignore_dir_filter = map { $_->is_inverted() ? $_->invert() : $_ } @ignore_dir_filter;
+ my $dont_ignore_dir_filter = grep { $_ } @is_inverted;
+ my $previous_dir = '';
+ my $previous_dir_ignore_result;
- foreach my $filter (@{ $ignore_dir_list }) {
- if ( $filter =~ /^(\w+):(.*)/ ) {
- if ( $1 eq 'is' ) {
- $ignore_dir_set{ $2 } = 1;
- } else {
- Carp::croak( 'Non-is filters are not yet supported for --ignore-dir' );
+ return sub {
+ if ( $opt_g ) {
+ if ( $File::Next::name =~ /$opt_regex/ && $opt_v ) {
+ return 0;
}
- } else {
- Carp::croak( qq{Invalid filter specification "$filter"} );
- }
- }
- foreach my $filter (@{ $dont_ignore_dir_list }) {
- if ( $filter =~ /^(\w+):(.*)/ ) {
- if ( $1 eq 'is' ) {
- $dont_ignore_dir_set{ $2 } = 1;
- } else {
- Carp::croak( 'Non-is filters are not yet supported for --ignore-dir' );
+ if ( $File::Next::name !~ /$opt_regex/ && !$opt_v ) {
+ return 0;
}
- } else {
- Carp::croak( qq{Invalid filter specification "$filter"} );
}
- }
-
- return sub {
# ack always selects files that are specified on the command
# line, regardless of filetype. If you want to ack a JPEG,
# and say "ack foo whatever.jpg" it will do it for you.
return 1 if $is_member_of_starting_set{ get_file_id($File::Next::name) };
- if ( $dont_ignore_dir_list ) {
- my ( undef, $dirname ) = File::Spec->splitpath($File::Next::name);
- my @dirs = File::Spec->splitdir($dirname);
+ if ( $dont_ignore_dir_filter ) {
+ if ( $previous_dir eq $File::Next::dir ) {
+ if ( $previous_dir_ignore_result ) {
+ return 0;
+ }
+ }
+ else {
+ my @dirs = File::Spec->splitdir($File::Next::dir);
+
+ my $is_ignoring = 0;
- my $is_ignoring = 0;
+ for ( my $i = 0; $i < @dirs; $i++) {
+ my $dir_rsrc = App::Ack::Resource->new(File::Spec->catfile(@dirs[0 .. $i]));
- foreach my $dir ( @dirs ) {
- if ( $ignore_dir_set{ $dir } ) {
- $is_ignoring = 1;
+ my $j = 0;
+ for my $filter (@ignore_dir_filter) {
+ if ( $filter->filter($dir_rsrc) ) {
+ $is_ignoring = !$is_inverted[$j];
+ }
+ $j++;
+ }
}
- elsif ( $dont_ignore_dir_set{ $dir } ) {
- $is_ignoring = 0;
+
+ $previous_dir = $File::Next::dir;
+ $previous_dir_ignore_result = $is_ignoring;
+
+ if ( $is_ignoring ) {
+ return 0;
}
}
- if ( $is_ignoring ) {
- return 0;
- }
}
# Ignore named pipes found in directory searching. Named
# command line" wins.
return 0 if -p $File::Next::name;
- # we can't handle unreadable filenames; report them
- unless ( -r _ ) {
- if ( $App::Ack::report_bad_filenames ) {
- App::Ack::warn( "${File::Next::name}: cannot open file for reading" );
+ # We can't handle unreadable filenames; report them.
+ if ( not -r _ ) {
+ use filetest 'access';
+
+ if ( not -R $File::Next::name ) {
+ if ( $App::Ack::report_bad_filenames ) {
+ App::Ack::warn( "${File::Next::name}: cannot open file for reading" );
+ }
+ return 0;
}
- return 0;
}
- my $resource = App::Ack::Resource::Basic->new($File::Next::name);
- return 0 if ! $resource;
- foreach my $filter (@ifiles_filters) {
- return 0 if $filter->filter($resource);
- }
- my $match_found = 1;
- if ( @{$filters} ) {
- $match_found = 0;
+ my $resource = App::Ack::Resource->new($File::Next::name);
- foreach my $filter (@{$filters}) {
- if ($filter->filter($resource)) {
- $match_found = 1;
- last;
- }
- }
+ if ( $ifiles_filters && $ifiles_filters->filter($resource) ) {
+ return 0;
}
+
+ my $match_found = $direct_filters->filter($resource);
+
# Don't bother invoking inverse filters unless we consider the current resource a match
- if ( $match_found && @{$inverse_filters} ) {
- foreach my $filter ( @{$inverse_filters} ) {
- if ( not $filter->filter( $resource ) ) {
- $match_found = 0;
- last;
- }
- }
+ if ( $match_found && $inverse_filters->filter( $resource ) ) {
+ $match_found = 0;
}
return $match_found;
};
# Set default colors, load Term::ANSIColor
sub load_colors {
eval 'use Term::ANSIColor 1.10 ()';
+ eval 'use Win32::Console::ANSI' if $App::Ack::is_windows;
$ENV{ACK_COLOR_MATCH} ||= 'black on_yellow';
$ENV{ACK_COLOR_FILENAME} ||= 'bold green';
return;
}
-# inefficient, but functional
sub filetypes {
my ( $resource ) = @_;
my $filters = $App::Ack::mappings{$k};
foreach my $filter (@{$filters}) {
- # clone the resource
+ # Clone the resource.
my $clone = $resource->clone;
if ( $filter->filter($clone) ) {
push @matches, $k;
}
}
- return sort @matches;
+ # http://search.cpan.org/dist/Perl-Critic/lib/Perl/Critic/Policy/Subroutines/ProhibitReturnSort.pm
+ @matches = sort @matches;
+ return @matches;
}
-# returns a (fairly) unique identifier for a file
-# use this function to compare two files to see if they're
-# equal (ie. the same file, but with a different path/links/etc)
+# Returns a (fairly) unique identifier for a file.
+# Use this function to compare two files to see if they're
+# equal (ie. the same file, but with a different path/links/etc).
sub get_file_id {
my ( $filename ) = @_;
return File::Next::reslash( $filename );
}
else {
- # XXX is this the best method? it always hits the FS
+ # XXX Is this the best method? It always hits the FS.
if( my ( $dev, $inode ) = (stat($filename))[0, 1] ) {
return join(':', $dev, $inode);
}
else {
- # XXX this could be better
+ # XXX This could be better.
return $filename;
}
}
}
# Returns a regex object based on a string and command-line options.
-# Dies when the regex $str is undefinied (i.e. not given on command line).
+# Dies when the regex $str is undefined (i.e. not given on command line).
sub build_regex {
my $str = shift;
$str = quotemeta( $str ) if $opt->{Q};
if ( $opt->{w} ) {
- $str = "\\b$str" if $str =~ /^\w/;
- $str = "$str\\b" if $str =~ /\w$/;
+ my $pristine_str = $str;
+
+ $str = "(?:$str)";
+ $str = "\\b$str" if $pristine_str =~ /^\w/;
+ $str = "$str\\b" if $pristine_str =~ /\w$/;
}
my $regex_is_lc = $str eq lc $str;
$str = "(?i)$str";
}
- my $re = eval { qr/$str/ };
+ my $re = eval { qr/$str/m };
if ( !$re ) {
die "Invalid regex '$str':\n $@";
}
}
+my $match_column_number;
+
{
-my @before_ctx_lines;
-my @after_ctx_lines;
+# Number of context lines
+my $n_before_ctx_lines;
+my $n_after_ctx_lines;
+
+# Array to keep track of lines that might be required for a "before" context
+my @before_context_buf;
+# Position to insert next line in @before_context_buf
+my $before_context_pos;
+
+# Number of "after" context lines still pending
+my $after_context_pending;
+
+# Number of latest line that got printed
+my $printed_line_no;
+
my $is_iterating;
+my $is_first_match;
my $has_printed_something;
BEGIN {
$has_printed_something = 0;
}
+# Set up context tracking variables.
+sub set_up_line_context {
+ $n_before_ctx_lines = $opt_output ? 0 : ($opt_before_context || 0);
+ $n_after_ctx_lines = $opt_output ? 0 : ($opt_after_context || 0);
+
+ @before_context_buf = (undef) x $n_before_ctx_lines;
+ $before_context_pos = 0;
+
+ $is_tracking_context = $n_before_ctx_lines || $n_after_ctx_lines;
+
+ $is_first_match = 1;
+
+ return;
+}
+
+# Adjust context tracking variables when entering a new file.
+sub set_up_line_context_for_file {
+ $printed_line_no = 0;
+ $after_context_pending = 0;
+ if ( $opt_heading && !$opt_lines ) {
+ $is_first_match = 1;
+ }
+
+ return;
+}
+
+=begin Developers
+
+This subroutine jumps through a number of optimization hoops to
+try to be fast in the more common use cases of ack. For one thing,
+in non-context tracking searches (not using -A, -B, or -C),
+conditions that normally would be checked inside the loop happen
+outside, resulting in three nearly identical loops for -v, --passthru,
+and normal searching. Any changes that happen to one should propagate
+to the others if they make sense. The non-context branches also inline
+does_match for performance reasons; any relevant changes that happen here
+must also happen there.
+
+=end Developers
+
+=cut
+
sub print_matches_in_resource {
- my ( $resource, $opt ) = @_;
+ my ( $resource ) = @_;
- my $passthru = $opt->{passthru};
- my $max_count = $opt->{m} || -1;
+ my $max_count = $opt_m || -1;
my $nmatches = 0;
my $filename = $resource->name;
- my $break = $opt->{break};
- my $heading = $opt->{heading};
- my $ors = $opt->{print0} ? "\0" : "\n";
- my $color = $opt->{color};
- my $print_filename = $opt->{show_filename};
+ my $ors = $opt_print0 ? "\0" : "\n";
my $has_printed_for_this_resource = 0;
$is_iterating = 1;
- local $opt->{before_context} = $opt->{output} ? 0 : $opt->{before_context};
- local $opt->{after_context} = $opt->{output} ? 0 : $opt->{after_context};
-
- my $n_before_ctx_lines = $opt->{before_context} || 0;
- my $n_after_ctx_lines = $opt->{after_context} || 0;
-
- @after_ctx_lines = @before_ctx_lines = ();
-
my $fh = $resource->open();
if ( !$fh ) {
if ( $App::Ack::report_bad_filenames ) {
}
my $display_filename = $filename;
- if ( $print_filename && $heading && $color ) {
+ if ( $opt_show_filename && $opt_heading && $opt_color ) {
$display_filename = Term::ANSIColor::colored($display_filename, $ENV{ACK_COLOR_FILENAME});
}
- # check for context before the main loop, so we don't
- # pay for it if we don't need it
- if ( $n_before_ctx_lines || $n_after_ctx_lines ) {
- my $current_line = <$fh>; # prime the first line of input
-
- while ( defined $current_line ) {
- while ( (@after_ctx_lines < $n_after_ctx_lines) && defined($_ = <$fh>) ) {
- push @after_ctx_lines, $_;
- }
-
- local $_ = $current_line;
- my $former_dot_period = $.;
- $. -= @after_ctx_lines;
-
- if ( does_match($opt, $_) ) {
+ # Check for context before the main loop, so we don't pay for it if we don't need it.
+ if ( $is_tracking_context ) {
+ $after_context_pending = 0;
+ while ( <$fh> ) {
+ if ( does_match( $_ ) && $max_count ) {
if ( !$has_printed_for_this_resource ) {
- if ( $break && $has_printed_something ) {
+ if ( $opt_break && $has_printed_something ) {
App::Ack::print_blank_line();
}
- if ( $print_filename && $heading ) {
+ if ( $opt_show_filename && $opt_heading ) {
App::Ack::print_filename( $display_filename, $ors );
}
}
- print_line_with_context($opt, $filename, $_, $.);
+ print_line_with_context( $filename, $_, $. );
$has_printed_for_this_resource = 1;
$nmatches++;
$max_count--;
}
- elsif ( $passthru ) {
- chomp; # XXX proper newline handling?
- # XXX inline this call?
- if ( $break && !$has_printed_for_this_resource && $has_printed_something ) {
+ elsif ( $opt_passthru ) {
+ chomp; # XXX Proper newline handling?
+ # XXX Inline this call?
+ if ( $opt_break && !$has_printed_for_this_resource && $has_printed_something ) {
App::Ack::print_blank_line();
}
- print_line_with_options($opt, $filename, $_, $., ':');
+ print_line_with_options( $filename, $_, $., ':' );
$has_printed_for_this_resource = 1;
}
- last unless $max_count != 0;
-
- # I tried doing this with local(), but for some reason,
- # $. continued to have its new value after the exit of the
- # enclosing block. I'm guessing that $. has some extra
- # magic associated with it or something. If someone can
- # tell me why this happened, I would love to know!
- $. = $former_dot_period; # XXX this won't happen on an exception
-
- if ( $n_before_ctx_lines ) {
- push @before_ctx_lines, $current_line;
- shift @before_ctx_lines while @before_ctx_lines > $n_before_ctx_lines;
- }
- if ( $n_after_ctx_lines ) {
- $current_line = shift @after_ctx_lines;
- }
else {
- $current_line = <$fh>;
+ chomp; # XXX Proper newline handling?
+ print_line_if_context( $filename, $_, $., '-' );
}
+
+ last if ($max_count == 0) && ($after_context_pending == 0);
}
}
else {
- local $_;
-
- while ( <$fh> ) {
- if ( does_match($opt, $_) ) {
- if ( !$has_printed_for_this_resource ) {
- if ( $break && $has_printed_something ) {
+ if ( $opt_passthru ) {
+ local $_;
+
+ while ( <$fh> ) {
+ $match_column_number = undef;
+ if ( $opt_v ? !/$opt_regex/o : /$opt_regex/o ) {
+ if ( !$opt_v ) {
+ $match_column_number = $-[0] + 1;
+ }
+ if ( !$has_printed_for_this_resource ) {
+ if ( $opt_break && $has_printed_something ) {
+ App::Ack::print_blank_line();
+ }
+ if ( $opt_show_filename && $opt_heading ) {
+ App::Ack::print_filename( $display_filename, $ors );
+ }
+ }
+ print_line_with_context( $filename, $_, $. );
+ $has_printed_for_this_resource = 1;
+ $nmatches++;
+ $max_count--;
+ }
+ else {
+ chomp; # XXX proper newline handling?
+ if ( $opt_break && !$has_printed_for_this_resource && $has_printed_something ) {
App::Ack::print_blank_line();
}
- if ( $print_filename && $heading ) {
- App::Ack::print_filename( $display_filename, $ors );
+ print_line_with_options( $filename, $_, $., ':' );
+ $has_printed_for_this_resource = 1;
+ }
+ last unless $max_count != 0;
+ }
+ }
+ elsif ( $opt_v ) {
+ local $_;
+
+ $match_column_number = undef;
+ while ( <$fh> ) {
+ if ( !/$opt_regex/o ) {
+ if ( !$has_printed_for_this_resource ) {
+ if ( $opt_break && $has_printed_something ) {
+ App::Ack::print_blank_line();
+ }
+ if ( $opt_show_filename && $opt_heading ) {
+ App::Ack::print_filename( $display_filename, $ors );
+ }
}
+ print_line_with_context( $filename, $_, $. );
+ $has_printed_for_this_resource = 1;
+ $nmatches++;
+ $max_count--;
}
- print_line_with_context($opt, $filename, $_, $.);
- $has_printed_for_this_resource = 1;
- $nmatches++;
- $max_count--;
+ last unless $max_count != 0;
}
- elsif ( $passthru ) {
- chomp; # XXX proper newline handling?
- if ( $break && !$has_printed_for_this_resource && $has_printed_something ) {
- App::Ack::print_blank_line();
+ }
+ else {
+ local $_;
+
+ while ( <$fh> ) {
+ $match_column_number = undef;
+ if ( /$opt_regex/o ) {
+ $match_column_number = $-[0] + 1;
+ if ( !$has_printed_for_this_resource ) {
+ if ( $opt_break && $has_printed_something ) {
+ App::Ack::print_blank_line();
+ }
+ if ( $opt_show_filename && $opt_heading ) {
+ App::Ack::print_filename( $display_filename, $ors );
+ }
+ }
+ s/[\r\n]+$//g;
+ print_line_with_options( $filename, $_, $., ':' );
+ $has_printed_for_this_resource = 1;
+ $nmatches++;
+ $max_count--;
}
- print_line_with_options($opt, $filename, $_, $., ':');
- $has_printed_for_this_resource = 1;
+ last unless $max_count != 0;
}
- last unless $max_count != 0;
}
+
}
- $is_iterating = 0; # XXX this won't happen on an exception
- # then again, do we care? ack doesn't really
- # handle exceptions anyway.
+ $is_iterating = 0;
return $nmatches;
}
sub print_line_with_options {
- my ( $opt, $filename, $line, $line_no, $separator ) = @_;
+ my ( $filename, $line, $line_no, $separator ) = @_;
$has_printed_something = 1;
+ $printed_line_no = $line_no;
- my $print_filename = $opt->{show_filename};
- my $print_column = $opt->{column};
- my $ors = $opt->{print0} ? "\0" : "\n";
- my $heading = $opt->{heading};
- my $output_expr = $opt->{output};
- my $color = $opt->{color};
+ my $ors = $opt_print0 ? "\0" : "\n";
my @line_parts;
- if( $color ) {
+ if( $opt_color ) {
$filename = Term::ANSIColor::colored($filename,
$ENV{ACK_COLOR_FILENAME});
$line_no = Term::ANSIColor::colored($line_no,
$ENV{ACK_COLOR_LINENO});
}
- if($print_filename) {
- if( $heading ) {
+ if($opt_show_filename) {
+ if( $opt_heading ) {
push @line_parts, $line_no;
}
else {
push @line_parts, $filename, $line_no;
}
- if( $print_column ) {
+ if( $opt_column ) {
push @line_parts, get_match_column();
}
}
- if( $output_expr ) {
- while ( $line =~ /$opt->{regex}/og ) {
- my $output = eval $output_expr;
+ if( $opt_output ) {
+ while ( $line =~ /$opt_regex/og ) {
+ # XXX We need to stop using eval() for --output. See https://github.com/beyondgrep/ack2/issues/421
+ my $output = eval $opt_output;
App::Ack::print( join( $separator, @line_parts, $output ), $ors );
}
}
else {
- if ( $color ) {
- my @capture_indices = get_capture_indices();
- if( @capture_indices ) {
- my $offset = 0; # additional offset for when we add stuff
+ if ( $opt_color ) {
+ # This match is redundant, but we need to perfom it in order to get if capture groups are set.
+ $line =~ /$opt_regex/o;
- foreach my $index_pair ( @capture_indices ) {
- my ( $match_start, $match_end ) = @{$index_pair};
+ if ( @+ > 1 ) { # If we have captures...
+ while ( $line =~ /$opt_regex/og ) {
+ my $offset = 0; # Additional offset for when we add stuff.
+ my $previous_match_end = 0;
- my $substring = substr( $line,
- $offset + $match_start, $match_end - $match_start );
- my $substitution = Term::ANSIColor::colored( $substring,
- $ENV{ACK_COLOR_MATCH} );
+ last if $-[0] == $+[0];
+
+ for ( my $i = 1; $i < @+; $i++ ) {
+ my ( $match_start, $match_end ) = ( $-[$i], $+[$i] );
+
+ next unless defined($match_start);
+ next if $match_start < $previous_match_end;
- substr( $line, $offset + $match_start,
- $match_end - $match_start, $substitution );
+ my $substring = substr( $line,
+ $offset + $match_start, $match_end - $match_start );
+ my $substitution = Term::ANSIColor::colored( $substring,
+ $ENV{ACK_COLOR_MATCH} );
- $offset += length( $substitution ) - length( $substring );
+ substr( $line, $offset + $match_start,
+ $match_end - $match_start, $substitution );
+
+ $previous_match_end = $match_end; # Offsets do not need to be applied.
+ $offset += length( $substitution ) - length( $substring );
+ }
+
+ pos($line) = $+[0] + $offset;
}
}
else {
- my $matched = 0; # flag; if matched, need to escape afterwards
+ my $matched = 0; # If matched, need to escape afterwards.
- while ( $line =~ /$opt->{regex}/og ) {
+ while ( $line =~ /$opt_regex/og ) {
$matched = 1;
my ( $match_start, $match_end ) = ($-[0], $+[0]);
+ next unless defined($match_start);
+ last if $match_start == $match_end;
my $substring = substr( $line, $match_start,
$match_end - $match_start );
pos($line) = $match_end +
(length( $substitution ) - length( $substring ));
}
+ # XXX Why do we do this?
$line .= "\033[0m\033[K" if $matched;
}
}
}
sub iterate {
- my ( $resource, $opt, $cb ) = @_;
+ my ( $resource, $cb ) = @_;
$is_iterating = 1;
- local $opt->{before_context} = $opt->{output} ? 0 : $opt->{before_context};
- local $opt->{after_context} = $opt->{output} ? 0 : $opt->{after_context};
-
- my $n_before_ctx_lines = $opt->{before_context} || 0;
- my $n_after_ctx_lines = $opt->{after_context} || 0;
-
- @after_ctx_lines = @before_ctx_lines = ();
-
my $fh = $resource->open();
if ( !$fh ) {
if ( $App::Ack::report_bad_filenames ) {
- # XXX direct access to filename
- App::Ack::warn( "$resource->{filename}: $!" );
+ App::Ack::warn( $resource->name . ': ' . $! );
}
return;
}
- # check for context before the main loop, so we don't
- # pay for it if we don't need it
- if ( $n_before_ctx_lines || $n_after_ctx_lines ) {
- my $current_line = <$fh>; # prime the first line of input
-
- while ( defined $current_line ) {
- while ( (@after_ctx_lines < $n_after_ctx_lines) && defined($_ = <$fh>) ) {
- push @after_ctx_lines, $_;
- }
-
- local $_ = $current_line;
- my $former_dot_period = $.;
- $. -= @after_ctx_lines;
+ # Check for context before the main loop, so we don't pay for it if we don't need it.
+ if ( $is_tracking_context ) {
+ $after_context_pending = 0;
+ while ( <$fh> ) {
last unless $cb->();
-
- # I tried doing this with local(), but for some reason,
- # $. continued to have its new value after the exit of the
- # enclosing block. I'm guessing that $. has some extra
- # magic associated with it or something. If someone can
- # tell me why this happened, I would love to know!
- $. = $former_dot_period; # XXX this won't happen on an exception
-
- if ( $n_before_ctx_lines ) {
- push @before_ctx_lines, $current_line;
- shift @before_ctx_lines while @before_ctx_lines > $n_before_ctx_lines;
- }
- if ( $n_after_ctx_lines ) {
- $current_line = shift @after_ctx_lines;
- }
- else {
- $current_line = <$fh>;
- }
}
}
else {
}
}
- $is_iterating = 0; # XXX this won't happen on an exception
- # then again, do we care? ack doesn't really
- # handle exceptions anyway.
+ $is_iterating = 0;
return;
}
-sub get_context {
- if ( not $is_iterating ) {
- Carp::croak( 'get_context() called outside of iterate()' );
- }
-
- return (
- scalar(@before_ctx_lines) ? \@before_ctx_lines : undef,
- scalar(@after_ctx_lines) ? \@after_ctx_lines : undef,
- );
-}
+sub print_line_with_context {
+ my ( $filename, $matching_line, $line_no ) = @_;
-}
+ my $ors = $opt_print0 ? "\0" : "\n";
+ my $is_tracking_context = $opt_after_context || $opt_before_context;
-{
+ $matching_line =~ s/[\r\n]+$//g;
-my $is_first_match;
-my $previous_file_processed;
-my $previous_line_printed;
+ # Check if we need to print context lines first.
+ if ( $is_tracking_context ) {
+ my $before_unprinted = $line_no - $printed_line_no - 1;
+ if ( !$is_first_match && ( !$printed_line_no || $before_unprinted > $n_before_ctx_lines ) ) {
+ App::Ack::print('--', $ors);
+ }
-BEGIN {
- $is_first_match = 1;
- $previous_line_printed = -1;
-}
+ # We want at most $n_before_ctx_lines of context.
+ if ( $before_unprinted > $n_before_ctx_lines ) {
+ $before_unprinted = $n_before_ctx_lines;
+ }
-sub print_line_with_context {
- my ( $opt, $filename, $matching_line, $line_no ) = @_;
+ while ( $before_unprinted > 0 ) {
+ my $line = $before_context_buf[($before_context_pos - $before_unprinted + $n_before_ctx_lines) % $n_before_ctx_lines];
- my $heading = $opt->{heading};
+ chomp $line;
- if( !defined($previous_file_processed) ||
- $previous_file_processed ne $filename ) {
- $previous_file_processed = $filename;
- $previous_line_printed = -1;
+ # Disable $opt->{column} since there are no matches in the context lines.
+ local $opt_column = 0;
- if( $heading ) {
- $is_first_match = 1;
+ print_line_with_options( $filename, $line, $line_no-$before_unprinted, '-' );
+ $before_unprinted--;
}
}
- my $ors = $opt->{print0} ? "\0" : "\n";
- my $match_word = $opt->{w};
- my $is_tracking_context = $opt->{after_context} || $opt->{before_context};
- my $output_expr = $opt->{output};
+ print_line_with_options( $filename, $matching_line, $line_no, ':' );
- $matching_line =~ s/[\r\n]+$//g;
-
- my ( $before_context, $after_context ) = get_context();
-
- if ( $before_context ) {
- my $first_line = $. - @{$before_context};
-
- if ( $first_line <= $previous_line_printed ) {
- splice @{$before_context}, 0, $previous_line_printed - $first_line + 1;
- $first_line = $. - @{$before_context};
- }
- if ( @{$before_context} ) {
- my $offset = @{$before_context};
+ # We want to get the next $n_after_ctx_lines printed.
+ $after_context_pending = $n_after_ctx_lines;
- if( !$is_first_match && $previous_line_printed != $first_line - 1 ) {
- App::Ack::print('--', $ors);
- }
- foreach my $line (@{$before_context}) {
- my $context_line_no = $. - $offset;
- if ( $context_line_no <= $previous_line_printed ) {
- next;
- }
+ $is_first_match = 0;
- chomp $line;
- print_line_with_options($opt, $filename, $line, $context_line_no, '-');
- $previous_line_printed = $context_line_no;
- $offset--;
- }
- }
- }
+ return;
+}
- if ( $. > $previous_line_printed ) {
- if( $is_tracking_context && !$is_first_match && $previous_line_printed != $. - 1 ) {
- App::Ack::print('--', $ors);
- }
+# Print the line only if it's part of a context we need to display.
+sub print_line_if_context {
+ my ( $filename, $line, $line_no, $separator ) = @_;
- print_line_with_options($opt, $filename, $matching_line, $line_no, ':');
- $previous_line_printed = $.;
+ if ( $after_context_pending ) {
+ # Disable $opt_column since there are no matches in the context lines.
+ local $opt_column = 0;
+ print_line_with_options( $filename, $line, $line_no, $separator );
+ --$after_context_pending;
}
-
- if($after_context) {
- my $offset = 1;
- foreach my $line (@{$after_context}) {
- # XXX improve this!
- if ( $previous_line_printed >= $. + $offset ) {
- $offset++;
- next;
- }
- chomp $line;
- my $separator = ($opt->{regex} && does_match( $opt, $line )) ? ':' : '-';
- print_line_with_options($opt, $filename, $line, $. + $offset, $separator);
- $previous_line_printed = $. + $offset;
- $offset++;
- }
+ elsif ( $n_before_ctx_lines ) {
+ # Save line for "before" context.
+ $before_context_buf[$before_context_pos] = $_;
+ $before_context_pos = ($before_context_pos+1) % $n_before_ctx_lines;
}
- $is_first_match = 0;
-
return;
}
}
-{
+# does_match() MUST have an $opt_regex set.
-my @capture_indices;
-my $match_column_number;
+=begin Developers
-# does_match() MUST have an $opt->{regex} set.
+This subroutine is inlined a few places in print_matches_in_resource
+for performance reasons, so any changes here must be copied there as
+well.
+
+=end Developers
+
+=cut
sub does_match {
- my ( $opt, $line ) = @_;
+ my ( $line ) = @_;
$match_column_number = undef;
- @capture_indices = ();
- if ( $opt->{v} ) {
- return ( $line !~ /$opt->{regex}/o );
+ if ( $opt_v ) {
+ return ( $line !~ /$opt_regex/o );
}
else {
- if ( $line =~ /$opt->{regex}/o ) {
+ if ( $line =~ /$opt_regex/o ) {
# @- = @LAST_MATCH_START
# @+ = @LAST_MATCH_END
$match_column_number = $-[0] + 1;
-
- if ( @- > 1 ) {
- @capture_indices = map {
- [ $-[$_], $+[$_] ]
- } ( 1 .. $#- );
- }
return 1;
}
else {
}
}
-sub get_capture_indices {
- return @capture_indices;
-}
-
sub get_match_column {
return $match_column_number;
}
-}
-
sub resource_has_match {
- my ( $resource, $opt ) = @_;
+ my ( $resource ) = @_;
my $has_match = 0;
my $fh = $resource->open();
if ( !$fh ) {
if ( $App::Ack::report_bad_filenames ) {
- # XXX direct access to filename
- App::Ack::warn( "$resource->{filename}: $!" );
+ App::Ack::warn( $resource->name . ': ' . $! );
}
}
else {
- my $opt_v = $opt->{v};
- my $re = $opt->{regex};
while ( <$fh> ) {
- if (/$re/o xor $opt_v) {
+ if (/$opt_regex/o xor $opt_v) {
$has_match = 1;
last;
}
}
sub count_matches_in_resource {
- my ( $resource, $opt ) = @_;
+ my ( $resource ) = @_;
my $nmatches = 0;
my $fh = $resource->open();
if ( !$fh ) {
if ( $App::Ack::report_bad_filenames ) {
- # XXX direct access to filename
- App::Ack::warn( "$resource->{filename}: $!" );
+ App::Ack::warn( $resource->name . ': ' . $! );
}
}
else {
- my $opt_v = $opt->{v};
- my $re = $opt->{regex};
while ( <$fh> ) {
- ++$nmatches if (/$re/o xor $opt_v);
+ ++$nmatches if (/$opt_regex/o xor $opt_v);
}
close $fh;
}
my $opt = App::Ack::ConfigLoader::process_args( @arg_sources );
+ $opt_after_context = $opt->{after_context};
+ $opt_before_context = $opt->{before_context};
+ $opt_output = $opt->{output};
+ $opt_print0 = $opt->{print0};
+ $opt_color = $opt->{color};
+ $opt_heading = $opt->{heading};
+ $opt_show_filename = $opt->{show_filename};
+ $opt_regex = $opt->{regex};
+ $opt_break = $opt->{break};
+ $opt_count = $opt->{count};
+ $opt_v = $opt->{v};
+ $opt_m = $opt->{m};
+ $opt_g = $opt->{g};
+ $opt_f = $opt->{f};
+ $opt_lines = $opt->{lines};
+ $opt_L = $opt->{L};
+ $opt_l = $opt->{l};
+ $opt_passthru = $opt->{passthru};
+ $opt_column = $opt->{column};
+
$App::Ack::report_bad_filenames = !$opt->{dont_report_bad_filenames};
if ( $opt->{flush} ) {
$| = 1;
}
- if ( not defined $opt->{color} ) {
- $opt->{color} = !App::Ack::output_to_pipe() && !$App::Ack::is_windows;
+ if ( !defined($opt_color) && !$opt_g ) {
+ my $windows_color = 1;
+ if ( $App::Ack::is_windows ) {
+ $windows_color = eval { require Win32::Console::ANSI; };
+ }
+ $opt_color = !App::Ack::output_to_pipe() && $windows_color;
}
- if ( not defined $opt->{heading} and not defined $opt->{break} ) {
- $opt->{heading} = $opt->{break} = !App::Ack::output_to_pipe();
+ if ( not defined $opt_heading and not defined $opt_break ) {
+ $opt_heading = $opt_break = $opt->{break} = !App::Ack::output_to_pipe();
}
if ( defined($opt->{H}) || defined($opt->{h}) ) {
- $opt->{show_filename}= $opt->{H} && !$opt->{h};
+ $opt_show_filename = $opt->{show_filename} = $opt->{H} && !$opt->{h};
}
- if ( my $output = $opt->{output} ) {
+ if ( my $output = $opt_output ) {
$output =~ s{\\}{\\\\}g;
$output =~ s{"}{\\"}g;
- $opt->{output} = qq{"$output"};
+ $opt_output = qq{"$output"};
}
my $resources;
if ( $App::Ack::is_filter_mode && !$opt->{files_from} ) { # probably -x
$resources = App::Ack::Resources->from_stdin( $opt );
- my $regex = $opt->{regex};
- $regex = shift @ARGV if not defined $regex;
- $opt->{regex} = build_regex( $regex, $opt );
+ $opt_regex = shift @ARGV if not defined $opt_regex;
+ $opt_regex = $opt->{regex} = build_regex( $opt_regex, $opt );
}
else {
- if ( $opt->{f} || $opt->{lines} ) {
- if ( $opt->{regex} ) {
- App::Ack::warn( "regex ($opt->{regex}) specified with -f or --lines" );
+ if ( $opt_f || $opt_lines ) {
+ if ( $opt_regex ) {
+ App::Ack::warn( "regex ($opt_regex) specified with -f or --lines" );
App::Ack::exit_from_ack( 0 ); # XXX the 0 is misleading
}
}
else {
- my $regex = $opt->{regex};
- $regex = shift @ARGV if not defined $regex;
- $opt->{regex} = build_regex( $regex, $opt );
+ $opt_regex = shift @ARGV if not defined $opt_regex;
+ $opt_regex = $opt->{regex} = build_regex( $opt_regex, $opt );
+ }
+ if ( $opt_regex && $opt_regex =~ /\n/ ) {
+ App::Ack::exit_from_ack( 0 );
}
my @start;
if ( not defined $opt->{files_from} ) {
}
if ( !exists($opt->{show_filename}) ) {
unless(@start == 1 && !(-d $start[0])) {
- $opt->{show_filename} = 1;
+ $opt_show_filename = $opt->{show_filename} = 1;
}
}
}
App::Ack::set_up_pager( $opt->{pager} ) if defined $opt->{pager};
- my $print_filenames = $opt->{show_filename};
- my $max_count = $opt->{m};
- my $ors = $opt->{print0} ? "\0" : "\n";
- my $only_first = $opt->{1};
+ my $ors = $opt_print0 ? "\0" : "\n";
+ my $only_first = $opt->{1};
my $nmatches = 0;
my $total_count = 0;
+
+ set_up_line_context();
+
RESOURCES:
while ( my $resource = $resources->next ) {
- # XXX this variable name combined with what we're trying
- # to do makes no sense.
+ if ($is_tracking_context) {
+ set_up_line_context_for_file();
+ }
- # XXX Combine the -f and -g functions
- if ( $opt->{f} ) {
- # XXX printing should probably happen inside of App::Ack
+ if ( $opt_f ) {
if ( $opt->{show_types} ) {
show_types( $resource, $ors );
}
App::Ack::print( $resource->name, $ors );
}
++$nmatches;
- last RESOURCES if defined($max_count) && $nmatches >= $max_count;
+ last RESOURCES if defined($opt_m) && $nmatches >= $opt_m;
}
- elsif ( $opt->{g} ) {
- my $is_match = ( $resource->name =~ /$opt->{regex}/o );
- if ( $opt->{v} ? !$is_match : $is_match ) {
- if ( $opt->{show_types} ) {
- show_types( $resource, $ors );
- }
- else {
- App::Ack::print( $resource->name, $ors );
- }
- ++$nmatches;
- last RESOURCES if defined($max_count) && $nmatches >= $max_count;
+ elsif ( $opt_g ) {
+ if ( $opt->{show_types} ) {
+ show_types( $resource, $ors );
}
- }
- elsif ( $opt->{lines} ) {
- my $print_filename = $opt->{show_filename};
- my $passthru = $opt->{passthru};
+ else {
+ local $opt_show_filename = 0; # XXX Why is this local?
+ print_line_with_options( '', $resource->name, 0, $ors );
+ }
+ ++$nmatches;
+ last RESOURCES if defined($opt_m) && $nmatches >= $opt_m;
+ }
+ elsif ( $opt_lines ) {
my %line_numbers;
- foreach my $line ( @{ $opt->{lines} } ) {
+ foreach my $line ( @{ $opt_lines } ) {
my @lines = split /,/, $line;
@lines = map {
/^(\d+)-(\d+)$/
my $filename = $resource->name;
- local $opt->{color} = 0;
+ local $opt_color = 0;
- iterate($resource, $opt, sub {
+ iterate( $resource, sub {
chomp;
if ( $line_numbers{$.} ) {
- print_line_with_context($opt, $filename, $_, $.);
+ print_line_with_context( $filename, $_, $. );
}
- elsif ( $passthru ) {
- print_line_with_options($opt, $filename, $_, $., ':');
+ elsif ( $opt_passthru ) {
+ print_line_with_options( $filename, $_, $., ':' );
+ }
+ elsif ( $is_tracking_context ) {
+ print_line_if_context( $filename, $_, $., '-' );
}
return 1;
});
}
- elsif ( $opt->{count} ) {
- my $matches_for_this_file = count_matches_in_resource( $resource, $opt );
+ elsif ( $opt_count ) {
+ my $matches_for_this_file = count_matches_in_resource( $resource );
- unless ( $opt->{show_filename} ) {
+ if ( not $opt_show_filename ) {
$total_count += $matches_for_this_file;
next RESOURCES;
}
- if ( !$opt->{l} || $matches_for_this_file > 0) {
- if ( $print_filenames ) {
+ if ( !$opt_l || $matches_for_this_file > 0) {
+ if ( $opt_show_filename ) {
App::Ack::print( $resource->name, ':', $matches_for_this_file, $ors );
}
else {
}
}
}
- elsif ( $opt->{l} || $opt->{L} ) {
- my $is_match = resource_has_match( $resource, $opt );
+ elsif ( $opt_l || $opt_L ) {
+ my $is_match = resource_has_match( $resource );
- if ( $opt->{L} ? !$is_match : $is_match ) {
+ if ( $opt_L ? !$is_match : $is_match ) {
App::Ack::print( $resource->name, $ors );
++$nmatches;
last RESOURCES if $only_first;
- last RESOURCES if defined($max_count) && $nmatches >= $max_count;
+ last RESOURCES if defined($opt_m) && $nmatches >= $opt_m;
}
}
else {
}
}
- if ( $opt->{count} && !$opt->{show_filename} ) {
+ if ( $opt_count && !$opt_show_filename ) {
App::Ack::print( $total_count, "\n" );
}
App::Ack::exit_from_ack( $nmatches );
}
+=pod
+=encoding UTF-8
=head1 NAME
=head1 DESCRIPTION
-Ack is designed as a replacement for 99% of the uses of F<grep>.
+ack is designed as an alternative to F<grep> for programmers.
-Ack searches the named input FILEs (or standard input if no files
-are named, or the file name - is given) for lines containing a match
-to the given PATTERN. By default, ack prints the matching lines.
+ack searches the named input files or directories for lines containing a
+match to the given PATTERN. By default, ack prints the matching lines.
+If no FILE or DIRECTORY is given, the current directory will be searched.
PATTERN is a Perl regular expression. Perl regular expressions
are commonly found in other programming languages, but for the particulars
=over 4
+=item B<--ackrc>
+
+Specifies an ackrc file to load after all others; see L</"ACKRC LOCATION SEMANTICS">.
+
=item B<-A I<NUM>>, B<--after-context=I<NUM>>
Print I<NUM> lines of trailing context after matching lines.
=item B<-C [I<NUM>]>, B<--context[=I<NUM>]>
Print I<NUM> lines (default 2) of context around matching lines.
+You can specify zero lines of context to override another context
+specified in an ackrc.
=item B<-c>, B<--count>
=item B<--[no]color>, B<--[no]colour>
-B<--color> highlights the matching text. B<--nocolor> supresses
+B<--color> highlights the matching text. B<--nocolor> suppresses
the color. This is on by default unless the output is redirected.
On Windows, this option is off by default unless the
=item B<--files-from=I<FILE>>
The list of files to be searched is specified in I<FILE>. The list of
-files are seperated by newlines. If I<FILE> is C<->, the list is loaded
+files are separated by newlines. If I<FILE> is C<->, the list is loaded
from standard input.
=item B<--[no]filter>
-Forces ack to act as if it were recieving input via a pipe.
+Forces ack to act as if it were receiving input via a pipe.
=item B<--[no]follow>
=item B<-g I<PATTERN>>
-Print files where the relative path + filename matches I<PATTERN>.
+Print searchable files where the relative path + filename matches
+I<PATTERN>.
+
+Note that
+
+ ack -g foo
+
+is exactly the same as
+
+ ack -f | ack foo
+
+This means that just as ack will not search, for example, F<.jpg>
+files, C<-g> will not list F<.jpg> files either. ack is not intended
+to be a general-purpose file finder.
+
+Note also that if you have C<-i> in your .ackrc that the filenames
+to be matched will be case-insensitive as well.
+
+This option can be combined with B<--color> to make it easier to
+spot the match.
=item B<--[no]group>
=item B<-w>, B<--word-regexp>
+=item B<-w>, B<--word-regexp>
+
+Turn on "words mode". This sometimes matches a whole word, but the
+semantics is quite subtle. If the passed regexp begins with a word
+character, then a word boundary is required before the match. If the
+passed regexp ends with a word character, or with a word character
+followed by newline, then a word boundary is required after the match.
+
+Thus, for example, B<-w> with the regular expression C<ox> will not
+match the strings C<box> or C<oxen>. However, if the regular
+expression is C<(ox|ass)> then it will match those strings. Because
+the regular expression's first character is C<(>, the B<-w> flag has
+no effect at the start, and because the last character is C<)>, it has
+no effect at the end.
+
Force PATTERN to match only whole words. The PATTERN is wrapped with
C<\b> metacharacters.
Check with the admiral for traps.
+=item B<--cathy>
+
+Chocolate, Chocolate, Chocolate!
+
=back
=head1 THE .ackrc FILE
# Always sort the files
--sort-files
- # Always color, even if piping to a another program
+ # Always color, even if piping to another program
--color
# Use "less -r" as my pager
over again. In the following examples the options will always be shown
on one command line so that they can be easily copy & pasted.
+File types can be specified both with the the I<--type=xxx> option,
+or the file type as an option itself. For example, if you create
+a filetype of "cobol", you can specify I<--type=cobol> or simply
+I<--cobol>. File types must be at least two characters long. This
+is why the C language is I<--cc> and the R language is I<--rr>.
+
I<ack --perl foo> searches for foo in all perl files. I<ack --help=types>
tells you, that perl files are files ending
in .pl, .pm, .pod or .t. So what if you would like to include .xs
--type-set eiffel:ext:e,eiffel
-
In order to see all currently defined types, use I<--help-types>, e.g.
I<ack --type-set backup:ext:bak --type-add perl:ext:perl --help-types>
=back
+=head1 AVAILABLE COLORS
+
+F<ack> uses the colors available in Perl's L<Term::ANSIColor> module, which
+provides the following listed values. Note that case does not matter when using
+these values.
+
+=head2 Foreground colors
+
+ black red green yellow blue magenta cyan white
+
+ bright_black bright_red bright_green bright_yellow
+ bright_blue bright_magenta bright_cyan bright_white
+
+=head2 Background colors
+
+ on_black on_red on_green on_yellow
+ on_blue on_magenta on_cyan on_white
+
+ on_bright_black on_bright_red on_bright_green on_bright_yellow
+ on_bright_blue on_bright_magenta on_bright_cyan on_bright_white
+
=head1 ACK & OTHER TOOLS
-=head2 Vim integration
+=head2 Simple vim integration
F<ack> integrates easily with the Vim text editor. Set this in your
F<.vimrc> to use F<ack> instead of F<grep>:
:grep Dumper perllib
-Miles Sterrett has written a Vim plugin for F<ack> which allows you to use
-C<:Ack> instead of C<:grep>, as well as several other advanced features.
-
-L<https://github.com/mileszs/ack.vim>
-
-=head2 Emacs integration
+=head2 Editor integration
-Phil Jackson put together an F<ack.el> extension that "provides a
-simple compilation mode ... has the ability to guess what files you
-want to search for based on the major-mode."
-
-L<http://www.shellarchive.co.uk/content/emacs.html>
-
-=head2 TextMate integration
-
-Pedro Melo is a TextMate user who writes "I spend my day mostly
-inside TextMate, and the built-in find-in-project sucks with large
-projects. So I hacked a TextMate command that was using find +
-grep to use ack. The result is the Search in Project with ack, and
-you can find it here:
-L<http://www.simplicidade.org/notes/archives/2008/03/search_in_proje.html>"
+Many users have integrated ack into their preferred text editors.
+For details and links, see L<https://beyondgrep.com/more-tools/>.
=head2 Shell and Return Code
input file contains "=head1 NAME"
output "1 : NAME"
-=head2 Share your knowledge
+=head1 COMMUNITY
-Join the ack-users mailing list. Send me your tips and I may add
-them here.
+There are ack mailing lists and a Slack channel for ack. See
+L<https://beyondgrep.com/community/> for details.
=head1 FAQ
=head2 Why isn't ack finding a match in (some file)?
-Probably because it's of a type that ack doesn't recognize. ack's
-searching behavior is driven by filetype. B<If ack doesn't know
-what kind of file it is, ack ignores the file.>
-
-Use the C<-f> switch to see a list of files that ack will search
-for you.
+First, take a look and see if ack is even looking at the file. ack is
+intelligent in what files it will search and which ones it won't, but
+sometimes that can be surprising.
-If you want ack to search files that it doesn't recognize, use the
-C<-a> switch.
+Use the C<-f> switch, with no regex, to see a list of files that ack
+will search for you. If your file doesn't show up in the list of files
+that C<ack -f> shows, then ack never looks in it.
-If you want ack to search every file, even ones that it always
-ignores like coredumps and backup files, use the C<-u> switch.
-
-=head2 Why does ack ignore unknown files by default?
-
-ack is designed by a programmer, for programmers, for searching
-large trees of code. Most codebases have a lot files in them which
-aren't source files (like compiled object files, source control
-metadata, etc), and grep wastes a lot of time searching through all
-of those as well and returning matches from those files.
-
-That's why ack's behavior of not searching things it doesn't recognize
-is one of its greatest strengths: the speed you get from only
-searching the things that you want to be looking at.
+NOTE: If you're using an old ack before 2.0, it's probably because it's of
+a type that ack doesn't recognize. In ack 1.x, the searching behavior is
+driven by filetype. B<If ack 1.x doesn't know what kind of file it is,
+ack ignores the file.> You can use the C<--show-types> switch to show
+which type ack thinks each file is.
=head2 Wouldn't it be great if F<ack> did search & replace?
$ perl -i -p -e's/foo/bar/g' $(ack -f --php)
-=head2 Can you make ack recognize F<.xyz> files?
+=head2 Can I make ack recognize F<.xyz> files?
Yes! Please see L</"Defining your own types">. If you think
that F<ack> should recognize a type by default, please see
use the C<--match> option. (However, don't forget that C<+> is a regular
expression metacharacter!)
+=head2 Why does C<"ack '.{40000,}'"> fail? Isn't that a valid regex?
+
+The Perl language limits the repetition quantifier to 32K. You
+can search for C<.{32767}> but not C<.{32768}>.
+
+=head2 Ack does "X" and shouldn't, should it?
+
+We try to remain as close to grep's behavior as possible, so when in doubt,
+see what grep does! If there's a mismatch in functionality there, please
+bring it up on the ack-users mailing list.
+
=head1 ACKRC LOCATION SEMANTICS
-Ack can load its configuration from many sources. This list
-specifies the sources Ack looks for configuration; each one
+Ack can load its configuration from many sources. The following list
+specifies the sources Ack looks for configuration files; each one
that is found is loaded in the order specified here, and
each one overrides options set in any of the sources preceding
it. (For example, if I set --sort-files in my user ackrc, and
=item * Global ackrc
Options are then loaded from the global ackrc. This is located at
-C</etc/ackrc> on Unix-like systems, and
-C<C:\Documents and Settings\All Users\Application Data> on Windows.
-This can be omitted using C<--noenv>.
+C</etc/ackrc> on Unix-like systems.
+
+Under Windows XP and earlier, the global ackrc is at
+C<C:\Documents and Settings\All Users\Application Data\ackrc>
+
+Under Windows Vista/7, the global ackrc is at
+C<C:\ProgramData\ackrc>
+
+The C<--noenv> option prevents all ackrc files from being loaded.
=item * User ackrc
Options are then loaded from the user's ackrc. This is located at
-C<$HOME/.ackrc> on Unix-like systems, and
-C<C:\Documents and Settings\$USER\Application Data>. If a different
-ackrc is desired, it may be overriden with the C<$ACKRC> environment
-variable.
-This can be omitted using C<--noenv>.
+C<$HOME/.ackrc> on Unix-like systems.
+
+Under Windows XP and earlier, the user's ackrc is at
+C<C:\Documents and Settings\$USER\Application Data\ackrc>.
+
+Under Windows Vista/7, the user's ackrc is at
+C<C:\Users\$USER\AppData\Roaming\ackrc>.
+
+If you want to load a different user-level ackrc, it may be specified
+with the C<$ACKRC> environment variable.
+
+The C<--noenv> option prevents all ackrc files from being loaded.
=item * Project ackrc
in the current directory, then the parent directory, then the grandparent
directory, etc. This can be omitted using C<--noenv>.
+=item * --ackrc
+
+The C<--ackrc> option may be included on the command line to specify an
+ackrc file that can override all others. It is consulted even if C<--noenv>
+is present.
+
=item * ACK_OPTIONS
-Options are then loaded from the enviroment variable C<ACK_OPTIONS>. This can
+Options are then loaded from the environment variable C<ACK_OPTIONS>. This can
be omitted using C<--noenv>.
=item * Command line
=item *
When no selectors are specified, ack 1.x only searches through files that
-it can map to a file type. ack 2.x, by constrast, will search through
+it can map to a file type. ack 2.x, by contrast, will search through
every regular, non-binary file that is not explicitly ignored via
B<--ignore-file> or B<--ignore-dir>. This is similar to the behavior of the
B<-a/--all> option in ack 1.x.
=head1 BUGS
Please report any bugs or feature requests to the issues list at
-Github: L<https://github.com/petdance/ack2/issues>
+Github: L<https://github.com/beyondgrep/ack2/issues>
=head1 ENHANCEMENTS
ack users. This includes requests for new filetypes.
There is a list of enhancements I want to make to F<ack> in the ack
-issues list at Github: L<https://github.com/petdance/ack2/issues>
+issues list at Github: L<https://github.com/beyondgrep/ack2/issues>
Patches are always welcome, but patches with tests get the most
attention.
=item * The ack homepage
-L<http://beyondgrep.com/>
+L<https://beyondgrep.com/>
=item * The ack-users mailing list
=item * The ack issues list at Github
-L<https://github.com/petdance/ack2/issues>
+L<https://github.com/beyondgrep/ack2/issues>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://search.cpan.org/dist/ack>
+=item * MetaCPAN
+
+L<http://metacpan.org/release/ack>
+
=item * Git source repository
-L<https://github.com/petdance/ack2>
+L<https://github.com/beyondgrep/ack2>
=back
How appropriate to have I<ack>nowledgements!
Thanks to everyone who has contributed to ack in any way, including
+Michele Campeotto,
+H.Merijn Brand,
+Duke Leto,
+Gerhard Poul,
+Ethan Mallove,
+Marek Kubica,
+Ray Donnelly,
+Nikolaj Schumacher,
+Ed Avis,
+Nick Morrott,
+Austin Chamberlin,
+Varadinsky,
+SE<eacute>bastien FeugE<egrave>re,
+Jakub Wilk,
+Pete Houston,
+Stephen Thirlwall,
+Jonah Bishop,
+Chris Rebert,
+Denis Howe,
+RaE<uacute>l GundE<iacute>n,
+James McCoy,
+Daniel Perrett,
+Steven Lee,
+Jonathan Perret,
+Fraser Tweedale,
+RaE<aacute>l GundE<aacute>n,
+Steffen Jaeckel,
+Stephan Hohe,
+Michael Beijen,
+Alexandr Ciornii,
+Christian Walde,
+Charles Lee,
+Joe McMahon,
+John Warwick,
+David Steinbrunner,
+Kara Martens,
+Volodymyr Medvid,
+Ron Savage,
+Konrad Borowski,
Dale Sedivic,
Michael McClimon,
Andrew Black,
=head1 COPYRIGHT & LICENSE
-Copyright 2005-2013 Andy Lester.
+Copyright 2005-2017 Andy Lester.
This program is free software; you can redistribute it and/or modify
it under the terms of the Artistic License v2.0.
file that comes with the ack distribution.
=cut
-package File::Next;
-
-use strict;
-use warnings;
-
-
-our $VERSION = '1.12';
-
-
-
-use File::Spec ();
-
-our $name; # name of the current file
-our $dir; # dir of the current file
-
-our %files_defaults;
-our %skip_dirs;
-
-BEGIN {
- %files_defaults = (
- file_filter => undef,
- descend_filter => undef,
- error_handler => sub { CORE::die @_ },
- warning_handler => sub { CORE::warn @_ },
- sort_files => undef,
- follow_symlinks => 1,
- nul_separated => 0,
- );
- %skip_dirs = map {($_,1)} (File::Spec->curdir, File::Spec->updir);
-}
-
-
-sub files {
- die _bad_invocation() if @_ && defined($_[0]) && ($_[0] eq __PACKAGE__);
-
- my ($parms,@queue) = _setup( \%files_defaults, @_ );
- my $filter = $parms->{file_filter};
-
- return sub {
- while (@queue) {
- my ($dirname,$file,$fullpath) = splice( @queue, 0, 3 );
- if ( -f $fullpath || -p $fullpath || $fullpath =~ m{^/dev/fd} ) {
- if ( $filter ) {
- local $_ = $file;
- local $File::Next::dir = $dirname;
- local $File::Next::name = $fullpath;
- next if not $filter->();
- }
- return wantarray ? ($dirname,$file,$fullpath) : $fullpath;
- }
- elsif ( -d _ ) {
- unshift( @queue, _candidate_files( $parms, $fullpath ) );
- }
- } # while
-
- return;
- }; # iterator
-}
-
-
-
-
-
-
-sub from_file {
- die _bad_invocation() if @_ && defined($_[0]) && ($_[0] eq __PACKAGE__);
-
- my ($parms,@queue) = _setup( \%files_defaults, @_ );
- my $err = $parms->{error_handler};
- my $warn = $parms->{error_handler};
-
- my $filename = $queue[1];
-
- if ( !defined($filename) ) {
- $err->( 'Must pass a filename to from_file()' );
- return undef;
- }
-
- my $fh;
- if ( $filename eq '-' ) {
- $fh = \*STDIN;
- }
- else {
- if ( !open( $fh, '<', $filename ) ) {
- $err->( "Unable to open $filename: $!" );
- return undef;
- }
- }
- my $filter = $parms->{file_filter};
-
- return sub {
- local $/ = $parms->{nul_separated} ? "\x00" : $/;
- while ( my $fullpath = <$fh> ) {
- chomp $fullpath;
- next unless $fullpath =~ /./;
- if ( not ( -f $fullpath || -p _ ) ) {
- $warn->( "$fullpath: No such file" );
- next;
- }
-
- my ($volume,$dirname,$file) = File::Spec->splitpath( $fullpath );
- if ( $filter ) {
- local $_ = $file;
- local $File::Next::dir = $dirname;
- local $File::Next::name = $fullpath;
- next if not $filter->();
- }
- return wantarray ? ($dirname,$file,$fullpath) : $fullpath;
- } # while
- close $fh;
-
- return;
- }; # iterator
-}
-
-sub _bad_invocation {
- my $good = (caller(1))[3];
- my $bad = $good;
- $bad =~ s/(.+)::/$1->/;
- return "$good must not be invoked as $bad";
-}
-
-sub sort_standard($$) { return $_[0]->[1] cmp $_[1]->[1] }
-sub sort_reverse($$) { return $_[1]->[1] cmp $_[0]->[1] }
-
-sub reslash {
- my $path = shift;
-
- my @parts = split( /\//, $path );
-
- return $path if @parts < 2;
-
- return File::Spec->catfile( @parts );
-}
-
-
-
-sub _setup {
- my $defaults = shift;
- my $passed_parms = ref $_[0] eq 'HASH' ? {%{+shift}} : {}; # copy parm hash
-
- my %passed_parms = %{$passed_parms};
-
- my $parms = {};
- for my $key ( keys %{$defaults} ) {
- $parms->{$key} =
- exists $passed_parms{$key}
- ? delete $passed_parms{$key}
- : $defaults->{$key};
- }
-
- # Any leftover keys are bogus
- for my $badkey ( keys %passed_parms ) {
- my $sub = (caller(1))[3];
- $parms->{error_handler}->( "Invalid option passed to $sub(): $badkey" );
- }
-
- # If it's not a code ref, assume standard sort
- if ( $parms->{sort_files} && ( ref($parms->{sort_files}) ne 'CODE' ) ) {
- $parms->{sort_files} = \&sort_standard;
- }
- my @queue;
-
- for ( @_ ) {
- my $start = reslash( $_ );
- if (-d $start) {
- push @queue, ($start,undef,$start);
- }
- else {
- push @queue, (undef,$start,$start);
- }
- }
-
- return ($parms,@queue);
-}
-
-
-sub _candidate_files {
- my $parms = shift;
- my $dirname = shift;
-
- my $dh;
- if ( !opendir $dh, $dirname ) {
- $parms->{error_handler}->( "$dirname: $!" );
- return;
- }
-
- my @newfiles;
- my $descend_filter = $parms->{descend_filter};
- my $follow_symlinks = $parms->{follow_symlinks};
- my $sort_sub = $parms->{sort_files};
-
- for my $file ( grep { !exists $skip_dirs{$_} } readdir $dh ) {
- my $has_stat;
-
- # Only do directory checking if we have a descend_filter
- my $fullpath = File::Spec->catdir( $dirname, $file );
- if ( !$follow_symlinks ) {
- next if -l $fullpath;
- $has_stat = 1;
- }
-
- if ( $descend_filter ) {
- if ( $has_stat ? (-d _) : (-d $fullpath) ) {
- local $File::Next::dir = $fullpath;
- local $_ = $file;
- next if not $descend_filter->();
- }
- }
- if ( $sort_sub ) {
- push( @newfiles, [ $dirname, $file, $fullpath ] );
- }
- else {
- push( @newfiles, $dirname, $file, $fullpath );
- }
- }
- closedir $dh;
-
- if ( $sort_sub ) {
- return map { @{$_} } sort $sort_sub @newfiles;
- }
-
- return @newfiles;
-}
-
-
-1; # End of File::Next
-package App::Ack;
+package App::Ack;
use warnings;
use strict;
our $VERSION;
-our $GIT_REVISION;
our $COPYRIGHT;
BEGIN {
- $VERSION = '2.04';
- $COPYRIGHT = 'Copyright 2005-2013 Andy Lester.';
- $GIT_REVISION = q{8f405b7};
+ $VERSION = '2.22';
+ $COPYRIGHT = 'Copyright 2005-2017 Andy Lester.';
}
our $fh;
$output_to_pipe = not -t *STDOUT;
$is_filter_mode = -p STDIN;
- $is_cygwin = ($^O eq 'cygwin');
- $is_windows = ($^O =~ /MSWin32/);
+ $is_cygwin = ($^O eq 'cygwin' || $^O eq 'msys');
+ $is_windows = ($^O eq 'MSWin32');
$dir_sep_chars = $is_windows ? quotemeta( '\\/' ) : quotemeta( File::Spec->catfile( '', '' ) );
}
return keys %mappings;
}
-sub _get_thpppt {
+sub thpppt {
my $y = q{_ /|,\\'!.x',=(www)=, U };
$y =~ tr/,x!w/\nOo_/;
- return $y;
-}
-sub _thpppt {
- my $y = _get_thpppt();
App::Ack::print( "$y ack $_[0]!\n" );
exit 0;
}
-sub _bar {
+sub ackbar {
my $x;
$x = <<'_BAR';
6?!I'7!I"?%+!
77I!+!7!?!7!I"71+!7,
_BAR
- $x =~ s/(.)(.)/$1x(ord($2)-32)/eg;
- App::Ack::print( $x );
+ return _pic_decode($x);
+}
+
+sub cathy {
+ my $x = <<'CATHY';
+ 0+!--+!
+ 0|! "C!H!O!C!O!L!A!T!E!!! !|!
+ 0|! "C!H!O!C!O!L!A!T!E!!! !|!
+ 0|! "C!H!O!C!O!L!A!T!E!!! !|!
+ 0|! $A"C!K!!! $|!
+ 0+!--+!
+ 6\! 1:!,!.! !
+ 7\! /.!M!~!Z!M!~!
+ 8\! /~!D! "M! !
+ 4.! $\! /M!~!.!8! +.!M# 4
+ 0,!.! (\! .~!M!N! ,+!I!.!M!.! 3
+ /?!O!.!M!:! '\! .O!.! +~!Z!=!N!.! 4
+ ..! !D!Z!.!Z!.! '\! 9=!M".! 6
+ /.! !.!~!M".! '\! 8~! 9
+ 4M!.! /.!7!N!M!.! F
+ 4.! &:!M! !N"M# !M"N!M! #D!M&=! =
+ :M!7!M#:! !~!M!7!,!$!M!:! #.! !O!N!.!M!:!M# ;
+ 8Z!M"~!N!$!D!.!N!?! !I!N!.! (?!M! !M!,!D!M".! 9
+ (?!Z!M!N!:! )=!M!O!8!.!M!+!M! !M!,! !O!M! +,!M!.!M!~!Z!N!M!:! &:!~! 0
+ &8!7!.!~!M"D!M!,! &M!?!=!8! !M!,!O! !M!+! !+!O!.!M! $M#~! !.!8!M!Z!.!M! !O!M"Z! %:!~!M!Z!M!Z!.! +
+ &:!M!7!,! *M!.!Z!M! !8"M!.!M!~! !.!M!.!=! #~!8!.!M! !7!M! "N!Z#I! !D!M!,!M!.! $."M!,! !M!.! *
+ 2$!O! "N! !.!M!I! !7" "M! "+!O! !~!M! !d!O!.!7!I!M!.! !.!O!=!M!.! !M",!M!.! %.!$!O!D! +
+ 1~!O! "M!+! !8!$! "M! "?!O! %Z!8!D!M!?!8!I!O!7!M! #M!.!M! "M",!M! 4
+ 07!~! ".!8! !.!M! "I!+! !.!M! &Z!D!.!7!=!M! !:!.!M! #:!8"+! !.!+!8! !8! 3
+ /~!M! #N! !~!M!$! !.!M! !.!M" &~!M! "~!M!O! "D! $M! !8! "M!,!M!+!D!.! 1
+ #.! #?!M!N!.! #~!O! $M!.!7!$! "?" !?!~!M! '7!8!?!M!.!+!M"O! $?"$!D! !.!O! !$!7!I!.! 0
+ $,!M!:!O!?! ".! !?!=! $=!:!O! !M! "M! !M! !+!$! (.! +.!M! !M!.! !8! !+"Z!~! $:!M!$! !.! '
+ #.!8!.!I!$! $7!I! %M" !=!M! !~!M!D! "7!I! .I!O! %?!=!,!D! !,!M! !D!~!8!~! %D!M! (
+ #.!M"?! $=!O! %=!N! "8!.! !Z!M! #M!~! (M!:! #.!M" &O! !M!.! !?!,! !8!.!N!~! $8!N!M!,!.! %
+ *$!O! &M!,! "O! !.!M!.! #M! (~!M( &O!.! !7! "M! !.!M!.!M!,! #.!M! !M! &
+ )=!8!.! $.!M!O!.! "$!.!I!N! !I!M# (7!M(I! %D"Z!M! "=!I! "M! !M!:! #~!D! '
+ )D! &8!N!:! ".!O! !M!="M! "M! (7!M) %." !M!D!."M!.! !$!=! !M!,! +
+ (M! &+!.!M! #Z!7!O!M!.!~!8! +,!M#D!?!M#D! #.!Z!M#,!Z!?! !~!N! "N!.! !M! +
+ 'D!:! %$!D! !?! #M!Z! !8!.! !M"?!7!?!7! '+!I!D! !?!O!:!M!:! ":!M!:! !M!7".!M! "8!+! !:!D! !.!M! *
+ %.!O!:! $.!O!+! !D!.! #M! "M!.!+!N!I!Z! "7!M!N!M!N!?!I!7!Z!=!M'D"~! #M!.!8!$! !:! !.!M! "N!?! !,!O! )
+ !.!?!M!:!M!I! %8!,! "M!.! #M! "N! !M!.! !M!.! !+!~! !.!M!.! ':!M! $M! $M!Z!$! !M!.! "D! "M! "?!M! (
+ !7!8! !+!I! ".! "$!=! ":!$! "+! !M!.! !O! !M!I!M".! !=!~! ",!O! '=!M! $$!,! #N!:! ":!8!.! !D!~! !,!M!.! !:!M!.! &
+ !:!,!.! &Z" #D! !.!8!."M!.! !8!?!Z!M!.!M! #Z!~! !?!M!Z!.! %~!O!.!8!$!N!8!O!I!:!~! !+! #M!.! !.!M!.! !+!M! ".!~!M!+! $
+ !.! 'D!I! #?!M!.!M!,! !.!Z! !.!8! #M&O!I!?! (~!I!M"." !M!Z!.! !M!N!.! "+!$!.! "M!.! !M!?!.! "8!M! $
+ (O!8! $M! !M!.! ".!:! !+!=! #M! #.!M! !+" *$!M":!.! !M!~! "M!7! #M! #7!Z! "M"$!M!.! !.! #
+ '$!Z! #.!7!+!M! $.!,! !+!:! #N! #.!M!.!+!M! +D!M! #=!N! ":!O! #=!M! #Z!D! $M!I! %
+ $,! ".! $.!M" %$!.! !?!~! "+!7!." !.!M!,! !M! *,!N!M!.$M!?! "D!,! #M!.! #N! +
+ ,M!Z! &M! "I!,! "M! %I!M! !?!=!.! (Z!8!M! $:!M!.! !,!M! $D! #.!M!.! )
+ +8!O! &.!8! "I!,! !~!M! &N!M! !M!D! '?!N!O!." $?!7! "?!~! #M!.! #I!D!.! (
+ 3M!,! "N!.! !D" &.!+!M!.! !M":!.":!M!7!M!D! 'M!.! "M!.! "M!,! $I! )
+ 3I! #M! "M!,! !:! &.!M" ".!,! !.!$!M!I! #.! !:! !.!M!?! "N!+! ".! /
+ 1M!,! #.!M!8!M!=!.! +~!N"O!Z"~! *+!M!.! "M! 2
+ 0.!M! &M!.! 8:! %.!M!Z! "M!=! *O!,! %
+ 0?!$! &N! )." .,! %."M! ":!M!.! 0
+ 0N!:! %?!O! #.! ..! &,! &.!D!,! "N!I! 0
+CATHY
+ return _pic_decode($x);
+}
+
+sub _pic_decode {
+ my($compressed) = @_;
+ $compressed =~ s/(.)(.)/$1x(ord($2)-32)/eg;
+ App::Ack::print( $compressed );
exit 0;
}
-c, --count Show number of lines matching per file
--[no]column Show the column number of the first match
- -A NUM, --after-context=NUM Print NUM lines of trailing context after matching
- lines.
- -B NUM, --before-context=NUM Print NUM lines of leading context before matching
- lines.
+ -A NUM, --after-context=NUM Print NUM lines of trailing context after
+ matching lines.
+ -B NUM, --before-context=NUM Print NUM lines of leading context before
+ matching lines.
-C [NUM], --context[=NUM] Print NUM lines (default 2) of output context.
--print0 Print null byte as separator between filenames,
File presentation:
- --pager=COMMAND Pipes all ack output through COMMAND. For example,
- --pager="less -R". Ignored if output is redirected.
- --nopager Do not send output through a pager. Cancels any
- setting in ~/.ackrc, ACK_PAGER or ACK_PAGER_COLOR.
- --[no]heading Print a filename heading above each file's results.
- (default: on when used interactively)
- --[no]break Print a break between results from different files.
- (default: on when used interactively)
+ --pager=COMMAND Pipes all ack output through COMMAND. For
+ example, --pager="less -R". Ignored if output
+ is redirected.
+ --nopager Do not send output through a pager. Cancels
+ any setting in ~/.ackrc, ACK_PAGER or
+ ACK_PAGER_COLOR.
+ --[no]heading Print a filename heading above each file's
+ results. (default: on when used interactively)
+ --[no]break Print a break between results from different
+ files. (default: on when used interactively)
--group Same as --heading --break
--nogroup Same as --noheading --nobreak
--[no]color Highlight the matching text (default: on unless
--[no]colour Same as --[no]color
--color-filename=COLOR
--color-match=COLOR
- --color-lineno=COLOR Set the color for filenames, matches, and line numbers.
+ --color-lineno=COLOR Set the color for filenames, matches, and line
+ numbers.
--flush Flush output immediately, even when ack is used
non-interactively (when output goes to a pipe or
file).
File finding:
- -f Only print the files selected, without searching.
- The PATTERN must not be specified.
- -g Same as -f, but only select files matching PATTERN.
+ -f Only print the files selected, without
+ searching. The PATTERN must not be specified.
+ -g Same as -f, but only select files matching
+ PATTERN.
--sort-files Sort the found files lexically.
--show-types Show which types each file has.
--files-from=FILE Read the list of files to search from FILE.
-x Read the list of files to search from STDIN.
File inclusion/exclusion:
- --[no]ignore-dir=name Add/Remove directory from the list of ignored dirs
+ --[no]ignore-dir=name Add/remove directory from list of ignored dirs
--[no]ignore-directory=name Synonym for ignore-dir
--ignore-file=filter Add filter for ignoring files
- -r, -R, --recurse Recurse into subdirectories (ack's default behavior)
+ -r, -R, --recurse Recurse into subdirectories (default: on)
-n, --no-recurse No descending into subdirectories
--[no]follow Follow symlinks. Default is off.
- -k, --known-types Include only files with types that ack recognizes.
+ -k, --known-types Include only files of types that ack recognizes.
- --type=X Include only X files, where X is a recognized filetype.
+ --type=X Include only X files, where X is a recognized
+ filetype.
--type=noX Exclude X files.
See "ack --help-types" for supported filetypes.
File type specification:
--type-set TYPE:FILTER:FILTERARGS
- Files with the given FILTERARGS applied to the given
- FILTER are recognized as being of type TYPE. This
- replaces an existing definition for type TYPE.
+ Files with the given FILTERARGS applied to the
+ given FILTER are recognized as being of type
+ TYPE. This replaces an existing definition for
+ type TYPE.
--type-add TYPE:FILTER:FILTERARGS
- Files with the given FILTERARGS applied to the given
- FILTER are recognized as being of type TYPE.
+ Files with the given FILTERARGS applied to the
+ given FILTER are recognized as being type TYPE.
--type-del TYPE Removes all filters associated with TYPE.
Miscellaneous:
- --[no]env Ignore environment variables and global ackrc files. --env is legal but redundant.
+ --[no]env Ignore environment variables and global ackrc
+ files. --env is legal but redundant.
--ackrc=filename Specify an ackrc file to use
- --ignore-ack-defaults Ignore the default definitions that ack includes.
- --create-ackrc Outputs a default ackrc for your customization to standard output.
+ --ignore-ack-defaults Ignore default definitions included with ack.
+ --create-ackrc Outputs a default ackrc for your customization
+ to standard output.
--help, -? This help
--help-types Display all known types
- --dump Dump information on which options are loaded from which RC files
- --[no]filter Force ack to treat standard input as a pipe (--filter) or tty (--nofilter)
+ --dump Dump information on which options are loaded
+ from which RC files
+ --[no]filter Force ack to treat standard input as a pipe
+ (--filter) or tty (--nofilter)
--man Man page
--version Display version & copyright
--thpppt Bill the Cat
--bar The warning admiral
+ --cathy Chocolate! Chocolate! Chocolate!
Exit status is 0 if match, 1 if no match.
-This is version $VERSION of ack.
+ack's home page is at https://beyondgrep.com/
+
+The full ack manual is available by running "ack --man".
+
+This is version $VERSION of ack. Run "ack --version" for full version info.
END_OF_HELP
return;
}
my $ver = sprintf( '%vd', $^V );
- my $git_revision = $GIT_REVISION ? " (git commit $GIT_REVISION)" : '';
-
return <<"END_OF_VERSION";
-ack ${VERSION}${git_revision}
+ack ${VERSION}
Running under Perl $ver at $this_perl
$copyright
}
-# print subs added in order to make it easy for a third party
-# module (such as App::Wack) to redefine the display methods
-# and show the results in a different way.
sub print { print {$fh} @_; return; }
-sub print_first_filename { App::Ack::print( $_[0], "\n" ); return; }
sub print_blank_line { App::Ack::print( "\n" ); return; }
-sub print_separator { App::Ack::print( "--\n" ); return; }
sub print_filename { App::Ack::print( $_[0], $_[1] ); return; }
-sub print_line_no { App::Ack::print( $_[0], $_[1] ); return; }
-sub print_column_no { App::Ack::print( $_[0], $_[1] ); return; }
-sub print_count {
- my $filename = shift;
- my $nmatches = shift;
- my $ors = shift;
- my $count = shift;
- my $show_filename = shift;
-
- if ($show_filename) {
- App::Ack::print( $filename );
- App::Ack::print( ':', $nmatches ) if $count;
- }
- else {
- App::Ack::print( $nmatches ) if $count;
- }
- App::Ack::print( $ors );
-
- return;
-}
-
-sub print_count0 {
- my $filename = shift;
- my $ors = shift;
- my $show_filename = shift;
-
- if ($show_filename) {
- App::Ack::print( $filename, ':0', $ors );
- }
- else {
- App::Ack::print( '0', $ors );
- }
-
- return;
-}
sub set_up_pager {
my $command = shift;
use overload
'""' => 'name';
-sub FAIL {
- require Carp;
- Carp::confess( 'Must be overloaded' );
-}
-
sub new {
- return FAIL();
-}
+ my $class = shift;
+ my $filename = shift;
+ my $self = bless {
+ filename => $filename,
+ fh => undef,
+ opened => 0,
+ }, $class;
-sub name {
- return FAIL();
-}
+ if ( $self->{filename} eq '-' ) {
+ $self->{fh} = *STDIN;
+ $self->{opened} = 1;
+ }
+ return $self;
+}
+
+
+
+sub name {
+ return $_[0]->{filename};
+}
-sub is_binary {
- return FAIL();
+
+
+sub basename {
+ my ( $self ) = @_;
+
+ # XXX Definedness? Pre-populate the slot with an undef?
+ unless ( exists $self->{basename} ) {
+ $self->{basename} = (File::Spec->splitpath($self->name))[2];
+ }
+
+ return $self->{basename};
}
+
sub open {
- return FAIL();
+ my ( $self ) = @_;
+
+ if ( !$self->{opened} ) {
+ if ( open $self->{fh}, '<', $self->{filename} ) {
+ $self->{opened} = 1;
+ }
+ else {
+ $self->{fh} = undef;
+ }
+ }
+
+ return $self->{fh};
}
+
sub needs_line_scan {
- return FAIL();
+ my $self = shift;
+ my $opt = shift;
+
+ return 1 if $opt->{v};
+
+ my $size = -s $self->{fh};
+ if ( $size == 0 ) {
+ return 0;
+ }
+ elsif ( $size > 100_000 ) {
+ return 1;
+ }
+
+ my $buffer;
+ my $rc = sysread( $self->{fh}, $buffer, $size );
+ if ( !defined($rc) && $App::Ack::report_bad_filenames ) {
+ App::Ack::warn( "$self->{filename}: $!" );
+ return 1;
+ }
+ return 0 unless $rc && ( $rc == $size );
+
+ return $buffer =~ /$opt->{regex}/m;
}
+
sub reset {
- return FAIL();
+ my $self = shift;
+
+ # Return if we haven't opened the file yet.
+ if ( !defined($self->{fh}) ) {
+ return;
+ }
+
+ if ( !seek( $self->{fh}, 0, 0 ) && $App::Ack::report_bad_filenames ) {
+ App::Ack::warn( "$self->{filename}: $!" );
+ }
+
+ return;
}
+
sub close {
- return FAIL();
+ my $self = shift;
+
+ # Return if we haven't opened the file yet.
+ if ( !defined($self->{fh}) ) {
+ return;
+ }
+
+ if ( !close($self->{fh}) && $App::Ack::report_bad_filenames ) {
+ App::Ack::warn( $self->name() . ": $!" );
+ }
+
+ $self->{opened} = 0;
+
+ return;
}
+
sub clone {
- return FAIL();
+ my ( $self ) = @_;
+
+ return __PACKAGE__->new($self->name);
}
+
sub firstliney {
- return FAIL();
+ my ( $self ) = @_;
+
+ if ( !exists $self->{firstliney} ) {
+ my $fh = $self->open();
+ if ( !$fh ) {
+ if ( $App::Ack::report_bad_filenames ) {
+ App::Ack::warn( $self->name . ': ' . $! );
+ }
+ return '';
+ }
+
+ my $buffer = '';
+ my $rc = sysread( $fh, $buffer, 250 );
+ unless($rc) { # XXX handle this better?
+ $buffer = '';
+ }
+ $buffer =~ s/[\r\n].*//s;
+ $self->{firstliney} = $buffer;
+ $self->reset;
+
+ $self->close;
+ }
+
+ return $self->{firstliney};
}
1;
+use Errno qw(EACCES);
+
use warnings;
use strict;
+sub _generate_error_handler {
+ my $opt = shift;
+
+ if ( $opt->{dont_report_bad_filenames} ) {
+ return sub {
+ my $msg = shift;
+ if ( $! == EACCES ) {
+ return;
+ }
+ App::Ack::warn( $msg );
+ };
+ }
+ else {
+ return sub {
+ my $msg = shift;
+ App::Ack::warn( $msg );
+ };
+ }
+}
+
sub from_argv {
my $class = shift;
File::Next::files( {
file_filter => $opt->{file_filter},
descend_filter => $descend_filter,
- error_handler => sub { my $msg = shift; App::Ack::warn( $msg ) },
+ error_handler => _generate_error_handler($opt),
+ warning_handler => sub {},
sort_files => $opt->{sort_files},
follow_symlinks => $opt->{follow},
}, @{$start} );
my $iter =
File::Next::from_file( {
- error_handler => sub { my $msg = shift; App::Ack::warn( $msg ) },
- warning_handler => sub { my $msg = shift; App::Ack::warn( $msg ) },
+ error_handler => _generate_error_handler($opt),
+ warning_handler => _generate_error_handler($opt),
sort_files => $opt->{sort_files},
}, $file ) or return undef;
my $file = $self->{iter}->() or return;
- return App::Ack::Resource::Basic->new( $file );
+ return App::Ack::Resource->new( $file );
}
1;
-package App::Ack::Resource::Basic;
-
+package App::Ack::ConfigDefault;
use warnings;
use strict;
-use Fcntl ();
-
-BEGIN {
- our @ISA = 'App::Ack::Resource';
-}
-
-
-sub new {
- my $class = shift;
- my $filename = shift;
- my $self = bless {
- filename => $filename,
- fh => undef,
- opened => 0,
- }, $class;
- if ( $self->{filename} eq '-' ) {
- $self->{fh} = *STDIN;
- $self->{opened} = 1;
- }
- return $self;
+sub options {
+ return split( /\n/, _options_block() );
}
-sub name {
- return $_[0]->{filename};
+sub options_clean {
+ return grep { /./ && !/^#/ } options();
}
+sub _options_block {
+ my $lines = <<'HERE';
+# This is the default ackrc for ack version ==VERSION==.
-sub needs_line_scan {
- my $self = shift;
- my $opt = shift;
+# There are four different ways to match
+#
+# is: Match the filename exactly
+#
+# ext: Match the extension of the filename exactly
+#
+# match: Match the filename against a Perl regular expression
+#
+# firstlinematch: Match the first 250 characters of the first line
+# of text against a Perl regular expression. This is only for
+# the --type-add option.
- return 1 if $opt->{v};
- my $size = -s $self->{fh};
- if ( $size == 0 ) {
- return 0;
- }
- elsif ( $size > 100_000 ) {
- return 1;
- }
+### Directories to ignore
- my $buffer;
- my $rc = sysread( $self->{fh}, $buffer, $size );
- if ( !defined($rc) && $App::Ack::report_bad_filenames ) {
- App::Ack::warn( "$self->{filename}: $!" );
- return 1;
- }
- return 0 unless $rc && ( $rc == $size );
+# Bazaar
+# http://bazaar.canonical.com/
+--ignore-directory=is:.bzr
- my $regex = $opt->{regex};
- return $buffer =~ /$regex/m;
-}
+# Codeville
+# http://freecode.com/projects/codeville
+--ignore-directory=is:.cdv
+# Interface Builder (Xcode)
+# http://en.wikipedia.org/wiki/Interface_Builder
+--ignore-directory=is:~.dep
+--ignore-directory=is:~.dot
+--ignore-directory=is:~.nib
+--ignore-directory=is:~.plst
-sub reset {
- my $self = shift;
+# Git
+# http://git-scm.com/
+--ignore-directory=is:.git
+# When using submodules, .git is a file.
+--ignore-file=is:.git
- # return if we haven't opened the file yet
- if ( !defined($self->{fh}) ) {
- return;
- }
+# Mercurial
+# http://mercurial.selenic.com/
+--ignore-directory=is:.hg
- if( !seek( $self->{fh}, 0, 0 ) && $App::Ack::report_bad_filenames ) {
- App::Ack::warn( "$self->{filename}: $!" );
- }
+# quilt
+# http://directory.fsf.org/wiki/Quilt
+--ignore-directory=is:.pc
- return;
-}
+# Subversion
+# http://subversion.tigris.org/
+--ignore-directory=is:.svn
+# Monotone
+# http://www.monotone.ca/
+--ignore-directory=is:_MTN
-sub close {
- my $self = shift;
+# CVS
+# http://savannah.nongnu.org/projects/cvs
+--ignore-directory=is:CVS
- # return if we haven't opened the file yet
- if ( !defined($self->{fh}) ) {
- return;
- }
+# RCS
+# http://www.gnu.org/software/rcs/
+--ignore-directory=is:RCS
- if ( !close($self->{fh}) && $App::Ack::report_bad_filenames ) {
- App::Ack::warn( $self->name() . ": $!" );
- }
+# SCCS
+# http://en.wikipedia.org/wiki/Source_Code_Control_System
+--ignore-directory=is:SCCS
- $self->{opened} = 0;
+# darcs
+# http://darcs.net/
+--ignore-directory=is:_darcs
- return;
-}
+# Vault/Fortress
+--ignore-directory=is:_sgbak
+# autoconf
+# http://www.gnu.org/software/autoconf/
+--ignore-directory=is:autom4te.cache
-sub clone {
- my ( $self ) = @_;
+# Perl module building
+--ignore-directory=is:blib
+--ignore-directory=is:_build
- return __PACKAGE__->new($self->name);
-}
+# Perl Devel::Cover module's output directory
+# https://metacpan.org/release/Devel-Cover
+--ignore-directory=is:cover_db
-sub firstliney {
- my ( $self ) = @_;
+# Node modules created by npm
+--ignore-directory=is:node_modules
- my $fh = $self->open();
+# CMake cache
+# http://www.cmake.org/
+--ignore-directory=is:CMakeFiles
- unless(exists $self->{firstliney}) {
- my $buffer = '';
- my $rc = sysread( $fh, $buffer, 250 );
- unless($rc) { # XXX handle this better?
- $buffer = '';
- }
- $buffer =~ s/[\r\n].*//s;
- $self->{firstliney} = $buffer;
- $self->reset;
- }
+# Eclipse workspace folder
+# http://eclipse.org/
+--ignore-directory=is:.metadata
- $self->close;
+# Cabal (Haskell) sandboxes
+# http://www.haskell.org/cabal/users-guide/installing-packages.html
+--ignore-directory=is:.cabal-sandbox
- return $self->{firstliney};
-}
+### Files to ignore
-sub open {
- my ( $self ) = @_;
+# Backup files
+--ignore-file=ext:bak
+--ignore-file=match:/~$/
- return $self->{fh} if $self->{opened};
+# Emacs swap files
+--ignore-file=match:/^#.+#$/
- unless ( open $self->{fh}, '<', $self->{filename} ) {
- return;
- }
+# vi/vim swap files http://vim.org/
+--ignore-file=match:/[._].*\.swp$/
- $self->{opened} = 1;
+# core dumps
+--ignore-file=match:/core\.\d+$/
- return $self->{fh};
-}
+# minified Javascript
+--ignore-file=match:/[.-]min[.]js$/
+--ignore-file=match:/[.]js[.]min$/
-1;
-package App::Ack::Filter;
+# minified CSS
+--ignore-file=match:/[.]min[.]css$/
+--ignore-file=match:/[.]css[.]min$/
-use strict;
-use warnings;
-use overload
- '""' => 'to_string';
+# JS and CSS source maps
+--ignore-file=match:/[.]js[.]map$/
+--ignore-file=match:/[.]css[.]map$/
-use Carp 1.04 ();
+# PDFs, because they pass Perl's -T detection
+--ignore-file=ext:pdf
-my %filter_types;
+# Common graphics, just as an optimization
+--ignore-file=ext:gif,jpg,jpeg,png
-sub create_filter {
- my ( undef, $type, @args ) = @_;
-
- if ( my $package = $filter_types{$type} ) {
- return $package->new(@args);
- }
- Carp::croak "Unknown filter type '$type'";
-}
+### Filetypes defined
+# Perl
+# http://perl.org/
+--type-add=perl:ext:pl,pm,pod,t,psgi
+--type-add=perl:firstlinematch:/^#!.*\bperl/
-sub register_filter {
- my ( undef, $type, $package ) = @_;
-
- $filter_types{$type} = $package;
-
- return;
-}
+# Perl tests
+--type-add=perltest:ext:t
+# Makefiles
+# http://www.gnu.org/s/make/
+--type-add=make:ext:mk
+--type-add=make:ext:mak
+--type-add=make:is:makefile
+--type-add=make:is:Makefile
+--type-add=make:is:Makefile.Debug
+--type-add=make:is:Makefile.Release
-sub invert {
- my ( $self ) = @_;
+# Rakefiles
+# http://rake.rubyforge.org/
+--type-add=rake:is:Rakefile
- return App::Ack::Filter::Inverse->new( $self );
-}
+# CMake
+# http://www.cmake.org/
+--type-add=cmake:is:CMakeLists.txt
+--type-add=cmake:ext:cmake
+# Actionscript
+--type-add=actionscript:ext:as,mxml
-sub is_inverted {
- return 0;
-}
+# Ada
+# http://www.adaic.org/
+--type-add=ada:ext:ada,adb,ads
+# ASP
+# http://msdn.microsoft.com/en-us/library/aa286483.aspx
+--type-add=asp:ext:asp
-sub to_string {
- my ( $self ) = @_;
+# ASP.Net
+# http://www.asp.net/
+--type-add=aspx:ext:master,ascx,asmx,aspx,svc
- return '(unimplemented to_string)';
-}
+# Assembly
+--type-add=asm:ext:asm,s
+# Batch
+--type-add=batch:ext:bat,cmd
-sub inspect {
- my ( $self ) = @_;
+# ColdFusion
+# http://en.wikipedia.org/wiki/ColdFusion
+--type-add=cfmx:ext:cfc,cfm,cfml
- return ref($self);
-}
+# Clojure
+# http://clojure.org/
+--type-add=clojure:ext:clj,cljs,edn,cljc
-1;
-package App::Ack::Filter::Extension;
+# C
+# .xs are Perl C files
+--type-add=cc:ext:c,h,xs
-use strict;
-use warnings;
-BEGIN {
- our @ISA = 'App::Ack::Filter';
-}
+# C header files
+--type-add=hh:ext:h
-sub new {
- my ( $class, @extensions ) = @_;
+# CoffeeScript
+# http://coffeescript.org/
+--type-add=coffeescript:ext:coffee
- my $exts = join('|', map { "\Q$_\E"} @extensions);
- my $re = qr/[.](?:$exts)$/i;
+# C++
+--type-add=cpp:ext:cpp,cc,cxx,m,hpp,hh,h,hxx
- return bless {
- extensions => \@extensions,
- regex => $re,
- }, $class;
-}
+# C++ header files
+--type-add=hpp:ext:hpp,hh,h,hxx
-sub filter {
- my ( $self, $resource ) = @_;
+# C#
+--type-add=csharp:ext:cs
- my $re = $self->{'regex'};
+# CSS
+# http://www.w3.org/Style/CSS/
+--type-add=css:ext:css
- return $resource->name =~ /$re/;
-}
+# Dart
+# http://www.dartlang.org/
+--type-add=dart:ext:dart
-sub inspect {
- my ( $self ) = @_;
+# Delphi
+# http://en.wikipedia.org/wiki/Embarcadero_Delphi
+--type-add=delphi:ext:pas,int,dfm,nfm,dof,dpk,dproj,groupproj,bdsgroup,bdsproj
- my $re = $self->{'regex'};
+# Elixir
+# http://elixir-lang.org/
+--type-add=elixir:ext:ex,exs
- return ref($self) . " - $re";
-}
+# Emacs Lisp
+# http://www.gnu.org/software/emacs
+--type-add=elisp:ext:el
-sub to_string {
- my ( $self ) = @_;
+# Erlang
+# http://www.erlang.org/
+--type-add=erlang:ext:erl,hrl
- my $exts = $self->{'extensions'};
+# Fortran
+# http://en.wikipedia.org/wiki/Fortran
+--type-add=fortran:ext:f,f77,f90,f95,f03,for,ftn,fpp
- return join(' ', map { ".$_" } @{$exts});
-}
+# Go
+# http://golang.org/
+--type-add=go:ext:go
-BEGIN {
- App::Ack::Filter->register_filter(ext => __PACKAGE__);
-}
+# Groovy
+# http://groovy.codehaus.org/
+--type-add=groovy:ext:groovy,gtmpl,gpp,grunit,gradle
-1;
-package App::Ack::Filter::FirstLineMatch;
+# GSP
+# http://groovy.codehaus.org/GSP
+--type-add=gsp:ext:gsp
-use strict;
-use warnings;
-BEGIN {
- our @ISA = 'App::Ack::Filter';
-}
+# Haskell
+# http://www.haskell.org/
+--type-add=haskell:ext:hs,lhs
-sub new {
- my ( $class, $re ) = @_;
+# HTML
+--type-add=html:ext:htm,html,xhtml
- $re =~ s{^/|/$}{}g; # XXX validate?
- $re = qr{$re}i;
+# Jade
+# http://jade-lang.com/
+--type-add=jade:ext:jade
- return bless {
- regex => $re,
- }, $class;
-}
+# Java
+# http://www.oracle.com/technetwork/java/index.html
+--type-add=java:ext:java,properties
-# This test reads the first 250 characters of a file, then just uses the
-# first line found in that. This prevents reading something like an entire
-# .min.js file (which might be only one "line" long) into memory.
+# JavaScript
+--type-add=js:ext:js
-sub filter {
- my ( $self, $resource ) = @_;
+# JSP
+# http://www.oracle.com/technetwork/java/javaee/jsp/index.html
+--type-add=jsp:ext:jsp,jspx,jspf,jhtm,jhtml
- my $re = $self->{'regex'};
+# JSON
+# http://www.json.org/
+--type-add=json:ext:json
- my $line = $resource->firstliney;
+# Kotlin
+# https://kotlinlang.org/
+--type-add=kotlin:ext:kt,kts
- return $line =~ /$re/;
-}
+# Less
+# http://www.lesscss.org/
+--type-add=less:ext:less
-sub inspect {
- my ( $self ) = @_;
+# Common Lisp
+# http://common-lisp.net/
+--type-add=lisp:ext:lisp,lsp
- my $re = $self->{'regex'};
+# Lua
+# http://www.lua.org/
+--type-add=lua:ext:lua
+--type-add=lua:firstlinematch:/^#!.*\blua(jit)?/
- return ref($self) . " - $re";
-}
+# Objective-C
+--type-add=objc:ext:m,h
-sub to_string {
- my ( $self ) = @_;
+# Objective-C++
+--type-add=objcpp:ext:mm,h
- (my $re = $self->{regex}) =~ s{\([^:]*:(.*)\)$}{$1};
+# OCaml
+# http://caml.inria.fr/
+--type-add=ocaml:ext:ml,mli,mll,mly
- return "first line matches /$re/";
-}
+# Matlab
+# http://en.wikipedia.org/wiki/MATLAB
+--type-add=matlab:ext:m
-BEGIN {
- App::Ack::Filter->register_filter(firstlinematch => __PACKAGE__);
-}
+# Parrot
+# http://www.parrot.org/
+--type-add=parrot:ext:pir,pasm,pmc,ops,pod,pg,tg
-1;
-package App::Ack::Filter::Is;
+# PHP
+# http://www.php.net/
+--type-add=php:ext:php,phpt,php3,php4,php5,phtml
+--type-add=php:firstlinematch:/^#!.*\bphp/
-use strict;
-use warnings;
-BEGIN {
- our @ISA = 'App::Ack::Filter';
-}
+# Plone
+# http://plone.org/
+--type-add=plone:ext:pt,cpt,metadata,cpy,py
-use File::Spec 3.00 ();
+# Python
+# http://www.python.org/
+--type-add=python:ext:py
+--type-add=python:firstlinematch:/^#!.*\bpython/
-sub new {
- my ( $class, $filename ) = @_;
+# R
+# http://www.r-project.org/
+--type-add=rr:ext:R
- return bless {
- filename => $filename,
- }, $class;
-}
+# reStructured Text
+# http://docutils.sourceforge.net/rst.html
+--type-add=rst:ext:rst
-sub filter {
- my ( $self, $resource ) = @_;
+# Ruby
+# http://www.ruby-lang.org/
+--type-add=ruby:ext:rb,rhtml,rjs,rxml,erb,rake,spec
+--type-add=ruby:is:Rakefile
+--type-add=ruby:firstlinematch:/^#!.*\bruby/
- my $filename = $self->{'filename'};
- my $base = (File::Spec->splitpath($resource->name))[2];
+# Rust
+# http://www.rust-lang.org/
+--type-add=rust:ext:rs
- return $base eq $filename;
-}
+# Sass
+# http://sass-lang.com
+--type-add=sass:ext:sass,scss
-sub inspect {
- my ( $self ) = @_;
+# Scala
+# http://www.scala-lang.org/
+--type-add=scala:ext:scala
- my $filename = $self->{'filename'};
+# Scheme
+# http://groups.csail.mit.edu/mac/projects/scheme/
+--type-add=scheme:ext:scm,ss
- return ref($self) . " - $filename";
-}
+# Shell
+--type-add=shell:ext:sh,bash,csh,tcsh,ksh,zsh,fish
+--type-add=shell:firstlinematch:/^#!.*\b(?:ba|t?c|k|z|fi)?sh\b/
-sub to_string {
- my ( $self ) = @_;
+# Smalltalk
+# http://www.smalltalk.org/
+--type-add=smalltalk:ext:st
- my $filename = $self->{'filename'};
-}
+# Smarty
+# http://www.smarty.net/
+--type-add=smarty:ext:tpl
-BEGIN {
- App::Ack::Filter->register_filter(is => __PACKAGE__);
-}
+# SQL
+# http://www.iso.org/iso/catalogue_detail.htm?csnumber=45498
+--type-add=sql:ext:sql,ctl
-1;
-package App::Ack::Filter::Match;
+# Stylus
+# http://learnboost.github.io/stylus/
+--type-add=stylus:ext:styl
-use strict;
-use warnings;
-BEGIN {
- our @ISA = 'App::Ack::Filter';
-}
+# Swift
+# https://developer.apple.com/swift/
+--type-add=swift:ext:swift
+--type-add=swift:firstlinematch:/^#!.*\bswift/
-use File::Spec 3.00;
+# Tcl
+# http://www.tcl.tk/
+--type-add=tcl:ext:tcl,itcl,itk
-sub new {
- my ( $class, $re ) = @_;
+# LaTeX
+# http://www.latex-project.org/
+--type-add=tex:ext:tex,cls,sty
- $re =~ s{^/|/$}{}g; # XXX validate?
- $re = qr/$re/i;
+# Template Toolkit (Perl)
+# http://template-toolkit.org/
+--type-add=tt:ext:tt,tt2,ttml
- return bless {
- regex => $re,
- }, $class;
-}
+# Visual Basic
+--type-add=vb:ext:bas,cls,frm,ctl,vb,resx
-sub filter {
- my ( $self, $resource ) = @_;
+# Verilog
+--type-add=verilog:ext:v,vh,sv
- my $re = $self->{'regex'};
- my $base = (File::Spec->splitpath($resource->name))[2];
+# VHDL
+# http://www.eda.org/twiki/bin/view.cgi/P1076/WebHome
+--type-add=vhdl:ext:vhd,vhdl
- return $base =~ /$re/;
-}
+# Vim
+# http://www.vim.org/
+--type-add=vim:ext:vim
-sub inspect {
- my ( $self ) = @_;
+# XML
+# http://www.w3.org/TR/REC-xml/
+--type-add=xml:ext:xml,dtd,xsd,xsl,xslt,ent,wsdl
+--type-add=xml:firstlinematch:/<[?]xml/
- my $re = $self->{'regex'};
+# YAML
+# http://yaml.org/
+--type-add=yaml:ext:yaml,yml
+HERE
+ $lines =~ s/==VERSION==/$App::Ack::VERSION/sm;
- print ref($self) . " - $re";
+ return $lines;
}
-sub to_string {
- my ( $self ) = @_;
+1;
+package App::Ack::ConfigFinder;
- my $re = $self->{'regex'};
- return "filename matches $re";
-}
+use strict;
+use warnings;
-BEGIN {
- App::Ack::Filter->register_filter(match => __PACKAGE__);
-}
+use Cwd 3.00 ();
+use File::Spec 3.00;
-1;
-package App::Ack::Filter::Default;
+use if ($^O eq 'MSWin32'), 'Win32';
-use strict;
-use warnings;
-BEGIN {
- our @ISA = 'App::Ack::Filter';
-}
sub new {
my ( $class ) = @_;
return bless {}, $class;
}
-sub filter {
- my ( $self, $resource ) = @_;
-
- return -T $resource->name;
-}
-
-1;
-package App::Ack::Filter::Inverse;
-
-use strict;
-use warnings;
-BEGIN {
- our @ISA = 'App::Ack::Filter';
-}
-
-sub new {
- my ( $class, $filter ) = @_;
-
- return bless {
- filter => $filter,
- }, $class;
-}
-
-sub filter {
- my ( $self, $resource ) = @_;
-
- my $filter = $self->{'filter'};
- return !$filter->filter( $resource );
-}
-
-sub invert {
- my $self = shift;
-
- return $self->{'filter'};
-}
-
-sub is_inverted {
- return 1;
-}
-
-sub inspect {
- my ( $self ) = @_;
-
- my $filter = $self->{'filter'};
-
- return "!$filter";
-}
-
-1;
-package App::Ack::ConfigFinder;
-
-
-use strict;
-use warnings;
-
-use Cwd 3.00 ();
-use File::Spec 3.00;
-
-use if ($^O =~ /MSWin32/ ? 1 : 0), "Win32";
-
-
-our $is_win = 0;
-
-sub new {
- my ( $class ) = @_;
-
- $is_win = $^O =~ /MSWin32/,
-
- return bless {}, $class;
-}
sub _remove_redundancies {
- my ( @configs ) = @_;
-
- if ( $is_win ) {
- # inode stat always returns 0 on windows,
- # so just check filenames
- my (%seen, @uniq);
-
- foreach my $path (@configs) {
- push @uniq, $path unless $seen{$path};
- $seen{$path} = 1;
- }
-
- return @uniq;
- }
-
- else {
-
- my %dev_and_inode_seen;
-
- foreach my $path ( @configs ) {
- my ( $dev, $inode ) = (stat $path)[0, 1];
-
- if( defined($dev) ) {
- if( $dev_and_inode_seen{"$dev:$inode"} ) {
- undef $path;
- }
- else {
- $dev_and_inode_seen{"$dev:$inode"} = 1;
- }
- }
+ my @configs = @_;
+
+ my %seen;
+ foreach my $config (@configs) {
+ my $key = $config->{path};
+ if ( not $App::Ack::is_windows ) {
+ # On Unix, uniquify on inode.
+ my ($dev, $inode) = (stat $key)[0, 1];
+ $key = "$dev:$inode" if defined $dev;
}
-
- return grep { defined() } @configs;
-
+ undef $config if $seen{$key}++;
}
+ return grep { defined } @configs;
}
+
sub _check_for_ackrc {
return unless defined $_[0];
} # end _check_for_ackrc
+
sub find_config_files {
my @config_files;
- if( $is_win ) {
- push @config_files, map { File::Spec->catfile($_, 'ackrc') } (
+ if ( $App::Ack::is_windows ) {
+ push @config_files, map { +{ path => File::Spec->catfile($_, 'ackrc') } } (
Win32::GetFolderPath(Win32::CSIDL_COMMON_APPDATA()),
Win32::GetFolderPath(Win32::CSIDL_APPDATA()),
);
}
else {
- push @config_files, '/etc/ackrc';
+ push @config_files, { path => '/etc/ackrc' };
}
if ( $ENV{'ACKRC'} && -f $ENV{'ACKRC'} ) {
- push @config_files, $ENV{'ACKRC'};
+ push @config_files, { path => $ENV{'ACKRC'} };
}
else {
- push @config_files, _check_for_ackrc($ENV{'HOME'});
+ push @config_files, map { +{ path => $_ } } _check_for_ackrc($ENV{'HOME'});
}
- my @dirs = File::Spec->splitdir(Cwd::getcwd());
+ my $cwd = Cwd::getcwd();
+ return () unless defined $cwd;
+
+ # XXX This should go through some untainted cwd-fetching function, and not get untainted brute-force like this.
+ $cwd =~ /(.+)/;
+ $cwd = $1;
+ my @dirs = File::Spec->splitdir( $cwd );
while(@dirs) {
my $ackrc = _check_for_ackrc(@dirs);
if(defined $ackrc) {
- push @config_files, $ackrc;
+ push @config_files, { project => 1, path => $ackrc };
last;
}
pop @dirs;
}
- # XXX we only test for existence here, so if the file is
- # deleted out from under us, this will fail later. =(
+ # We only test for existence here, so if the file is deleted out from under us, this will fail later.
return _remove_redundancies( @config_files );
}
+
sub read_rcfile {
my $file = shift;
$line =~ s/\s+$//;
next if $line eq '';
- next if $line =~ /^#/;
+ next if $line =~ /^\s*#/;
push( @lines, $line );
}
- close $fh;
+ close $fh or App::Ack::die( "Unable to close $file: $!" );
return @lines;
}
use warnings;
use Carp 1.04 ();
-use Getopt::Long 2.35 ();
+use Getopt::Long 2.38 ();
use Text::ParseWords 3.1 ();
);
}
+sub _generate_ignore_dir {
+ my ( $option_name, $opt ) = @_;
+
+ my $is_inverted = $option_name =~ /^--no/;
+
+ return sub {
+ my ( undef, $dir ) = @_;
+
+ $dir = App::Ack::remove_dir_sep( $dir );
+ if ( $dir !~ /:/ ) {
+ $dir = 'is:' . $dir;
+ }
+
+ my ( $filter_type, $args ) = split /:/, $dir, 2;
+
+ if ( $filter_type eq 'firstlinematch' ) {
+ Carp::croak( qq{Invalid filter specification "$filter_type" for option '$option_name'} );
+ }
+
+ my $filter = App::Ack::Filter->create_filter($filter_type, split(/,/, $args));
+ my $collection;
+
+ my $previous_inversion_matches = $opt->{idirs} && !($is_inverted xor $opt->{idirs}[-1]->is_inverted());
+
+ if ( $previous_inversion_matches ) {
+ $collection = $opt->{idirs}[-1];
+
+ if ( $is_inverted ) {
+ # XXX this relies on invert of an inverted filter
+ # to return the original
+ $collection = $collection->invert()
+ }
+ }
+ else {
+ $collection = App::Ack::Filter::Collection->new();
+
+ if ( $is_inverted ) {
+ push @{ $opt->{idirs} }, $collection->invert();
+ }
+ else {
+ push @{ $opt->{idirs} }, $collection;
+ }
+ }
+
+ $collection->add($filter);
+
+ if ( $filter_type eq 'is' ) {
+ $collection->add(App::Ack::Filter::IsPath->new($args));
+ }
+ };
+}
+
sub process_filter_spec {
my ( $spec ) = @_;
}
}
+
+sub uninvert_filter {
+ my ( $opt, @filters ) = @_;
+
+ return unless defined $opt->{filters} && @filters;
+
+ # Loop through all the registered filters. If we hit one that
+ # matches this extension and it's inverted, we need to delete it from
+ # the options.
+ for ( my $i = 0; $i < @{ $opt->{filters} }; $i++ ) {
+ my $opt_filter = @{ $opt->{filters} }[$i];
+
+ # XXX Do a real list comparison? This just checks string equivalence.
+ if ( $opt_filter->is_inverted() && "$opt_filter->{filter}" eq "@filters" ) {
+ splice @{ $opt->{filters} }, $i, 1;
+ $i--;
+ }
+ }
+
+ return;
+}
+
+
sub process_filetypes {
my ( $opt, $arg_sources ) = @_;
if ( not $value ) {
@filters = map { $_->invert() } @filters;
}
+ else {
+ uninvert_filter( $opt, @filters );
+ }
push @{ $opt->{'filters'} }, @filters;
};
'type-del=s' => $delete_spec,
);
- for ( my $i = 0; $i < @{$arg_sources}; $i += 2) {
- my ( $source_name, $args ) = @{$arg_sources}[ $i, $i + 1];
+ foreach my $source (@{$arg_sources}) {
+ my ( $source_name, $args ) = @{$source}{qw/name contents/};
if ( ref($args) ) {
# $args are modified in place, so no need to munge $arg_sources
@{$args} = @ARGV;
}
else {
- ( undef, $arg_sources->[$i + 1] ) =
+ ( undef, $source->{contents} ) =
Getopt::Long::GetOptionsFromString($args, %type_arg_specs);
}
}
return \%additional_specs;
}
+
sub removed_option {
my ( $option, $explanation ) = @_;
$explanation ||= '';
return sub {
- warn "Option '$option' is not valid in ack 2\n$explanation";
+ warn "Option '$option' is not valid in ack 2.\n$explanation";
exit 1;
};
}
+
sub get_arg_spec {
my ( $opt, $extra_specs ) = @_;
- my $dash_a_explanation = <<EOT;
-This is because we now have -k/--known-types which makes it only select files
-of known types, rather than any text file (which is the behavior of ack 1.x).
+ my $dash_a_explanation = <<'EOT';
+You don't need -a, ack 1.x users. This is because ack 2.x has
+-k/--known-types which makes it only select files of known types, rather
+than any text file (which is the behavior of ack 1.x).
+
+If you're surprised to see this message because you didn't put -a on the
+command line, you may have options in an .ackrc, or in the ACKRC_OPTIONS
+environment variable. Try using the --dump flag to help find it.
EOT
+
+ sub _context_value {
+ my $val = shift;
+
+ # Contexts default to 2.
+ return (!defined($val) || ($val < 0)) ? 2 : $val;
+ }
+
return {
1 => sub { $opt->{1} = $opt->{m} = 1 },
- 'A|after-context=i' => \$opt->{after_context},
- 'B|before-context=i'
- => \$opt->{before_context},
- 'C|context:i' => sub { shift; my $val = shift; $opt->{before_context} = $opt->{after_context} = ($val || 2) },
+ 'A|after-context:-1' => sub { shift; $opt->{after_context} = _context_value(shift) },
+ 'B|before-context:-1' => sub { shift; $opt->{before_context} = _context_value(shift) },
+ 'C|context:-1' => sub { shift; $opt->{before_context} = $opt->{after_context} = _context_value(shift) },
'a' => removed_option('-a', $dash_a_explanation),
'all' => removed_option('--all', $dash_a_explanation),
'break!' => \$opt->{break},
'h|no-filename' => \$opt->{h},
'H|with-filename' => \$opt->{H},
'i|ignore-case' => \$opt->{i},
- 'ignore-directory|ignore-dir=s' # XXX Combine this version with the negated version below
- => sub {
- my ( undef, $dir ) = @_;
-
- $dir = App::Ack::remove_dir_sep( $dir );
- if ( $dir !~ /^(?:is|match):/ ) {
- $dir = 'is:' . $dir;
- }
- push @{ $opt->{idirs} }, $dir;
- },
- 'ignore-file=s' => sub {
+ 'ignore-directory|ignore-dir=s' => _generate_ignore_dir('--ignore-dir', $opt),
+ 'ignore-file=s' => sub {
my ( undef, $file ) = @_;
- push @{ $opt->{ifiles} }, $file;
+
+ my ( $filter_type, $args ) = split /:/, $file, 2;
+
+ my $filter = App::Ack::Filter->create_filter($filter_type, split(/,/, $args));
+
+ if ( !$opt->{ifiles} ) {
+ $opt->{ifiles} = App::Ack::Filter::Collection->new();
+ }
+ $opt->{ifiles}->add($filter);
},
'lines=s' => sub { shift; my $val = shift; push @{$opt->{lines}}, $val },
'l|files-with-matches'
'n|no-recurse' => \$opt->{n},
o => sub { $opt->{output} = '$&' },
'output=s' => \$opt->{output},
- 'pager=s' => \$opt->{pager},
- 'noignore-directory|noignore-dir=s'
- => sub {
- my ( undef, $dir ) = @_;
-
- # XXX can you do --noignore-dir=match,...?
- $dir = App::Ack::remove_dir_sep( $dir );
- if ( $dir !~ /^(?:is|match):/ ) {
- $dir = 'is:' . $dir;
- }
- if ( $dir !~ /^(?:is|match):/ ) {
- Carp::croak("invalid noignore-directory argument: '$dir'");
- }
-
- @{ $opt->{idirs} } = grep {
- $_ ne $dir
- } @{ $opt->{idirs} };
-
- push @{ $opt->{no_ignore_dirs} }, $dir;
- },
+ 'pager:s' => sub {
+ my ( undef, $value ) = @_;
+
+ $opt->{pager} = $value || $ENV{PAGER};
+ },
+ 'noignore-directory|noignore-dir=s' => _generate_ignore_dir('--noignore-dir', $opt),
'nopager' => sub { $opt->{pager} = undef },
'passthru' => \$opt->{passthru},
'print0' => \$opt->{print0},
}; # arg_specs
}
+
sub process_other {
my ( $opt, $extra_specs, $arg_sources ) = @_;
- Getopt::Long::Configure('default', 'no_auto_help', 'no_auto_version'); # start with default options, minus some annoying ones
+ # Start with default options, minus some annoying ones.
+ Getopt::Long::Configure('default', 'no_auto_help', 'no_auto_version');
Getopt::Long::Configure(
'bundling',
'no_ignore_case',
my $argv_source;
my $is_help_types_active;
- for ( my $i = 0; $i < @{$arg_sources}; $i += 2 ) {
- my ( $source_name, $args ) = @{$arg_sources}[ $i, $i + 1 ];
+ foreach my $source (@{$arg_sources}) {
+ my ( $source_name, $args ) = @{$source}{qw/name contents/};
if ( $source_name eq 'ARGV' ) {
$argv_source = $args;
}
}
- if ( $argv_source ) { # this *should* always be true, but you never know...
+ if ( $argv_source ) { # This *should* always be true, but you never know...
my @copy = @{$argv_source};
local @ARGV = @copy;
my $arg_specs = get_arg_spec($opt, $extra_specs);
- for ( my $i = 0; $i < @{$arg_sources}; $i += 2) {
- my ($source_name, $args) = @{$arg_sources}[$i, $i + 1];
+ foreach my $source (@{$arg_sources}) {
+ my ( $source_name, $args ) = @{$source}{qw/name contents/};
+
+ my $args_for_source = $arg_specs;
+
+ if ( $source->{project} ) {
+ my $illegal = sub {
+ die "Options --output, --pager and --match are forbidden in project .ackrc files.\n";
+ };
+
+ $args_for_source = {
+ %{$args_for_source},
+ 'output=s' => $illegal,
+ 'pager:s' => $illegal,
+ 'match=s' => $illegal,
+ };
+ }
my $ret;
if ( ref($args) ) {
local @ARGV = @{$args};
- $ret = Getopt::Long::GetOptions( %{$arg_specs} );
+ $ret = Getopt::Long::GetOptions( %{$args_for_source} );
@{$args} = @ARGV;
}
else {
- ( $ret, $arg_sources->[$i + 1] ) =
- Getopt::Long::GetOptionsFromString( $args, %{$arg_specs} );
+ ( $ret, $source->{contents} ) =
+ Getopt::Long::GetOptionsFromString( $args, %{$args_for_source} );
}
if ( !$ret ) {
if ( !$is_help_types_active ) {
return;
}
+
sub should_dump_options {
my ( $sources ) = @_;
- for(my $i = 0; $i < @{$sources}; $i += 2) {
- my ( $name, $options ) = @{$sources}[$i, $i + 1];
+ foreach my $source (@{$sources}) {
+ my ( $name, $options ) = @{$source}{qw/name contents/};
+
if($name eq 'ARGV') {
my $dump;
local @ARGV = @{$options};
return;
}
+
sub explode_sources {
my ( $sources ) = @_;
delete $arg_spec->{$arg};
};
- for(my $i = 0; $i < @{$sources}; $i += 2) {
- my ( $name, $options ) = @{$sources}[$i, $i + 1];
+ foreach my $source (@{$sources}) {
+ my ( $name, $options ) = @{$source}{qw/name contents/};
if ( ref($options) ne 'ARRAY' ) {
- $sources->[$i + 1] = $options =
+ $source->{contents} = $options =
[ Text::ParseWords::shellwords($options) ];
}
- for ( my $j = 0; $j < @{$options}; $j++ ) {
+
+ for my $j ( 0 .. @{$options}-1 ) {
next unless $options->[$j] =~ /^-/;
my @chunk = ( $options->[$j] );
push @chunk, $options->[$j] while ++$j < @{$options} && $options->[$j] !~ /^-/;
);
Getopt::Long::GetOptions( %{$arg_spec} );
- push @new_sources, $name, \@copy;
+ push @new_sources, {
+ name => $name,
+ contents => \@copy,
+ };
}
}
return \@new_sources;
}
+
sub compare_opts {
my ( $a, $b ) = @_;
return $first_a cmp $first_b;
}
+
sub dump_options {
my ( $sources ) = @_;
my %opts_by_source;
my @source_names;
- for(my $i = 0; $i < @{$sources}; $i += 2) {
- my ( $name, $contents ) = @{$sources}[$i, $i + 1];
+ foreach my $source (@{$sources}) {
+ my ( $name, $contents ) = @{$source}{qw/name contents/};
if ( not $opts_by_source{$name} ) {
$opts_by_source{$name} = [];
push @source_names, $name;
return;
}
+
sub remove_default_options_if_needed {
my ( $sources ) = @_;
my $default_index;
- foreach my $index ( 0 .. $#$sources ) {
- if ( $sources->[$index] eq 'Defaults' ) {
+ foreach my $index ( 0 .. $#{$sources} ) {
+ if ( $sources->[$index]{'name'} eq 'Defaults' ) {
$default_index = $index;
last;
}
my $should_remove = 0;
- Getopt::Long::Configure('default', 'no_auto_help', 'no_auto_version'); # start with default options, minus some annoying ones
+ # Start with default options, minus some annoying ones.
+ Getopt::Long::Configure('default', 'no_auto_help', 'no_auto_version');
Getopt::Long::Configure(
'no_ignore_case',
'no_auto_abbrev',
'pass_through',
);
- foreach my $index ( $default_index + 2 .. $#$sources ) {
- next if $index % 2 != 0;
-
- my ( $name, $args ) = @{$sources}[ $index, $index + 1 ];
+ foreach my $index ( $default_index + 1 .. $#{$sources} ) {
+ my ( $name, $args ) = @{$sources->[$index]}{qw/name contents/};
if (ref($args)) {
local @ARGV = @{$args};
@{$args} = @ARGV;
}
else {
- ( undef, $sources->[$index + 1] ) = Getopt::Long::GetOptionsFromString($args,
+ ( undef, $sources->[$index]{contents} ) = Getopt::Long::GetOptionsFromString($args,
'ignore-ack-defaults' => \$should_remove,
);
}
return $sources unless $should_remove;
my @copy = @{$sources};
- splice @copy, $default_index, 2;
+ splice @copy, $default_index, 1;
return \@copy;
}
+
sub check_for_mutually_exclusive_options {
my ( $arg_sources ) = @_;
while( @copy ) {
my %set_opts;
- my ( $source_name, $args ) = splice @copy, 0, 2;
+ my $source = shift @copy;
+ my ( $source_name, $args ) = @{$source}{qw/name contents/};
$args = ref($args) ? [ @{$args} ] : [ Text::ParseWords::shellwords($args) ];
foreach my $opt ( @{$args} ) {
}
}
}
+
+ return;
}
+
sub process_args {
my $arg_sources = \@_;
- my %opt;
+ my %opt = (
+ pager => $ENV{ACK_PAGER_COLOR} || $ENV{ACK_PAGER},
+ );
check_for_mutually_exclusive_options($arg_sources);
my $type_specs = process_filetypes(\%opt, $arg_sources);
process_other(\%opt, $type_specs, $arg_sources);
while ( @{$arg_sources} ) {
- my ( $source_name, $args ) = splice( @{$arg_sources}, 0, 2 );
+ my $source = shift @{$arg_sources};
+ my ( $source_name, $args ) = @{$source}{qw/name contents/};
# All of our sources should be transformed into an array ref
if ( ref($args) ) {
}
my $filters = ($opt{filters} ||= []);
- # throw the default filter in if no others are selected
+ # Throw the default filter in if no others are selected.
if ( not grep { !$_->is_inverted() } @{$filters} ) {
push @{$filters}, App::Ack::Filter::Default->new();
}
@files = $finder->find_config_files;
}
if ( $ackrc ) {
- # we explicitly use open so we get a nice error message
- # XXX this is a potential race condition!
+ # We explicitly use open so we get a nice error message.
+ # XXX This is a potential race condition!.
if(open my $fh, '<', $ackrc) {
close $fh;
}
else {
die "Unable to load ackrc '$ackrc': $!"
}
- push( @files, $ackrc );
+ push( @files, { path => $ackrc } );
}
- push @arg_sources, Defaults => [ App::Ack::ConfigDefault::options() ];
+ push @arg_sources, {
+ name => 'Defaults',
+ contents => [ App::Ack::ConfigDefault::options_clean() ],
+ };
foreach my $file ( @files) {
- my @lines = App::Ack::ConfigFinder::read_rcfile($file);
- push ( @arg_sources, $file, \@lines ) if @lines;
+ my @lines = App::Ack::ConfigFinder::read_rcfile($file->{path});
+
+ if(@lines) {
+ push @arg_sources, {
+ name => $file->{path},
+ contents => \@lines,
+ project => $file->{project},
+ };
+ }
}
if ( $ENV{ACK_OPTIONS} && !$noenv ) {
- push( @arg_sources, 'ACK_OPTIONS' => $ENV{ACK_OPTIONS} );
+ push @arg_sources, {
+ name => 'ACK_OPTIONS',
+ contents => $ENV{ACK_OPTIONS},
+ };
}
- push( @arg_sources, 'ARGV' => [ @ARGV ] );
+ push @arg_sources, {
+ name => 'ARGV',
+ contents => [ @ARGV ],
+ };
return @arg_sources;
}
1; # End of App::Ack::ConfigLoader
-package App::Ack::ConfigDefault;
+package App::Ack::Filter;
+
-use warnings;
use strict;
+use warnings;
-sub options {
- my @options = split( /\n/, _options_block() );
- @options = grep { /./ && !/^#/ } @options;
+use Carp 1.04 ();
- return @options;
-}
+my %filter_types;
-sub _options_block {
- return <<'HERE';
-# This is the default ackrc for ack 2.0
-# There are four different ways to match
-#
-# is: Match the filename exactly
-#
-# ext: Match the extension of the filename exactly
-#
-# match: Match the filename against a Perl regular expression
-#
-# firstlinematch: Match the first 250 characters of the first line
-# of text against a Perl regular expression. This is only for
-# the --type-add option.
+sub create_filter {
+ my ( undef, $type, @args ) = @_;
+ if ( my $package = $filter_types{$type} ) {
+ return $package->new(@args);
+ }
+ Carp::croak "Unknown filter type '$type'";
+}
-# Directories to ignore
-# Bazaar
---ignore-directory=is:.bzr
-# Codeville
---ignore-directory=is:.cdv
+sub register_filter {
+ my ( undef, $type, $package ) = @_;
-# Interface Builder
---ignore-directory=is:~.dep
---ignore-directory=is:~.dot
---ignore-directory=is:~.nib
---ignore-directory=is:~.plst
+ $filter_types{$type} = $package;
-# Git
---ignore-directory=is:.git
+ return;
+}
-# Mercurial
---ignore-directory=is:.hg
-# quilt
---ignore-directory=is:.pc
+sub invert {
+ my ( $self ) = @_;
-# Subversion
---ignore-directory=is:.svn
+ return App::Ack::Filter::Inverse->new( $self );
+}
-# Monotone
---ignore-directory=is:_MTN
-# CVS
---ignore-directory=is:CVS
+sub is_inverted {
+ return 0;
+}
-# RCS
---ignore-directory=is:RCS
-# SCCS
---ignore-directory=is:SCCS
+sub to_string {
+ my ( $self ) = @_;
-# darcs
---ignore-directory=is:_darcs
+ return '(unimplemented to_string)';
+}
-# Vault/Fortress
---ignore-directory=is:_sgbak
-# autoconf
---ignore-directory=is:autom4te.cache
+sub inspect {
+ my ( $self ) = @_;
-# Perl module building
---ignore-directory=is:blib
---ignore-directory=is:_build
+ return ref($self);
+}
-# Perl Devel::Cover module's output directory
---ignore-directory=is:cover_db
+1;
+package App::Ack::Filter::Extension;
+use strict;
+use warnings;
+BEGIN {
+ our @ISA = 'App::Ack::Filter';
+}
-# Files to ignore
-# Backup files
---ignore-file=ext:bak
---ignore-file=match:/~$/
-# Emacs swap files
---ignore-file=match:/^#.+#$/
+sub new {
+ my ( $class, @extensions ) = @_;
-# vi/vim swap files
---ignore-file=match:/[._].*\.swp$/
+ my $exts = join('|', map { "\Q$_\E"} @extensions);
+ my $re = qr/[.](?:$exts)$/i;
-# core dumps
---ignore-file=match:/core\.\d+$/
+ return bless {
+ extensions => \@extensions,
+ regex => $re,
+ groupname => 'ExtensionGroup',
+ }, $class;
+}
-# minified Javascript
---ignore-file=match:/[.]min[.]js$/
---ignore-file=match:/[.]js[.]min$/
+sub create_group {
+ return App::Ack::Filter::ExtensionGroup->new();
+}
-# minified CSS
---ignore-file=match:/[.]min[.]css$/
---ignore-file=match:/[.]css[.]min$/
+sub filter {
+ my ( $self, $resource ) = @_;
+ my $re = $self->{'regex'};
-# Filetypes defined
+ return $resource->name =~ /$re/;
+}
-# Perl http://perl.org/
---type-add=perl:ext:pl,pm,pod,t
---type-add=perl:firstlinematch:/^#!.*\bperl/
+sub inspect {
+ my ( $self ) = @_;
-# Makefiles http://www.gnu.org/s/make/
---type-add=make:ext:mk
---type-add=make:ext:mak
---type-add=make:is:makefile
---type-add=make:is:Makefile
---type-add=make:is:GNUmakefile
+ my $re = $self->{'regex'};
-# Rakefiles http://rake.rubyforge.org/
---type-add=rake:is:Rakefile
+ return ref($self) . " - $re";
+}
-# CMake http://www.cmake.org/
---type-add=cmake:is:CMakeLists.txt
---type-add=cmake:ext:cmake
+sub to_string {
+ my ( $self ) = @_;
-# Actionscript
---type-add=actionscript:ext:as,mxml
+ my $exts = $self->{'extensions'};
-# Ada http://www.adaic.org/
---type-add=ada:ext:ada,adb,ads
+ return join(' ', map { ".$_" } @{$exts});
+}
-# ASP http://msdn.microsoft.com/en-us/library/aa286483.aspx
---type-add=asp:ext:asp
+BEGIN {
+ App::Ack::Filter->register_filter(ext => __PACKAGE__);
+}
-# ASP.Net http://www.asp.net/
---type-add=aspx:ext:master,ascx,asmx,aspx,svc
+1;
+package App::Ack::Filter::FirstLineMatch;
-# Assembly
---type-add=asm:ext:asm,s
-# Batch
---type-add=batch:ext:bat,cmd
-# ColdFusion http://en.wikipedia.org/wiki/ColdFusion
---type-add=cfmx:ext:cfc,cfm,cfml
+use strict;
+use warnings;
+BEGIN {
+ our @ISA = 'App::Ack::Filter';
+}
-# Clojure http://clojure.org/
---type-add=clojure:ext:clj
+sub new {
+ my ( $class, $re ) = @_;
-# C
-# .xs are Perl C files
---type-add=cc:ext:c,h,xs
+ $re =~ s{^/|/$}{}g; # XXX validate?
+ $re = qr{$re}i;
-# C header files
---type-add=hh:ext:h
+ return bless {
+ regex => $re,
+ }, $class;
+}
-# C++
---type-add=cpp:ext:cpp,cc,cxx,m,hpp,hh,h,hxx
+# This test reads the first 250 characters of a file, then just uses the
+# first line found in that. This prevents reading something like an entire
+# .min.js file (which might be only one "line" long) into memory.
-# C#
---type-add=csharp:ext:cs
+sub filter {
+ my ( $self, $resource ) = @_;
-# CSS http://www.w3.org/Style/CSS/
---type-add=css:ext:css
+ my $re = $self->{'regex'};
-# Dart http://www.dartlang.org/
---type-add=dart:ext:dart
+ my $line = $resource->firstliney;
-# Delphi http://en.wikipedia.org/wiki/Embarcadero_Delphi
---type-add=delphi:ext:pas,int,dfm,nfm,dof,dpk,dproj,groupproj,bdsgroup,bdsproj
+ return $line =~ /$re/;
+}
-# Emacs Lisp http://www.gnu.org/software/emacs
---type-add=elisp:ext:el
+sub inspect {
+ my ( $self ) = @_;
-# Erlang http://www.erlang.org/
---type-add=erlang:ext:erl,hrl
+ my $re = $self->{'regex'};
-# Fortran http://en.wikipedia.org/wiki/Fortran
---type-add=fortran:ext:f,f77,f90,f95,f03,for,ftn,fpp
+ return ref($self) . " - $re";
+}
-# Google Go http://golang.org/
---type-add=go:ext:go
+sub to_string {
+ my ( $self ) = @_;
-# Groovy http://groovy.codehaus.org/
---type-add=groovy:ext:groovy,gtmpl,gpp,grunit,gradle
+ (my $re = $self->{regex}) =~ s{\([^:]*:(.*)\)$}{$1};
-# Haskell http://www.haskell.org/
---type-add=haskell:ext:hs,lhs
+ return "first line matches /$re/";
+}
-# HTML
---type-add=html:ext:htm,html
+BEGIN {
+ App::Ack::Filter->register_filter(firstlinematch => __PACKAGE__);
+}
-# Java http://www.oracle.com/technetwork/java/index.html
---type-add=java:ext:java,properties
+1;
+package App::Ack::Filter::Is;
-# JavaScript
---type-add=js:ext:js
-# JSP http://www.oracle.com/technetwork/java/javaee/jsp/index.html
---type-add=jsp:ext:jsp,jspx,jhtm,jhtml
+use strict;
+use warnings;
+BEGIN {
+ our @ISA = 'App::Ack::Filter';
+}
-# Common Lisp http://common-lisp.net/
---type-add=lisp:ext:lisp,lsp
+use File::Spec 3.00 ();
-# Lua http://www.lua.org/
---type-add=lua:ext:lua
+sub new {
+ my ( $class, $filename ) = @_;
-# Objective-C
---type-add=objc:ext:m,h
+ return bless {
+ filename => $filename,
+ groupname => 'IsGroup',
+ }, $class;
+}
-# Objective-C++
---type-add=objcpp:ext:mm,h
+sub create_group {
+ return App::Ack::Filter::IsGroup->new();
+}
-# OCaml http://caml.inria.fr/
---type-add=ocaml:ext:ml,mli
+sub filter {
+ my ( $self, $resource ) = @_;
-# Parrot http://www.parrot.org/
---type-add=parrot:ext:pir,pasm,pmc,ops,pod,pg,tg
+ my $filename = $self->{'filename'};
+ my $base = (File::Spec->splitpath($resource->name))[2];
-# PHP http://www.php.net/
---type-add=php:ext:php,phpt,php3,php4,php5,phtml
---type-add=php:firstlinematch:/^#!.*\bphp/
+ return $base eq $filename;
+}
-# Plone http://plone.org/
---type-add=plone:ext:pt,cpt,metadata,cpy,py
+sub inspect {
+ my ( $self ) = @_;
-# Python http://www.python.org/
---type-add=python:ext:py
---type-add=python:firstlinematch:/^#!.*\bpython/
+ my $filename = $self->{'filename'};
-# R http://www.r-project.org/
---type-add=rr:ext:R
+ return ref($self) . " - $filename";
+}
-# Ruby http://www.ruby-lang.org/
---type-add=ruby:ext:rb,rhtml,rjs,rxml,erb,rake,spec
---type-add=ruby:is:Rakefile
---type-add=ruby:firstlinematch:/^#!.*\bruby/
+sub to_string {
+ my ( $self ) = @_;
-# Rust http://www.rust-lang.org/
---type-add=rust:ext:rs
+ my $filename = $self->{'filename'};
-# Scala http://www.scala-lang.org/
---type-add=scala:ext:scala
+ return $filename;
+}
-# Scheme http://groups.csail.mit.edu/mac/projects/scheme/
---type-add=scheme:ext:scm,ss
+BEGIN {
+ App::Ack::Filter->register_filter(is => __PACKAGE__);
+}
-# Shell
---type-add=shell:ext:sh,bash,csh,tcsh,ksh,zsh,fish
---type-add=shell:firstlinematch:/^#!.*\b(?:ba|t?c|k|z|fi)?sh\b/
+1;
+package App::Ack::Filter::Match;
-# Smalltalk http://www.smalltalk.org/
---type-add=smalltalk:ext:st
+use strict;
+use warnings;
+BEGIN {
+ our @ISA = 'App::Ack::Filter';
+}
-# SQL http://www.iso.org/iso/catalogue_detail.htm?csnumber=45498
---type-add=sql:ext:sql,ctl
+use File::Spec 3.00;
-# Tcl http://www.tcl.tk/
---type-add=tcl:ext:tcl,itcl,itk
-# LaTeX http://www.latex-project.org/
---type-add=tex:ext:tex,cls,sty
+sub new {
+ my ( $class, $re ) = @_;
-# Template Toolkit http://template-toolkit.org/
---type-add=tt:ext:tt,tt2,ttml
+ $re =~ s{^/|/$}{}g; # XXX validate?
+ $re = qr/$re/i;
-# Visual Basic
---type-add=vb:ext:bas,cls,frm,ctl,vb,resx
+ return bless {
+ regex => $re,
+ groupname => 'MatchGroup',
+ }, $class;
+}
-# Verilog
---type-add=verilog:ext:v,vh,sv
+sub create_group {
+ return App::Ack::Filter::MatchGroup->new;
+}
-# VHDL http://www.eda.org/twiki/bin/view.cgi/P1076/WebHome
---type-add=vhdl:ext:vhd,vhdl
+sub filter {
+ my ( $self, $resource ) = @_;
-# Vim http://www.vim.org/
---type-add=vim:ext:vim
+ my $re = $self->{'regex'};
-# XML http://www.w3.org/TR/REC-xml/
---type-add=xml:ext:xml,dtd,xsl,xslt,ent
---type-add=xml:firstlinematch:/<[?]xml/
+ return $resource->basename =~ /$re/;
+}
-# YAML http://yaml.org/
---type-add=yaml:ext:yaml,yml
-HERE
+sub inspect {
+ my ( $self ) = @_;
+
+ my $re = $self->{'regex'};
+
+ print ref($self) . " - $re";
+
+ return;
+}
+
+sub to_string {
+ my ( $self ) = @_;
+
+ my $re = $self->{'regex'};
+
+ return "filename matches $re";
+}
+
+BEGIN {
+ App::Ack::Filter->register_filter(match => __PACKAGE__);
+}
+
+1;
+package App::Ack::Filter::Default;
+
+
+use strict;
+use warnings;
+BEGIN {
+ our @ISA = 'App::Ack::Filter';
+}
+
+sub new {
+ my ( $class ) = @_;
+
+ return bless {}, $class;
+}
+
+sub filter {
+ my ( $self, $resource ) = @_;
+
+ return -T $resource->name;
}
1;
+package App::Ack::Filter::Inverse;
+
+
+
+use strict;
+use warnings;
+BEGIN {
+ our @ISA = 'App::Ack::Filter';
+}
+
+sub new {
+ my ( $class, $filter ) = @_;
+
+ return bless {
+ filter => $filter,
+ }, $class;
+}
+
+sub filter {
+ my ( $self, $resource ) = @_;
+
+ my $filter = $self->{'filter'};
+ return !$filter->filter( $resource );
+}
+
+sub invert {
+ my $self = shift;
+
+ return $self->{'filter'};
+}
+
+sub is_inverted {
+ return 1;
+}
+
+sub inspect {
+ my ( $self ) = @_;
+
+ my $filter = $self->{'filter'};
+
+ return "!$filter";
+}
+
+1;
+package App::Ack::Filter::Collection;
+
+
+use strict;
+use warnings;
+BEGIN {
+ our @ISA = 'App::Ack::Filter';
+}
+
+sub new {
+ my ( $class ) = @_;
+
+ return bless {
+ groups => {},
+ ungrouped => [],
+ }, $class;
+}
+
+sub filter {
+ my ( $self, $resource ) = @_;
+
+ for my $group (values %{$self->{'groups'}}) {
+ if ($group->filter($resource)) {
+ return 1;
+ }
+ }
+
+ for my $filter (@{$self->{'ungrouped'}}) {
+ if ($filter->filter($resource)) {
+ return 1;
+ }
+ }
+
+ return 0;
+}
+
+sub add {
+ my ( $self, $filter ) = @_;
+
+ if (exists $filter->{'groupname'}) {
+ my $group = ($self->{groups}->{$filter->{groupname}} ||= $filter->create_group());
+ $group->add($filter);
+ }
+ else {
+ push @{$self->{'ungrouped'}}, $filter;
+ }
+
+ return;
+}
+
+sub inspect {
+ my ( $self ) = @_;
+
+ return ref($self) . " - $self";
+}
+
+sub to_string {
+ my ( $self ) = @_;
+
+ my $ungrouped = $self->{'ungrouped'};
+
+ return join(', ', map { "($_)" } @{$ungrouped});
+}
+
+1;
+package App::Ack::Filter::IsGroup;
+
+
+use strict;
+use warnings;
+BEGIN {
+ our @ISA = 'App::Ack::Filter';
+}
+
+use File::Spec 3.00 ();
+
+sub new {
+ my ( $class ) = @_;
+
+ return bless {
+ data => {},
+ }, $class;
+}
+
+sub add {
+ my ( $self, $filter ) = @_;
+
+ $self->{data}->{ $filter->{filename} } = 1;
+
+ return;
+}
+
+sub filter {
+ my ( $self, $resource ) = @_;
+
+ my $data = $self->{'data'};
+ my $base = $resource->basename;
+
+ return exists $data->{$base};
+}
+
+sub inspect {
+ my ( $self ) = @_;
+
+ return ref($self) . " - $self";
+}
+
+sub to_string {
+ my ( $self ) = @_;
+
+ return join(' ', keys %{$self->{data}});
+}
+
+1;
+package App::Ack::Filter::ExtensionGroup;
+
+
+use strict;
+use warnings;
+BEGIN {
+ our @ISA = 'App::Ack::Filter';
+}
+
+sub new {
+ my ( $class ) = @_;
+
+ return bless {
+ data => {},
+ }, $class;
+}
+
+sub add {
+ my ( $self, $filter ) = @_;
+
+ foreach my $ext (@{$filter->{extensions}}) {
+ $self->{data}->{lc $ext} = 1;
+ }
+
+ return;
+}
+
+sub filter {
+ my ( $self, $resource ) = @_;
+
+ if ($resource->name =~ /[.]([^.]*)$/) {
+ return exists $self->{'data'}->{lc $1};
+ }
+
+ return 0;
+}
+
+sub inspect {
+ my ( $self ) = @_;
+
+ return ref($self) . " - $self";
+}
+
+sub to_string {
+ my ( $self ) = @_;
+
+ return join(' ', map { ".$_" } sort keys %{$self->{data}});
+}
+
+1;
+package App::Ack::Filter::MatchGroup;
+
+
+use strict;
+use warnings;
+BEGIN {
+ our @ISA = 'App::Ack::Filter';
+}
+
+sub new {
+ my ( $class ) = @_;
+
+ return bless {
+ matches => [],
+ big_re => undef,
+ }, $class;
+}
+
+sub add {
+ my ( $self, $filter ) = @_;
+
+ push @{ $self->{matches} }, $filter->{regex};
+
+ my $re = join('|', map { "(?:$_)" } @{ $self->{matches} });
+ $self->{big_re} = qr/$re/;
+
+ return;
+}
+
+sub filter {
+ my ( $self, $resource ) = @_;
+
+ my $re = $self->{big_re};
+
+ return $resource->basename =~ /$re/;
+}
+
+sub inspect {
+ my ( $self ) = @_;
+
+ # XXX Needs an explicit return.
+}
+
+sub to_string {
+ my ( $self ) = @_;
+
+ # XXX Needs an explicit return.
+}
+
+1;
+package App::Ack::Filter::IsPath;
+
+
+use strict;
+use warnings;
+BEGIN {
+ our @ISA = 'App::Ack::Filter';
+}
+
+
+sub new {
+ my ( $class, $filename ) = @_;
+
+ return bless {
+ filename => $filename,
+ groupname => 'IsPathGroup',
+ }, $class;
+}
+
+sub create_group {
+ return App::Ack::Filter::IsPathGroup->new();
+}
+
+sub filter {
+ my ( $self, $resource ) = @_;
+
+ return $resource->name eq $self->{'filename'};
+}
+
+sub inspect {
+ my ( $self ) = @_;
+
+ my $filename = $self->{'filename'};
+
+ return ref($self) . " - $filename";
+}
+
+sub to_string {
+ my ( $self ) = @_;
+
+ my $filename = $self->{'filename'};
+
+ return $filename;
+}
+
+1;
+package App::Ack::Filter::IsPathGroup;
+
+
+
+
+use strict;
+use warnings;
+BEGIN {
+ our @ISA = 'App::Ack::Filter';
+}
+
+sub new {
+ my ( $class ) = @_;
+
+ return bless {
+ data => {},
+ }, $class;
+}
+
+sub add {
+ my ( $self, $filter ) = @_;
+
+ $self->{data}->{ $filter->{filename} } = 1;
+
+ return;
+}
+
+sub filter {
+ my ( $self, $resource ) = @_;
+
+ my $data = $self->{'data'};
+
+ return exists $data->{$resource->name};
+}
+
+sub inspect {
+ my ( $self ) = @_;
+
+ return ref($self) . " - $self";
+}
+
+sub to_string {
+ my ( $self ) = @_;
+
+ return join(' ', keys %{$self->{data}});
+}
+
+1;
+package File::Next;
+
+use strict;
+use warnings;
+
+
+our $VERSION = '1.16';
+
+
+
+use File::Spec ();
+
+our $name; # name of the current file
+our $dir; # dir of the current file
+
+our %files_defaults;
+our %skip_dirs;
+
+BEGIN {
+ %files_defaults = (
+ file_filter => undef,
+ descend_filter => undef,
+ error_handler => sub { CORE::die $_[0] },
+ warning_handler => sub { CORE::warn @_ },
+ sort_files => undef,
+ follow_symlinks => 1,
+ nul_separated => 0,
+ );
+ %skip_dirs = map {($_,1)} (File::Spec->curdir, File::Spec->updir);
+}
+
+
+sub files {
+ die _bad_invocation() if @_ && defined($_[0]) && ($_[0] eq __PACKAGE__);
+
+ my ($parms,@queue) = _setup( \%files_defaults, @_ );
+
+ return sub {
+ my $filter = $parms->{file_filter};
+ while (@queue) {
+ my ($dirname,$file,$fullpath) = splice( @queue, 0, 3 );
+ if ( -f $fullpath || -p _ || $fullpath =~ m{^/dev/fd} ) {
+ if ( $filter ) {
+ local $_ = $file;
+ local $File::Next::dir = $dirname;
+ local $File::Next::name = $fullpath;
+ next if not $filter->();
+ }
+ return wantarray ? ($dirname,$file,$fullpath) : $fullpath;
+ }
+ if ( -d _ ) {
+ unshift( @queue, _candidate_files( $parms, $fullpath ) );
+ }
+ } # while
+
+ return;
+ }; # iterator
+}
+
+
+
+
+
+
+sub from_file {
+ die _bad_invocation() if @_ && defined($_[0]) && ($_[0] eq __PACKAGE__);
+
+ my ($parms,@queue) = _setup( \%files_defaults, @_ );
+ my $err = $parms->{error_handler};
+ my $warn = $parms->{warning_handler};
+
+ my $filename = $queue[1];
+
+ if ( !defined($filename) ) {
+ $err->( 'Must pass a filename to from_file()' );
+ return undef;
+ }
+
+ my $fh;
+ if ( $filename eq '-' ) {
+ $fh = \*STDIN;
+ }
+ else {
+ if ( !open( $fh, '<', $filename ) ) {
+ $err->( "Unable to open $filename: $!", $! + 0 );
+ return undef;
+ }
+ }
+
+ return sub {
+ my $filter = $parms->{file_filter};
+ local $/ = $parms->{nul_separated} ? "\x00" : $/;
+ while ( my $fullpath = <$fh> ) {
+ chomp $fullpath;
+ next unless $fullpath =~ /./;
+ if ( not ( -f $fullpath || -p _ ) ) {
+ $warn->( "$fullpath: No such file" );
+ next;
+ }
+
+ my ($volume,$dirname,$file) = File::Spec->splitpath( $fullpath );
+ if ( $filter ) {
+ local $_ = $file;
+ local $File::Next::dir = $dirname;
+ local $File::Next::name = $fullpath;
+ next if not $filter->();
+ }
+ return wantarray ? ($dirname,$file,$fullpath) : $fullpath;
+ } # while
+ close $fh;
+
+ return;
+ }; # iterator
+}
+
+sub _bad_invocation {
+ my $good = (caller(1))[3];
+ my $bad = $good;
+ $bad =~ s/(.+)::/$1->/;
+ return "$good must not be invoked as $bad";
+}
+
+sub sort_standard($$) { return $_[0]->[1] cmp $_[1]->[1] }
+sub sort_reverse($$) { return $_[1]->[1] cmp $_[0]->[1] }
+
+sub reslash {
+ my $path = shift;
+
+ my @parts = split( /\//, $path );
+
+ return $path if @parts < 2;
+
+ return File::Spec->catfile( @parts );
+}
+
+
+
+sub _setup {
+ my $defaults = shift;
+ my $passed_parms = ref $_[0] eq 'HASH' ? {%{+shift}} : {}; # copy parm hash
+
+ my %passed_parms = %{$passed_parms};
+
+ my $parms = {};
+ for my $key ( keys %{$defaults} ) {
+ $parms->{$key} =
+ exists $passed_parms{$key}
+ ? delete $passed_parms{$key}
+ : $defaults->{$key};
+ }
+
+ # Any leftover keys are bogus
+ for my $badkey ( keys %passed_parms ) {
+ my $sub = (caller(1))[3];
+ $parms->{error_handler}->( "Invalid option passed to $sub(): $badkey" );
+ }
+
+ # If it's not a code ref, assume standard sort
+ if ( $parms->{sort_files} && ( ref($parms->{sort_files}) ne 'CODE' ) ) {
+ $parms->{sort_files} = \&sort_standard;
+ }
+ my @queue;
+
+ for ( @_ ) {
+ my $start = reslash( $_ );
+ if (-d $start) {
+ push @queue, ($start,undef,$start);
+ }
+ else {
+ push @queue, (undef,$start,$start);
+ }
+ }
+
+ return ($parms,@queue);
+}
+
+
+sub _candidate_files {
+ my $parms = shift;
+ my $dirname = shift;
+
+ my $dh;
+ if ( !opendir $dh, $dirname ) {
+ $parms->{error_handler}->( "$dirname: $!", $! + 0 );
+ return;
+ }
+
+ my @newfiles;
+ my $descend_filter = $parms->{descend_filter};
+ my $follow_symlinks = $parms->{follow_symlinks};
+ my $sort_sub = $parms->{sort_files};
+
+ for my $file ( grep { !exists $skip_dirs{$_} } readdir $dh ) {
+ my $has_stat;
+
+ my $fullpath = File::Spec->catdir( $dirname, $file );
+ if ( !$follow_symlinks ) {
+ next if -l $fullpath;
+ $has_stat = 1;
+ }
+
+ # Only do directory checking if we have a descend_filter
+ if ( $descend_filter ) {
+ if ( $has_stat ? (-d _) : (-d $fullpath) ) {
+ local $File::Next::dir = $fullpath;
+ local $_ = $file;
+ next if not $descend_filter->();
+ }
+ }
+ if ( $sort_sub ) {
+ push( @newfiles, [ $dirname, $file, $fullpath ] );
+ }
+ else {
+ push( @newfiles, $dirname, $file, $fullpath );
+ }
+ }
+ closedir $dh;
+
+ if ( $sort_sub ) {
+ return map { @{$_} } sort $sort_sub @newfiles;
+ }
+
+ return @newfiles;
+}
+
+
+1; # End of File::Next