File Coverage

blib/lib/App/Ack/ConfigLoader.pm
Criterion Covered Total %
statement 41 456 8.9
branch 0 122 0.0
condition 0 28 0.0
subroutine 14 72 19.4
pod 0 6 0.0
total 55 684 8.0


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