%PDF-
%PDF-
Mini Shell
Mini Shell
package App::Ack::ConfigLoader;
use strict;
use warnings;
use App::Ack ();
use App::Ack::ConfigDefault ();
use App::Ack::ConfigFinder ();
use App::Ack::Filter;
use App::Ack::Filter::Collection;
use App::Ack::Filter::Default;
use Carp 1.04 ();
use Getopt::Long 2.38 ();
use Text::ParseWords 3.1 ();
=head1 NAME
App::Ack::ConfigLoader
=head1 DESCRIPTION
Logic for loading configuration files.
=head1 FUNCTIONS
=head2 process_args( @sources )
=cut
my @INVALID_COMBINATIONS;
BEGIN {
my @context = qw( -A -B -C --after-context --before-context --context );
my @pretty = qw( --heading --group --break );
my @filename = qw( -h -H --with-filename --no-filename );
@INVALID_COMBINATIONS = (
# XXX normalize
[qw(-l)] => [@context, @pretty, @filename, qw(-L -o --passthru --output --max-count --column -f -g --show-types)],
[qw(-L)] => [@context, @pretty, @filename, qw(-l -o --passthru --output --max-count --column -f -g --show-types -c --count)],
[qw(--line)] => [@context, @pretty, @filename, qw(-l --files-with-matches --files-without-matches -L -o --passthru --match -m --max-count -1 -c --count --column --print0 -f -g --show-types)],
[qw(-o)] => [@context, qw(--output -c --count --column --column -f --show-types)],
[qw(--passthru)] => [@context, qw(--output --column -m --max-count -1 -c --count -f -g)],
[qw(--output)] => [@context, qw(-c --count -f -g)],
[qw(--match)] => [qw(-f -g)],
[qw(-m --max-count)] => [qw(-1 -f -g -c --count)],
[qw(-h --no-filename)] => [qw(-H --with-filename -f -g --group --heading)],
[qw(-H --with-filename)] => [qw(-h --no-filename -f -g)],
[qw(-c --count)] => [@context, @pretty, qw(--column -f -g)],
[qw(--column)] => [qw(-f -g)],
[@context] => [qw(-f -g)],
[qw(-f)] => [qw(-g), @pretty],
[qw(-g)] => [qw(-f), @pretty],
);
}
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 ) = @_;
if ( $spec =~ /^(\w+):(\w+):(.*)/ ) {
my ( $type_name, $ext_type, $arguments ) = ( $1, $2, $3 );
return ( $type_name,
App::Ack::Filter->create_filter($ext_type, split(/,/, $arguments)) );
}
elsif ( $spec =~ /^(\w+)=(.*)/ ) { # Check to see if we have ack1-style argument specification.
my ( $type_name, $extensions ) = ( $1, $2 );
my @extensions = split(/,/, $extensions);
foreach my $extension ( @extensions ) {
$extension =~ s/^[.]//;
}
return ( $type_name, App::Ack::Filter->create_filter('ext', @extensions) );
}
else {
Carp::croak "invalid filter specification '$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 ) = @_;
Getopt::Long::Configure('default', 'no_auto_help', 'no_auto_version'); # start with default options, minus some annoying ones
Getopt::Long::Configure(
'no_ignore_case',
'no_auto_abbrev',
'pass_through',
);
my %additional_specs;
my $add_spec = sub {
my ( undef, $spec ) = @_;
my ( $name, $filter ) = process_filter_spec($spec);
push @{ $App::Ack::mappings{$name} }, $filter;
$additional_specs{$name . '!'} = sub {
my ( undef, $value ) = @_;
my @filters = @{ $App::Ack::mappings{$name} };
if ( not $value ) {
@filters = map { $_->invert() } @filters;
}
else {
uninvert_filter( $opt, @filters );
}
push @{ $opt->{'filters'} }, @filters;
};
};
my $set_spec = sub {
my ( undef, $spec ) = @_;
my ( $name, $filter ) = process_filter_spec($spec);
$App::Ack::mappings{$name} = [ $filter ];
$additional_specs{$name . '!'} = sub {
my ( undef, $value ) = @_;
my @filters = @{ $App::Ack::mappings{$name} };
if ( not $value ) {
@filters = map { $_->invert() } @filters;
}
push @{ $opt->{'filters'} }, @filters;
};
};
my $delete_spec = sub {
my ( undef, $name ) = @_;
delete $App::Ack::mappings{$name};
delete $additional_specs{$name . '!'};
};
my %type_arg_specs = (
'type-add=s' => $add_spec,
'type-set=s' => $set_spec,
'type-del=s' => $delete_spec,
);
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
local @ARGV = @{$args};
Getopt::Long::GetOptions(%type_arg_specs);
@{$args} = @ARGV;
}
else {
( undef, $source->{contents} ) =
Getopt::Long::GetOptionsFromString($args, %type_arg_specs);
}
}
$additional_specs{'k|known-types'} = sub {
my ( undef, $value ) = @_;
my @filters = map { @{$_} } values(%App::Ack::mappings);
push @{ $opt->{'filters'} }, @filters;
};
return \%additional_specs;
}
sub removed_option {
my ( $option, $explanation ) = @_;
$explanation ||= '';
return sub {
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';
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
=begin Adding-Options
*** IF YOU ARE MODIFYING ACK PLEASE READ THIS ***
If you plan to add a new option to ack, please make sure of
the following:
* Your new option has a test underneath the t/ directory.
* Your new option is explained when a user invokes ack --help.
(See App::Ack::show_help)
* Your new option is explained when a user invokes ack --man.
(See the POD at the end of ./ack)
* Add your option to t/config-loader.t
* Add your option to t/Util.pm#get_options
* Add your option's description and aliases to dev/generate-completion-scripts.pl
* Go through the list of options already available, and consider
whether your new option can be considered mutually exclusive
with another option.
=end Adding-Options
=cut
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:-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},
c => \$opt->{count},
'color|colour!' => \$opt->{color},
'color-match=s' => \$ENV{ACK_COLOR_MATCH},
'color-filename=s' => \$ENV{ACK_COLOR_FILENAME},
'color-lineno=s' => \$ENV{ACK_COLOR_LINENO},
'column!' => \$opt->{column},
count => \$opt->{count},
'create-ackrc' => sub { print "$_\n" for ( '--ignore-ack-defaults', App::Ack::ConfigDefault::options() ); exit; },
'env!' => sub {
my ( undef, $value ) = @_;
if ( !$value ) {
$opt->{noenv_seen} = 1;
}
},
f => \$opt->{f},
'files-from=s' => \$opt->{files_from},
'filter!' => \$App::Ack::is_filter_mode,
flush => \$opt->{flush},
'follow!' => \$opt->{follow},
g => \$opt->{g},
G => removed_option('-G'),
'group!' => sub { shift; $opt->{heading} = $opt->{break} = shift },
'heading!' => \$opt->{heading},
'h|no-filename' => \$opt->{h},
'H|with-filename' => \$opt->{H},
'i|ignore-case' => \$opt->{i},
'ignore-directory|ignore-dir=s' => _generate_ignore_dir('--ignore-dir', $opt),
'ignore-file=s' => sub {
my ( undef, $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'
=> \$opt->{l},
'L|files-without-matches'
=> \$opt->{L},
'm|max-count=i' => \$opt->{m},
'match=s' => \$opt->{regex},
'n|no-recurse' => \$opt->{n},
o => sub { $opt->{output} = '$&' },
'output=s' => \$opt->{output},
'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},
'Q|literal' => \$opt->{Q},
'r|R|recurse' => sub { $opt->{n} = 0 },
's' => \$opt->{dont_report_bad_filenames},
'show-types' => \$opt->{show_types},
'smart-case!' => \$opt->{smart_case},
'sort-files' => \$opt->{sort_files},
'type=s' => sub {
my ( $getopt, $value ) = @_;
my $cb_value = 1;
if ( $value =~ s/^no// ) {
$cb_value = 0;
}
my $callback = $extra_specs->{ $value . '!' };
if ( $callback ) {
$callback->( $getopt, $cb_value );
}
else {
Carp::croak( "Unknown type '$value'" );
}
},
'u' => removed_option('-u'),
'unrestricted' => removed_option('--unrestricted'),
'v|invert-match' => \$opt->{v},
'w|word-regexp' => \$opt->{w},
'x' => sub { $opt->{files_from} = '-' },
'version' => sub { App::Ack::print_version_statement(); exit; },
'help|?:s' => sub { shift; App::Ack::show_help(@_); exit; },
'help-types' => sub { App::Ack::show_help_types(); exit; },
'help-colors' => sub { App::Ack::show_help_colors(); exit; },
'help-rgb-colors' => sub { App::Ack::show_help_rgb(); exit; },
'man' => sub { App::Ack::show_man(); exit; },
$extra_specs ? %{$extra_specs} : (),
}; # arg_specs
}
sub process_other {
my ( $opt, $extra_specs, $arg_sources ) = @_;
# 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;
foreach my $source (@{$arg_sources}) {
my ( $source_name, $args ) = @{$source}{qw/name contents/};
if ( $source_name eq 'ARGV' ) {
$argv_source = $args;
last;
}
}
if ( $argv_source ) { # This *should* always be true, but you never know...
my @copy = @{$argv_source};
local @ARGV = @copy;
Getopt::Long::Configure('pass_through');
Getopt::Long::GetOptions(
'help-types' => \$is_help_types_active,
);
Getopt::Long::Configure('no_pass_through');
}
my $arg_specs = get_arg_spec($opt, $extra_specs);
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( %{$args_for_source} );
@{$args} = @ARGV;
}
else {
( $ret, $source->{contents} ) =
Getopt::Long::GetOptionsFromString( $args, %{$args_for_source} );
}
if ( !$ret ) {
if ( !$is_help_types_active ) {
my $where = $source_name eq 'ARGV' ? 'on command line' : "in $source_name";
App::Ack::die( "Invalid option $where" );
}
}
if ( $opt->{noenv_seen} ) {
App::Ack::die( "--noenv found in $source_name" );
}
}
# XXX We need to check on a -- in the middle of a non-ARGV source
return;
}
sub should_dump_options {
my ( $sources ) = @_;
foreach my $source (@{$sources}) {
my ( $name, $options ) = @{$source}{qw/name contents/};
if($name eq 'ARGV') {
my $dump;
local @ARGV = @{$options};
Getopt::Long::Configure('default', 'pass_through', 'no_auto_help', 'no_auto_version');
Getopt::Long::GetOptions(
'dump' => \$dump,
);
@{$options} = @ARGV;
return $dump;
}
}
return;
}
sub explode_sources {
my ( $sources ) = @_;
my @new_sources;
Getopt::Long::Configure('default', 'pass_through', 'no_auto_help', 'no_auto_version');
my %opt;
my $arg_spec = get_arg_spec(\%opt);
my $add_type = sub {
my ( undef, $arg ) = @_;
# XXX refactor?
if ( $arg =~ /(\w+)=/) {
$arg_spec->{$1} = sub {};
}
else {
( $arg ) = split /:/, $arg;
$arg_spec->{$arg} = sub {};
}
};
my $del_type = sub {
my ( undef, $arg ) = @_;
delete $arg_spec->{$arg};
};
foreach my $source (@{$sources}) {
my ( $name, $options ) = @{$source}{qw/name contents/};
if ( ref($options) ne 'ARRAY' ) {
$source->{contents} = $options =
[ Text::ParseWords::shellwords($options) ];
}
for my $j ( 0 .. @{$options}-1 ) {
next unless $options->[$j] =~ /^-/;
my @chunk = ( $options->[$j] );
push @chunk, $options->[$j] while ++$j < @{$options} && $options->[$j] !~ /^-/;
$j--;
my @copy = @chunk;
local @ARGV = @chunk;
Getopt::Long::GetOptions(
'type-add=s' => $add_type,
'type-set=s' => $add_type,
'type-del=s' => $del_type,
);
Getopt::Long::GetOptions( %{$arg_spec} );
push @new_sources, {
name => $name,
contents => \@copy,
};
}
}
return \@new_sources;
}
sub compare_opts {
my ( $a, $b ) = @_;
my $first_a = $a->[0];
my $first_b = $b->[0];
$first_a =~ s/^--?//;
$first_b =~ s/^--?//;
return $first_a cmp $first_b;
}
sub dump_options {
my ( $sources ) = @_;
$sources = explode_sources($sources);
my %opts_by_source;
my @source_names;
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;
}
push @{$opts_by_source{$name}}, $contents;
}
foreach my $name (@source_names) {
my $contents = $opts_by_source{$name};
print $name, "\n";
print '=' x length($name), "\n";
print ' ', join(' ', @{$_}), "\n" foreach sort { compare_opts($a, $b) } @{$contents};
}
return;
}
sub remove_default_options_if_needed {
my ( $sources ) = @_;
my $default_index;
foreach my $index ( 0 .. $#{$sources} ) {
if ( $sources->[$index]{'name'} eq 'Defaults' ) {
$default_index = $index;
last;
}
}
return $sources unless defined $default_index;
my $should_remove = 0;
# 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 + 1 .. $#{$sources} ) {
my ( $name, $args ) = @{$sources->[$index]}{qw/name contents/};
if (ref($args)) {
local @ARGV = @{$args};
Getopt::Long::GetOptions(
'ignore-ack-defaults' => \$should_remove,
);
@{$args} = @ARGV;
}
else {
( undef, $sources->[$index]{contents} ) = Getopt::Long::GetOptionsFromString($args,
'ignore-ack-defaults' => \$should_remove,
);
}
}
Getopt::Long::Configure('default');
Getopt::Long::Configure('default', 'no_auto_help', 'no_auto_version');
return $sources unless $should_remove;
my @copy = @{$sources};
splice @copy, $default_index, 1;
return \@copy;
}
sub check_for_mutually_exclusive_options {
my ( $arg_sources ) = @_;
my %mutually_exclusive_with;
my @copy = @{$arg_sources};
for(my $i = 0; $i < @INVALID_COMBINATIONS; $i += 2) {
my ( $lhs, $rhs ) = @INVALID_COMBINATIONS[ $i, $i + 1 ];
foreach my $l_opt ( @{$lhs} ) {
foreach my $r_opt ( @{$rhs} ) {
push @{ $mutually_exclusive_with{ $l_opt } }, $r_opt;
push @{ $mutually_exclusive_with{ $r_opt } }, $l_opt;
}
}
}
while( @copy ) {
my %set_opts;
my $source = shift @copy;
my ( $source_name, $args ) = @{$source}{qw/name contents/};
$args = ref($args) ? [ @{$args} ] : [ Text::ParseWords::shellwords($args) ];
foreach my $opt ( @{$args} ) {
next unless $opt =~ /^[-+]/;
last if $opt eq '--';
if( $opt =~ /^(.*)=/ ) {
$opt = $1;
}
elsif ( $opt =~ /^(-[^-]).+/ ) {
$opt = $1;
}
$set_opts{ $opt } = 1;
my $mutex_opts = $mutually_exclusive_with{ $opt };
next unless $mutex_opts;
foreach my $mutex_opt ( @{$mutex_opts} ) {
if($set_opts{ $mutex_opt }) {
die "Options '$mutex_opt' and '$opt' are mutually exclusive\n";
}
}
}
}
return;
}
sub process_args {
my $arg_sources = \@_;
my %opt = (
pager => $ENV{ACK_PAGER_COLOR} || $ENV{ACK_PAGER},
);
check_for_mutually_exclusive_options($arg_sources);
$arg_sources = remove_default_options_if_needed($arg_sources);
if ( should_dump_options($arg_sources) ) {
dump_options($arg_sources);
exit(0);
}
my $type_specs = process_filetypes(\%opt, $arg_sources);
process_other(\%opt, $type_specs, $arg_sources);
while ( @{$arg_sources} ) {
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) ) {
if ( $source_name eq 'ARGV' ) {
@ARGV = @{$args};
}
elsif (@{$args}) {
Carp::croak "source '$source_name' has extra arguments!";
}
}
else {
Carp::croak 'The impossible has occurred!';
}
}
my $filters = ($opt{filters} ||= []);
# Throw the default filter in if no others are selected.
if ( not grep { !$_->is_inverted() } @{$filters} ) {
push @{$filters}, App::Ack::Filter::Default->new();
}
return \%opt;
}
sub retrieve_arg_sources {
my @arg_sources;
my $noenv;
my $ackrc;
Getopt::Long::Configure('default', 'no_auto_help', 'no_auto_version');
Getopt::Long::Configure('pass_through');
Getopt::Long::Configure('no_auto_abbrev');
Getopt::Long::GetOptions(
'noenv' => \$noenv,
'ackrc=s' => \$ackrc,
);
Getopt::Long::Configure('default', 'no_auto_help', 'no_auto_version');
my @files;
if ( !$noenv ) {
my $finder = App::Ack::ConfigFinder->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!.
if(open my $fh, '<', $ackrc) {
close $fh;
}
else {
die "Unable to load ackrc '$ackrc': $!"
}
push( @files, { path => $ackrc } );
}
push @arg_sources, {
name => 'Defaults',
contents => [ App::Ack::ConfigDefault::options_clean() ],
};
foreach my $file ( @files) {
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, {
name => 'ACK_OPTIONS',
contents => $ENV{ACK_OPTIONS},
};
}
push @arg_sources, {
name => 'ARGV',
contents => [ @ARGV ],
};
return @arg_sources;
}
1; # End of App::Ack::ConfigLoader
Zerion Mini Shell 1.0