File Coverage

blib/lib/App/Ack/ConfigLoader.pm
Criterion Covered Total %
statement 215 458 46.9
branch 39 122 31.9
condition 10 28 35.7
subroutine 32 72 44.4
pod 0 6 0.0
total 296 686 43.1


line stmt bran cond sub pod time code
1             package App::Ack::ConfigLoader;
2              
3 6     6   227538 use strict;
  6         34  
  6         205  
4 6     6   32 use warnings;
  6         30  
  6         146  
5 6     6   135 use 5.010;
  6         22  
6              
7 6     6   1039 use App::Ack ();
  6         22  
  6         130  
8 6     6   1794 use App::Ack::ConfigDefault ();
  6         15  
  6         99  
9 6     6   2667 use App::Ack::ConfigFinder ();
  6         18  
  6         122  
10 6     6   1653 use App::Ack::Filter ();
  6         13  
  6         107  
11 6     6   2584 use App::Ack::Filter::Collection ();
  6         16  
  6         121  
12 6     6   1664 use App::Ack::Filter::Default ();
  6         16  
  6         102  
13 6     6   2581 use App::Ack::Filter::IsPath ();
  6         15  
  6         135  
14 6     6   41 use File::Spec 3.00 ();
  6         113  
  6         137  
15 6     6   3194 use Getopt::Long 2.38 ();
  6         42611  
  6         319  
16 6     6   1791 use Text::ParseWords 3.1 ();
  6         5236  
  6         9227  
17              
18             sub configure_parser {
19 374     374 0 812 my @opts = @_;
20              
21 374         911 my @standard = qw(
22             default
23             bundling
24             no_auto_help
25             no_auto_version
26             no_ignore_case
27             );
28 374         1245 Getopt::Long::Configure( @standard, @opts );
29              
30 374         35960 return;
31             }
32              
33              
34             sub _generate_ignore_dir {
35 296     296   609 my ( $option_name, $opt ) = @_;
36              
37 296         803 my $is_inverted = $option_name =~ /^--no/;
38              
39             return sub {
40 0     0   0 my ( undef, $dir ) = @_;
41              
42 0         0 $dir = _remove_directory_separator( $dir );
43 0 0       0 if ( $dir !~ /:/ ) {
44 0         0 $dir = 'is:' . $dir;
45             }
46              
47 0         0 my ( $filter_type, $args ) = split /:/, $dir, 2;
48              
49 0 0       0 if ( $filter_type eq 'firstlinematch' ) {
50 0         0 App::Ack::die( qq{Invalid filter specification "$filter_type" for option '$option_name'} );
51             }
52              
53 0         0 my $filter = App::Ack::Filter->create_filter($filter_type, split(/,/, $args));
54 0         0 my $collection;
55              
56 0   0     0 my $previous_inversion_matches = $opt->{idirs} && !($is_inverted xor $opt->{idirs}[-1]->is_inverted());
57              
58 0 0       0 if ( $previous_inversion_matches ) {
59 0         0 $collection = $opt->{idirs}[-1];
60              
61 0 0       0 if ( $is_inverted ) {
62             # This relies on invert of an inverted filter to return the original.
63 0         0 $collection = $collection->invert();
64             }
65             }
66             else {
67 0         0 $collection = App::Ack::Filter::Collection->new();
68 0 0       0 push @{ $opt->{idirs} }, $is_inverted ? $collection->invert() : $collection;
  0         0  
69             }
70              
71 0         0 $collection->add($filter);
72              
73 0 0       0 if ( $filter_type eq 'is' ) {
74 0         0 $collection->add(App::Ack::Filter::IsPath->new($args));
75             }
76 296         3718 };
77             }
78              
79              
80             sub _remove_directory_separator {
81 0     0   0 my $path = shift;
82              
83 0 0       0 state $dir_sep_chars = $App::Ack::is_windows ? quotemeta( '\\/' ) : quotemeta( File::Spec->catfile( '', '' ) );
84              
85 0         0 $path =~ s/[$dir_sep_chars]$//;
86              
87 0         0 return $path;
88             }
89              
90              
91             sub _process_filter_spec {
92 0     0   0 my ( $spec ) = @_;
93              
94 0 0       0 if ( $spec =~ /^(\w+):(\w+):(.*)/ ) {
    0          
95 0         0 my ( $type_name, $ext_type, $arguments ) = ( $1, $2, $3 );
96              
97 0         0 return ( $type_name,
98             App::Ack::Filter->create_filter($ext_type, split(/,/, $arguments)) );
99             }
100             elsif ( $spec =~ /^(\w+)=(.*)/ ) { # Check to see if we have ack1-style argument specification.
101 0         0 my ( $type_name, $extensions ) = ( $1, $2 );
102              
103 0         0 my @extensions = split(/,/, $extensions);
104 0         0 foreach my $extension ( @extensions ) {
105 0         0 $extension =~ s/^[.]//;
106             }
107              
108 0         0 return ( $type_name, App::Ack::Filter->create_filter('ext', @extensions) );
109             }
110             else {
111 0         0 App::Ack::die( "Invalid filter specification '$spec'" );
112             }
113             }
114              
115              
116             sub _uninvert_filter {
117 0     0   0 my ( $opt, @filters ) = @_;
118              
119 0 0 0     0 return unless defined $opt->{filters} && @filters;
120              
121             # Loop through all the registered filters. If we hit one that
122             # matches this extension and it's inverted, we need to delete it from
123             # the options.
124 0         0 for ( my $i = 0; $i < @{ $opt->{filters} }; $i++ ) {
  0         0  
125 0         0 my $opt_filter = @{ $opt->{filters} }[$i];
  0         0  
126              
127             # XXX Do a real list comparison? This just checks string equivalence.
128 0 0 0     0 if ( $opt_filter->is_inverted() && "$opt_filter->{filter}" eq "@filters" ) {
129 0         0 splice @{ $opt->{filters} }, $i, 1;
  0         0  
130 0         0 $i--;
131             }
132             }
133              
134 0         0 return;
135             }
136              
137              
138             sub _process_filetypes {
139 74     74   166 my ( $opt, $arg_sources ) = @_;
140              
141 74         105 my %additional_specs;
142              
143             my $add_spec = sub {
144 0     0   0 my ( undef, $spec ) = @_;
145              
146 0         0 my ( $name, $filter ) = _process_filter_spec($spec);
147              
148 0         0 push @{ $App::Ack::mappings{$name} }, $filter;
  0         0  
149              
150             $additional_specs{$name . '!'} = sub {
151 0         0 my ( undef, $value ) = @_;
152              
153 0         0 my @filters = @{ $App::Ack::mappings{$name} };
  0         0  
154 0 0       0 if ( not $value ) {
155 0         0 @filters = map { $_->invert() } @filters;
  0         0  
156             }
157             else {
158 0         0 _uninvert_filter( $opt, @filters );
159             }
160              
161 0         0 push @{ $opt->{'filters'} }, @filters;
  0         0  
162 0         0 };
163 74         373 };
164              
165             my $set_spec = sub {
166 0     0   0 my ( undef, $spec ) = @_;
167              
168 0         0 my ( $name, $filter ) = _process_filter_spec($spec);
169              
170 0         0 $App::Ack::mappings{$name} = [ $filter ];
171              
172             $additional_specs{$name . '!'} = sub {
173 0         0 my ( undef, $value ) = @_;
174              
175 0         0 my @filters = @{ $App::Ack::mappings{$name} };
  0         0  
176 0 0       0 if ( not $value ) {
177 0         0 @filters = map { $_->invert() } @filters;
  0         0  
178             }
179              
180 0         0 push @{ $opt->{'filters'} }, @filters;
  0         0  
181 0         0 };
182 74         261 };
183              
184             my $delete_spec = sub {
185 0     0   0 my ( undef, $name ) = @_;
186              
187 0         0 delete $App::Ack::mappings{$name};
188 0         0 delete $additional_specs{$name . '!'};
189 74         212 };
190              
191 74         286 my %type_arg_specs = (
192             'type-add=s' => $add_spec,
193             'type-set=s' => $set_spec,
194             'type-del=s' => $delete_spec,
195             );
196              
197 74         187 configure_parser( 'no_auto_abbrev', 'pass_through' );
198 74         164 foreach my $source (@{$arg_sources}) {
  74         188  
199 74         136 my $args = $source->{contents};
200              
201 74 50       199 if ( ref($args) ) {
202             # $args are modified in place, so no need to munge $arg_sources
203 74         275 Getopt::Long::GetOptionsFromArray( $args, %type_arg_specs );
204             }
205             else {
206 0         0 ( undef, $source->{contents} ) =
207             Getopt::Long::GetOptionsFromString( $args, %type_arg_specs );
208             }
209             }
210              
211             $additional_specs{'k|known-types'} = sub {
212 0     0   0 my @filters = map { @{$_} } values(%App::Ack::mappings);
  0         0  
  0         0  
213              
214 0         0 push @{ $opt->{'filters'} }, @filters;
  0         0  
215 74         22511 };
216              
217 74         850 return \%additional_specs;
218             }
219              
220              
221             sub get_arg_spec {
222 148     148 0 277 my ( $opt, $extra_specs ) = @_;
223              
224             =begin Adding-Options
225              
226             *** IF YOU ARE MODIFYING ACK PLEASE READ THIS ***
227              
228             If you plan to add a new option to ack, please make sure of
229             the following:
230              
231             * Your new option has a test underneath the t/ directory.
232             * Your new option is explained when a user invokes ack --help.
233             (See App::Ack::show_help)
234             * Your new option is explained when a user invokes ack --man.
235             (See the POD at the end of ./ack)
236             * Add your option to t/config-loader.t
237             * Add your option to t/Util.pm#get_expected_options
238             * Add your option's description and aliases to dev/generate-completion-scripts.pl
239             * Go through the list of options already available, and consider
240             whether your new option can be considered mutex with another option.
241              
242             =end Adding-Options
243              
244             =cut
245              
246             sub _type_handler {
247 0     0   0 my ( $getopt, $value ) = @_;
248              
249 0         0 my $cb_value = 1;
250 0 0       0 if ( $value =~ s/^no// ) {
251 0         0 $cb_value = 0;
252             }
253              
254 0         0 my $callback;
255             {
256 6     6   61 no warnings;
  6         16  
  6         26556  
  0         0  
257 0         0 $callback = $extra_specs->{ $value . '!' };
258             }
259              
260 0 0       0 if ( $callback ) {
261 0         0 $callback->( $getopt, $cb_value );
262             }
263             else {
264 0         0 App::Ack::die( "Unknown type '$value'" );
265             }
266              
267 0         0 return;
268             }
269              
270 148         337 $opt->{not} = [];
271              
272             return {
273 0     0   0 1 => sub { $opt->{1} = $opt->{m} = 1 },
274 16     16   59362 'A|after-context:-1' => sub { shift; $opt->{A} = _context_value(shift) },
  16         42  
275 16     16   58277 'B|before-context:-1' => sub { shift; $opt->{B} = _context_value(shift) },
  16         44  
276 16     16   58394 'C|context:-1' => sub { shift; $opt->{B} = $opt->{A} = _context_value(shift) },
  16         40  
277             'break!' => \$opt->{break},
278             'c|count' => \$opt->{c},
279             'color|colour!' => \$opt->{color},
280             'color-match=s' => \$ENV{ACK_COLOR_MATCH},
281             'color-filename=s' => \$ENV{ACK_COLOR_FILENAME},
282             'color-colno=s' => \$ENV{ACK_COLOR_COLNO},
283             'color-lineno=s' => \$ENV{ACK_COLOR_LINENO},
284             'column!' => \$opt->{column},
285 0     0   0 'create-ackrc' => sub { say for ( '--ignore-ack-defaults', App::Ack::ConfigDefault::options() ); exit; },
  0         0  
286             'debug' => \$opt->{debug},
287             'env!' => sub {
288 0     0   0 my ( undef, $value ) = @_;
289              
290 0 0       0 if ( !$value ) {
291 0         0 $opt->{noenv_seen} = 1;
292             }
293             },
294             f => \$opt->{f},
295             'files-from=s' => \$opt->{files_from},
296             'filter!' => \$App::Ack::is_filter_mode,
297 0     0   0 flush => sub { $| = 1 },
298             'follow!' => \$opt->{follow},
299             g => \$opt->{g},
300 0     0   0 'group!' => sub { shift; $opt->{heading} = $opt->{break} = shift },
  0         0  
301             'heading!' => \$opt->{heading},
302             'h|no-filename' => \$opt->{h},
303             'H|with-filename' => \$opt->{H},
304 0     0   0 'i|ignore-case' => sub { $opt->{i} = 1; $opt->{S} = 0; },
  0         0  
305 0     0   0 'I|no-ignore-case' => sub { $opt->{i} = 0; $opt->{S} = 0; },
  0         0  
306             'ignore-directory|ignore-dir=s' => _generate_ignore_dir('--ignore-dir', $opt),
307             'ignore-file=s' => sub {
308 0     0   0 my ( undef, $file ) = @_;
309              
310 0         0 my ( $filter_type, $args ) = split /:/, $file, 2;
311              
312 0   0     0 my $filter = App::Ack::Filter->create_filter($filter_type, split(/,/, $args//''));
313              
314 0 0       0 if ( !$opt->{ifiles} ) {
315 0         0 $opt->{ifiles} = App::Ack::Filter::Collection->new();
316             }
317 0         0 $opt->{ifiles}->add($filter);
318             },
319             'l|files-with-matches'
320             => \$opt->{l},
321             'L|files-without-matches'
322             => \$opt->{L},
323             'm|max-count=i' => \$opt->{m},
324             'match=s' => \$opt->{regex},
325             'n|no-recurse' => \$opt->{n},
326 0     0   0 o => sub { $opt->{output} = '$&' },
327             'output=s' => \$opt->{output},
328             'pager:s' => sub {
329 10     10   37068 my ( undef, $value ) = @_;
330              
331 10   66     54 $opt->{pager} = $value || $ENV{PAGER};
332             },
333             'noignore-directory|noignore-dir=s' => _generate_ignore_dir('--noignore-dir', $opt),
334 6     6   22129 'nopager' => sub { $opt->{pager} = undef },
335             'not=s' => $opt->{not},
336             'passthru' => \$opt->{passthru},
337             'print0' => \$opt->{print0},
338             'p|proximate:1' => \$opt->{p},
339 0     0   0 'P' => sub { $opt->{p} = 0 },
340             'Q|literal' => \$opt->{Q},
341 0     0   0 'r|R|recurse' => sub { $opt->{n} = 0 },
342             'range-start=s' => \$opt->{range_start},
343             'range-end=s' => \$opt->{range_end},
344             'range-invert!' => \$opt->{range_invert},
345             's' => \$opt->{s},
346             'show-types' => \$opt->{show_types},
347 0 0   0   0 'S|smart-case!' => sub { my (undef,$value) = @_; $opt->{S} = $value; $opt->{i} = 0 if $value; },
  0         0  
  0         0  
348             'sort-files' => \$opt->{sort_files},
349             't|type=s' => \&_type_handler,
350 0     0   0 'T=s' => sub { my ($getopt,$value) = @_; $value="no$value"; _type_handler($getopt,$value); },
  0         0  
  0         0  
351             'underline!' => \$opt->{underline},
352             'v|invert-match' => \$opt->{v},
353             'w|word-regexp' => \$opt->{w},
354 0     0   0 'x' => sub { $opt->{files_from} = '-' },
355              
356 0     0   0 'help' => sub { App::Ack::show_help(); exit; },
  0         0  
357 0     0   0 'help-types' => sub { App::Ack::show_help_types(); exit; },
  0         0  
358 0     0   0 'help-colors' => sub { App::Ack::show_help_colors(); exit; },
  0         0  
359 0     0   0 'help-rgb-colors' => sub { App::Ack::show_help_rgb(); exit; },
  0         0  
360 148 50       2213 $extra_specs ? %{$extra_specs} : (),
  148         4254  
361             }; # arg_specs
362             }
363              
364              
365             sub _context_value {
366 48     48   75 my $val = shift;
367              
368             # Contexts default to 2.
369 48 100 66     330 return (!defined($val) || ($val < 0)) ? 2 : $val;
370             }
371              
372              
373             sub _process_other {
374 74     74   147 my ( $opt, $extra_specs, $arg_sources ) = @_;
375              
376 74         115 my $argv_source;
377             my $is_help_types_active;
378              
379 74         105 foreach my $source (@{$arg_sources}) {
  74         139  
380 74 50       219 if ( $source->{name} eq 'ARGV' ) {
381 74         122 $argv_source = $source->{contents};
382 74         147 last;
383             }
384             }
385              
386 74 50       163 if ( $argv_source ) { # This *should* always be true, but you never know...
387 74         197 configure_parser( 'pass_through' );
388 74         116 Getopt::Long::GetOptionsFromArray( [ @{$argv_source} ],
  74         263  
389             'help-types' => \$is_help_types_active,
390             );
391             }
392              
393 74         11340 my $arg_specs = get_arg_spec( $opt, $extra_specs );
394              
395 74         232 configure_parser();
396 74         122 foreach my $source (@{$arg_sources}) {
  74         196  
397 74         125 my ( $source_name, $args ) = @{$source}{qw/name contents/};
  74         197  
398              
399 74         118 my $args_for_source = { %{$arg_specs} };
  74         2130  
400              
401 74 50       408 if ( $source->{is_ackrc} ) {
402             my $illegal = sub {
403 0     0   0 my $name = shift;
404 0         0 App::Ack::die( "Option --$name is forbidden in .ackrc files." );
405 0         0 };
406              
407             $args_for_source = {
408 0         0 %{$args_for_source},
  0         0  
409             'output=s' => $illegal,
410             'match=s' => $illegal,
411             };
412             }
413 74 50       165 if ( $source->{project} ) {
414             my $illegal = sub {
415 0     0   0 my $name = shift;
416 0         0 App::Ack::die( "Option --$name is forbidden in project .ackrc files." );
417 0         0 };
418              
419             $args_for_source = {
420 0         0 %{$args_for_source},
  0         0  
421             'pager:s' => $illegal,
422             };
423             }
424              
425 74         116 my $ret;
426 74 50       193 if ( ref($args) ) {
427 74         102 $ret = Getopt::Long::GetOptionsFromArray( $args, %{$args_for_source} );
  74         709  
428             }
429             else {
430             ( $ret, $source->{contents} ) =
431 0         0 Getopt::Long::GetOptionsFromString( $args, %{$args_for_source} );
  0         0  
432             }
433 74 50       39096 if ( !$ret ) {
434 0 0       0 if ( !$is_help_types_active ) {
435 0 0       0 my $where = $source_name eq 'ARGV' ? 'on command line' : "in $source_name";
436 0         0 App::Ack::die( "Invalid option $where" );
437             }
438             }
439 74 50       638 if ( $opt->{noenv_seen} ) {
440 0         0 App::Ack::die( "--noenv found in $source_name" );
441             }
442             }
443              
444             # XXX We need to check on a -- in the middle of a non-ARGV source
445              
446 74         2633 return;
447             }
448              
449              
450             sub _explode_sources {
451 0     0   0 my ( $sources ) = @_;
452              
453 0         0 my @new_sources;
454              
455             my %opt;
456 0         0 my $arg_spec = get_arg_spec( \%opt, {} );
457              
458 0     0   0 my $dummy_sub = sub {};
459             my $add_type = sub {
460 0     0   0 my ( undef, $arg ) = @_;
461              
462 0 0       0 if ( $arg =~ /(\w+)=/) {
463 0         0 $arg_spec->{$1} = $dummy_sub;
464             }
465             else {
466 0         0 ( $arg ) = split /:/, $arg;
467 0         0 $arg_spec->{$arg} = $dummy_sub;
468             }
469 0         0 };
470              
471             my $del_type = sub {
472 0     0   0 my ( undef, $arg ) = @_;
473              
474 0         0 delete $arg_spec->{$arg};
475 0         0 };
476              
477 0         0 configure_parser( 'pass_through' );
478 0         0 foreach my $source (@{$sources}) {
  0         0  
479 0         0 my ( $name, $options ) = @{$source}{qw/name contents/};
  0         0  
480 0 0       0 if ( ref($options) ne 'ARRAY' ) {
481 0         0 $source->{contents} = $options =
482             [ Text::ParseWords::shellwords($options) ];
483             }
484              
485 0         0 for my $j ( 0 .. @{$options}-1 ) {
  0         0  
486 0 0       0 next unless $options->[$j] =~ /^-/;
487 0         0 my @chunk = ( $options->[$j] );
488 0   0     0 push @chunk, $options->[$j] while ++$j < @{$options} && $options->[$j] !~ /^-/;
  0         0  
489 0         0 $j--;
490              
491 0         0 my @copy = @chunk;
492             Getopt::Long::GetOptionsFromArray( [@chunk],
493             'type-add=s' => $add_type,
494             'type-set=s' => $add_type,
495             'type-del=s' => $del_type,
496 0         0 %{$arg_spec}
  0         0  
497             );
498              
499 0         0 push @new_sources, {
500             name => $name,
501             contents => \@copy,
502             };
503             }
504             }
505              
506 0         0 return \@new_sources;
507             }
508              
509              
510             sub _compare_opts {
511 0     0   0 my ( $a, $b ) = @_;
512              
513 0         0 my $first_a = $a->[0];
514 0         0 my $first_b = $b->[0];
515              
516 0         0 $first_a =~ s/^--?//;
517 0         0 $first_b =~ s/^--?//;
518              
519 0         0 return $first_a cmp $first_b;
520             }
521              
522              
523             sub _dump_options {
524 0     0   0 my ( $sources ) = @_;
525              
526 0         0 $sources = _explode_sources($sources);
527              
528 0         0 my %opts_by_source;
529             my @source_names;
530              
531 0         0 foreach my $source (@{$sources}) {
  0         0  
532 0         0 my $name = $source->{name};
533 0 0       0 if ( not $opts_by_source{$name} ) {
534 0         0 $opts_by_source{$name} = [];
535 0         0 push @source_names, $name;
536             }
537 0         0 push @{$opts_by_source{$name}}, $source->{contents};
  0         0  
538             }
539              
540 0         0 foreach my $name (@source_names) {
541 0         0 my $contents = $opts_by_source{$name};
542              
543 0         0 say $name;
544 0         0 say '=' x length($name);
545 0         0 say ' ', join(' ', @{$_}) for sort { _compare_opts($a, $b) } @{$contents};
  0         0  
  0         0  
  0         0  
546             }
547              
548 0         0 return;
549             }
550              
551              
552             sub _remove_default_options_if_needed {
553 74     74   148 my ( $sources ) = @_;
554              
555 74         113 my $default_index;
556              
557 74         113 foreach my $index ( 0 .. $#{$sources} ) {
  74         221  
558 74 50       241 if ( $sources->[$index]{'name'} eq 'Defaults' ) {
559 0         0 $default_index = $index;
560 0         0 last;
561             }
562             }
563              
564 74 50       220 return $sources unless defined $default_index;
565              
566 0         0 my $should_remove = 0;
567              
568 0         0 configure_parser( 'no_auto_abbrev', 'pass_through' );
569              
570 0         0 foreach my $index ( $default_index + 1 .. $#{$sources} ) {
  0         0  
571 0         0 my $args = $sources->[$index]->{contents};
572              
573 0 0       0 if (ref($args)) {
574 0         0 Getopt::Long::GetOptionsFromArray( $args,
575             'ignore-ack-defaults' => \$should_remove,
576             );
577             }
578             else {
579 0         0 ( undef, $sources->[$index]{contents} ) = Getopt::Long::GetOptionsFromString( $args,
580             'ignore-ack-defaults' => \$should_remove,
581             );
582             }
583             }
584              
585 0 0       0 return $sources unless $should_remove;
586              
587 0         0 my @copy = @{$sources};
  0         0  
588 0         0 splice @copy, $default_index, 1;
589 0         0 return \@copy;
590             }
591              
592              
593             sub process_args {
594 74     74 0 369852 my $arg_sources = \@_;
595              
596             my %opt = (
597             pager => $ENV{ACK_PAGER_COLOR} || $ENV{ACK_PAGER},
598 74   100     457 );
599              
600 74         215 $arg_sources = _remove_default_options_if_needed($arg_sources);
601              
602             # Check for --dump early.
603 74         120 foreach my $source (@{$arg_sources}) {
  74         141  
604 74 50       181 if ( $source->{name} eq 'ARGV' ) {
605 74         103 my $dump;
606 74         201 configure_parser( 'pass_through' );
607             Getopt::Long::GetOptionsFromArray( $source->{contents},
608 74         288 'dump' => \$dump,
609             );
610 74 50       12572 if ( $dump ) {
611 0         0 _dump_options($arg_sources);
612 0         0 exit(0);
613             }
614             }
615             }
616              
617 74         247 my $type_specs = _process_filetypes(\%opt, $arg_sources);
618              
619 74         263 _check_for_mutex_options( $type_specs );
620              
621 74         244 _process_other(\%opt, $type_specs, $arg_sources);
622 74         142 while ( @{$arg_sources} ) {
  148         354  
623 74         119 my $source = shift @{$arg_sources};
  74         134  
624 74         138 my $args = $source->{contents};
625              
626             # All of our sources should be transformed into an array ref
627 74 50       169 if ( ref($args) ) {
628 74         137 my $source_name = $source->{name};
629 74 50       160 if ( $source_name eq 'ARGV' ) {
    0          
630 74         105 @ARGV = @{$args};
  74         194  
631             }
632 0         0 elsif (@{$args}) {
633 0         0 App::Ack::die( "Source '$source_name' has extra arguments!" );
634             }
635             }
636             else {
637 0         0 App::Ack::die( 'The impossible has occurred!' );
638             }
639             }
640 74   50     346 my $filters = ($opt{filters} ||= []);
641              
642             # Throw the default filter in if no others are selected.
643 74 50       139 if ( not grep { !$_->is_inverted() } @{$filters} ) {
  0         0  
  74         178  
644 74         103 push @{$filters}, App::Ack::Filter::Default->new();
  74         346  
645             }
646 74         470 return \%opt;
647             }
648              
649              
650             sub retrieve_arg_sources {
651 4     4 0 14361 my @arg_sources;
652              
653             my $noenv;
654 4         0 my $ackrc;
655              
656 4         15 configure_parser( 'no_auto_abbrev', 'pass_through' );
657 4         19 Getopt::Long::GetOptions(
658             'noenv' => \$noenv,
659             'ackrc=s' => \$ackrc,
660             );
661              
662 4         1504 my @files;
663              
664 4 100       16 if ( !$noenv ) {
665 2         21 my $finder = App::Ack::ConfigFinder->new;
666 2         9 @files = $finder->find_config_files;
667             }
668 4 50       13 if ( $ackrc ) {
669             # We explicitly use open so we get a nice error message.
670             # XXX This is a potential race condition!.
671 0 0       0 if ( open my $fh, '<', $ackrc ) {
672 0         0 close $fh;
673             }
674             else {
675 0         0 App::Ack::die( "Unable to load ackrc '$ackrc': $!" );
676             }
677 0         0 push( @files, { path => $ackrc } );
678             }
679              
680 4         17 push @arg_sources, {
681             name => 'Defaults',
682             contents => [ App::Ack::ConfigDefault::options_clean() ],
683             };
684              
685 4         110 foreach my $file ( @files) {
686 4         14 my @lines = read_rcfile($file->{path});
687 4 100       16 if ( @lines ) {
688             push @arg_sources, {
689             name => $file->{path},
690             contents => \@lines,
691             project => $file->{project},
692 2         15 is_ackrc => 1,
693             };
694             }
695             }
696              
697 4         18 push @arg_sources, {
698             name => 'ARGV',
699             contents => [ @ARGV ],
700             };
701              
702 4         22 return @arg_sources;
703             }
704              
705              
706             sub read_rcfile {
707 4     4 0 9 my $file = shift;
708              
709 4 100 66     62 return unless defined $file && -e $file;
710              
711 2         7 my @lines;
712              
713 2 50       82 open( my $fh, '<', $file ) or App::Ack::die( "Unable to read $file: $!" );
714 2         88 while ( defined( my $line = <$fh> ) ) {
715 2         7 chomp $line;
716 2         9 $line =~ s/^\s+//;
717 2         8 $line =~ s/\s+$//;
718              
719 2 50       7 next if $line eq '';
720 2 50       7 next if $line =~ /^\s*#/;
721              
722 2         26 push( @lines, $line );
723             }
724 2 50       59 close $fh or App::Ack::die( "Unable to close $file: $!" );
725              
726 2         16 return @lines;
727             }
728              
729              
730             # Verifies no mutex options were passed. Dies if they were.
731             sub _check_for_mutex_options {
732 74     74   121 my $type_specs = shift;
733              
734 74         171 my $mutex = mutex_options();
735              
736 74         190 my ($raw,$used) = _options_used( $type_specs );
737              
738 74         239 my @used = sort { lc $a cmp lc $b } keys %{$used};
  0         0  
  74         286  
739              
740 74         191 for my $i ( @used ) {
741 0         0 for my $j ( @used ) {
742 0 0       0 next if $i eq $j;
743 0 0       0 if ( $mutex->{$i}{$j} ) {
744 0         0 my $x = $raw->[ $used->{$i} ];
745 0         0 my $y = $raw->[ $used->{$j} ];
746 0         0 App::Ack::die( "Options '$x' and '$y' can't be used together." );
747             }
748             }
749             }
750              
751 74         1568 return;
752             }
753              
754              
755             # Processes the command line option and returns a hash of the options that were
756             # used on the command line, using their full name. "--prox" shows up in the hash as "--proximate".
757             sub _options_used {
758 74     74   119 my $type_specs = shift;
759              
760 74         121 my %dummy_opt;
761 74         152 my $real_spec = get_arg_spec( \%dummy_opt, $type_specs );
762              
763             # The real argument parsing doesn't check for --type-add, --type-del or --type-set because
764             # they get removed by the argument processing. We have to account for them here.
765 74     0   262 my $sub_dummy = sub {};
766             $real_spec = {
767 74         126 %{$real_spec},
  74         1472  
768             'type-add=s' => $sub_dummy,
769             'type-del=s' => $sub_dummy,
770             'type-set=s' => $sub_dummy,
771             'ignore-ack-defaults' => $sub_dummy,
772             };
773              
774 74         701 my %parsed;
775             my @raw;
776 74         0 my %spec_capture_parsed;
777 74         0 my %spec_capture_raw;
778              
779             =pod
780              
781             We have to build two argument specs.
782              
783             To populate the C<%parsed> hash: Capture the arguments that the user has
784             passed in, as parsed by the Getopt::Long::GetOptions function. Aliases are converted
785             down to their short options. If a user passes "--proximate", Getopt::Long
786             converts that to "-p" and we store it as "-p".
787              
788             To populate the C<@raw> array: Capture the arguments raw, without having
789             been converted to their short options. If a user passes "--proximate",
790             we store it in C<@raw> as "--proximate".
791              
792             =cut
793              
794             # Capture the %parsed hash.
795             CAPTURE_PARSED: {
796 74         112 my $parsed_pos = 0;
  74         122  
797             my $sub_count = sub {
798 0     0   0 my $arg = shift;
799 0         0 $arg = "$arg";
800 0         0 $parsed{$arg} = $parsed_pos++;
801 74         233 };
802             %spec_capture_parsed = (
803 0     0   0 '<>' => sub { $parsed_pos++ }, # Bump forward one pos for non-options.
804 74         205 map { $_ => $sub_count } keys %{$real_spec}
  5032         7665  
  74         606  
805             );
806             }
807              
808             # Capture the @raw array.
809             CAPTURE_RAW: {
810 74         495 my $raw_pos = 0;
  74         109  
811             %spec_capture_raw = (
812 0     0   0 '<>' => sub { $raw_pos++ }, # Bump forward one pos for non-options.
813 74         280 );
814              
815             my $sub_count = sub {
816 0     0   0 my $arg = shift;
817              
818 0         0 $arg = "$arg";
819 0 0       0 $raw[$raw_pos] = length($arg) == 1 ? "-$arg" : "--$arg";
820 0         0 $raw_pos++;
821 74         240 };
822              
823 74         127 for my $opt_spec ( keys %{$real_spec} ) {
  74         559  
824 5032         9452 my $negatable;
825             my $type;
826 5032         0 my $default;
827              
828 5032         9260 $negatable = ($opt_spec =~ s/!$//);
829              
830 5032 100       10951 if ( $opt_spec =~ s/(=[si])$// ) {
831 1406         2372 $type = $1;
832             }
833 5032 100       9427 if ( $opt_spec =~ s/(:.+)$// ) {
834 370         680 $default = $1;
835             }
836              
837 5032         9105 my @aliases = split( /\|/, $opt_spec );
838 5032         7279 for my $alias ( @aliases ) {
839 6808 100       10919 $alias .= $type if defined $type;
840 6808 100       10272 $alias .= $default if defined $default;
841 6808 100       10398 $alias .= '!' if $negatable;
842              
843 6808         12769 $spec_capture_raw{$alias} = $sub_count;
844             }
845             }
846             }
847              
848             # Parse @ARGV twice, once with each capture spec.
849 74         493 configure_parser( 'pass_through' ); # Ignore invalid options.
850 74         997 Getopt::Long::GetOptionsFromArray( [@ARGV], %spec_capture_raw );
851 74         360308 Getopt::Long::GetOptionsFromArray( [@ARGV], %spec_capture_parsed );
852              
853 74         281080 return (\@raw,\%parsed);
854             }
855              
856              
857             sub mutex_options {
858             # This list is machine-generated by dev/crank-mutex. Do not modify it by hand.
859              
860             return {
861 74     74 0 5395 1 => {
862             m => 1,
863             passthru => 1,
864             },
865             A => {
866             L => 1,
867             c => 1,
868             f => 1,
869             g => 1,
870             l => 1,
871             o => 1,
872             output => 1,
873             p => 1,
874             passthru => 1,
875             },
876             B => {
877             L => 1,
878             c => 1,
879             f => 1,
880             g => 1,
881             l => 1,
882             o => 1,
883             output => 1,
884             p => 1,
885             passthru => 1,
886             },
887             C => {
888             L => 1,
889             c => 1,
890             f => 1,
891             g => 1,
892             l => 1,
893             o => 1,
894             output => 1,
895             p => 1,
896             passthru => 1,
897             },
898             H => {
899             L => 1,
900             f => 1,
901             g => 1,
902             l => 1,
903             },
904             I => {
905             f => 1,
906             },
907             L => {
908             A => 1,
909             B => 1,
910             C => 1,
911             H => 1,
912             L => 1,
913             break => 1,
914             c => 1,
915             column => 1,
916             f => 1,
917             g => 1,
918             group => 1,
919             h => 1,
920             heading => 1,
921             l => 1,
922             'no-filename' => 1,
923             o => 1,
924             output => 1,
925             p => 1,
926             passthru => 1,
927             'show-types' => 1,
928             v => 1,
929             'with-filename' => 1,
930             },
931             break => {
932             L => 1,
933             c => 1,
934             f => 1,
935             g => 1,
936             l => 1,
937             },
938             c => {
939             A => 1,
940             B => 1,
941             C => 1,
942             L => 1,
943             break => 1,
944             column => 1,
945             f => 1,
946             g => 1,
947             group => 1,
948             heading => 1,
949             m => 1,
950             o => 1,
951             output => 1,
952             p => 1,
953             passthru => 1,
954             },
955             column => {
956             L => 1,
957             c => 1,
958             f => 1,
959             g => 1,
960             l => 1,
961             o => 1,
962             output => 1,
963             passthru => 1,
964             v => 1,
965             },
966             f => {
967             A => 1,
968             B => 1,
969             C => 1,
970             H => 1,
971             I => 1,
972             L => 1,
973             break => 1,
974             c => 1,
975             column => 1,
976             f => 1,
977             'files-from' => 1,
978             g => 1,
979             group => 1,
980             h => 1,
981             heading => 1,
982             i => 1,
983             l => 1,
984             m => 1,
985             match => 1,
986             o => 1,
987             output => 1,
988             p => 1,
989             passthru => 1,
990             'smart-case' => 1,
991             u => 1,
992             v => 1,
993             x => 1,
994             },
995             'files-from' => {
996             f => 1,
997             g => 1,
998             x => 1,
999             },
1000             g => {
1001             A => 1,
1002             B => 1,
1003             C => 1,
1004             H => 1,
1005             L => 1,
1006             break => 1,
1007             c => 1,
1008             column => 1,
1009             f => 1,
1010             'files-from' => 1,
1011             g => 1,
1012             group => 1,
1013             h => 1,
1014             heading => 1,
1015             l => 1,
1016             m => 1,
1017             match => 1,
1018             not => 1,
1019             o => 1,
1020             output => 1,
1021             p => 1,
1022             passthru => 1,
1023             u => 1,
1024             x => 1,
1025             },
1026             group => {
1027             L => 1,
1028             c => 1,
1029             f => 1,
1030             g => 1,
1031             l => 1,
1032             },
1033             h => {
1034             L => 1,
1035             f => 1,
1036             g => 1,
1037             l => 1,
1038             },
1039             heading => {
1040             L => 1,
1041             c => 1,
1042             f => 1,
1043             g => 1,
1044             l => 1,
1045             },
1046             i => {
1047             f => 1,
1048             },
1049             l => {
1050             A => 1,
1051             B => 1,
1052             C => 1,
1053             H => 1,
1054             L => 1,
1055             break => 1,
1056             column => 1,
1057             f => 1,
1058             g => 1,
1059             group => 1,
1060             h => 1,
1061             heading => 1,
1062             l => 1,
1063             'no-filename' => 1,
1064             o => 1,
1065             output => 1,
1066             p => 1,
1067             passthru => 1,
1068             'show-types' => 1,
1069             'with-filename' => 1,
1070             },
1071             m => {
1072             1 => 1,
1073             c => 1,
1074             f => 1,
1075             g => 1,
1076             passthru => 1,
1077             },
1078             match => {
1079             f => 1,
1080             g => 1,
1081             },
1082             'no-filename' => {
1083             L => 1,
1084             l => 1,
1085             },
1086             not => {
1087             g => 1,
1088             },
1089             o => {
1090             A => 1,
1091             B => 1,
1092             C => 1,
1093             L => 1,
1094             c => 1,
1095             column => 1,
1096             f => 1,
1097             g => 1,
1098             l => 1,
1099             o => 1,
1100             output => 1,
1101             p => 1,
1102             passthru => 1,
1103             'show-types' => 1,
1104             v => 1,
1105             },
1106             output => {
1107             A => 1,
1108             B => 1,
1109             C => 1,
1110             L => 1,
1111             c => 1,
1112             column => 1,
1113             f => 1,
1114             g => 1,
1115             l => 1,
1116             o => 1,
1117             output => 1,
1118             p => 1,
1119             passthru => 1,
1120             'show-types' => 1,
1121             u => 1,
1122             v => 1,
1123             },
1124             p => {
1125             A => 1,
1126             B => 1,
1127             C => 1,
1128             L => 1,
1129             c => 1,
1130             f => 1,
1131             g => 1,
1132             l => 1,
1133             o => 1,
1134             output => 1,
1135             p => 1,
1136             passthru => 1,
1137             },
1138             passthru => {
1139             1 => 1,
1140             A => 1,
1141             B => 1,
1142             C => 1,
1143             L => 1,
1144             c => 1,
1145             column => 1,
1146             f => 1,
1147             g => 1,
1148             l => 1,
1149             m => 1,
1150             o => 1,
1151             output => 1,
1152             p => 1,
1153             v => 1,
1154             },
1155             'show-types' => {
1156             L => 1,
1157             l => 1,
1158             o => 1,
1159             output => 1,
1160             },
1161             'smart-case' => {
1162             f => 1,
1163             },
1164             u => {
1165             f => 1,
1166             g => 1,
1167             output => 1,
1168             },
1169             v => {
1170             L => 1,
1171             column => 1,
1172             f => 1,
1173             o => 1,
1174             output => 1,
1175             passthru => 1,
1176             },
1177             'with-filename' => {
1178             L => 1,
1179             l => 1,
1180             },
1181             x => {
1182             f => 1,
1183             'files-from' => 1,
1184             g => 1,
1185             },
1186             };
1187              
1188             } # End of mutex_options()
1189              
1190              
1191             1; # End of App::Ack::ConfigLoader