File Coverage

blib/lib/Git/Reduce/Tests/Opts.pm
Criterion Covered Total %
statement 47 51 92.1
branch 21 24 87.5
condition 14 16 87.5
subroutine 8 8 100.0
pod 0 1 0.0
total 90 100 90.0


line stmt bran cond sub pod time code
1             package Git::Reduce::Tests::Opts;
2 1     1   20978 use strict;
  1         2  
  1         34  
3 1     1   4 use warnings;
  1         1  
  1         26  
4 1     1   4 use base qw( Exporter );
  1         4  
  1         93  
5             our @EXPORT_OK = qw(
6             process_options
7             );
8 1     1   5 use Carp;
  1         1  
  1         77  
9 1     1   4 use Cwd;
  1         1  
  1         55  
10 1     1   16761 use Data::Dumper;
  1         8476  
  1         90  
11 1     1   757 use Getopt::Long;
  1         9333  
  1         6  
12              
13             sub process_options {
14 15 100   15 0 16617 croak "Must provide even list of key-value pairs to process_options()"
15             unless (@_ % 2 == 0);
16 14         40 my %args = @_;
17 14 50       40 if ($args{verbose}) {
18 0         0 print "Arguments provided to process_options():\n";
19 0         0 print Dumper \%args;
20             }
21              
22 14         24444 my %defaults = (
23             'dir' => cwd(),
24             'branch' => 'master',
25             'prefix' => 'reduced_',
26             'remote' => 'origin',
27             'no_delete' => 0,
28             'include' => '',
29             'exclude' => '',
30             'verbose' => 0,
31             'no_push' => 0,
32             'test_extension' => 't',
33             );
34            
35 14         70 my %opts;
36 14 50 50     276 GetOptions(
      50        
37             "dir=s" => \$opts{dir},
38             "branch=s" => \$opts{branch},
39             "prefix=s" => \$opts{prefix} || '',
40             "suffix=s" => \$opts{suffix} || '',
41             "remote=s" => \$opts{remote},
42             "no-delete" => \$opts{no_delete}, # flag
43             "no_delete" => \$opts{no_delete}, # flag
44             "include=s" => \$opts{include},
45             "exclude=s" => \$opts{exclude},
46             "verbose" => \$opts{verbose}, # flag
47             "no-push" => \$opts{no_push}, # flag
48             "no_push" => \$opts{no_push}, # flag
49             "test-extension=s" => \$opts{test_extension},
50             "test_extension=s" => \$opts{test_extension},
51             ) or croak("Error in command line arguments\n");
52 14 50       11353 if ($opts{verbose}) {
53 0         0 print "Command-line arguments:\n";
54 0         0 print Dumper \%opts;
55             }
56 14 100 100     211 croak("Only one of '--prefix' or '--suffix' may be supplied")
57             if ( (length($opts{prefix})) and (length($opts{suffix})) );
58              
59             # Final selection of params starts with defaults.
60 13         47 my %params = map { $_ => $defaults{$_} } keys %defaults;
  130         212  
61              
62             # Override with command-line arguments.
63             # If --suffix is supplied on command-line, any --prefix already present is
64             # deleted.
65 13         70 for my $o (keys %opts) {
66 143 100       229 if (defined $opts{$o}) {
67 17 100       22 if ($o eq 'suffix') {
68 1         5 delete $params{prefix};
69             }
70 17         31 $params{$o} = $opts{$o};
71             }
72             }
73             # Arguments provided directly to process_options() supersede command-line
74             # arguments. (Mainly used in testing of this module.)
75             # Again, if 'suffix' is supplied in @_, any 'prefix' already present is
76             # deleted.
77 13 100 100     233 croak("Only one of 'prefix' or 'suffix' may be supplied")
78             if ( (length($args{prefix})) and (length($args{suffix})) );
79 12         28 for my $o (keys %args) {
80 13 100       27 if ($o eq 'suffix') {
81 1         4 delete $params{prefix};
82             }
83 13         29 $params{$o} = $args{$o};
84             }
85            
86 12 100       985 croak("Could not locate directory $params{dir}")
87             unless (-d $params{dir});
88 10 100 100     68 if ($params{include} and $params{exclude}) {
89 1         270 croak("'include' and 'exclude' options are mutually exclusive; choose one or the other");
90             }
91 9 100 100     33 if ( ! ($params{include} or $params{exclude}) ) {
92 1         220 croak("Must populate one of 'include' or 'exclude' with test files");
93             }
94 8         64 return \%params;
95             }
96              
97             =head1 NAME
98              
99             Git::Reduce::Tests::Opts - Prepare parameters for Git::Reduce::Tests
100              
101             =head1 SYNOPSIS
102              
103             use Git::Reduce::Tests::Opts qw( process_options );
104              
105             my $params = process_options( 'include' => 't/001-load.t' );
106              
107             =head1 DESCRIPTION
108              
109             This package exports on demand only one subroutine, C, used
110             to prepare parameters for Git::Reduce::Tests.
111              
112             The subroutine takes as arguments an optional list of key-value pairs. This
113             approach is useful in testing the subroutine but is not expected to be used
114             otherwise. The subroutine is a wrapper around Getopt::Long::GetOptions(), so
115             is devoted to processing command-line arguments provided, for example, to the
116             command-line utility F included in this CPAN distribution.
117              
118             Whether the subroutine is populated directly or via command-line arguments,
119             one, but not both, of the C or C options must be populated
120             with the name of a test file to be included in, or excluded from, the reduced
121             branch.
122              
123             The subroutine returns a reference to a hash populated with values in the
124             following order:
125              
126             =over 4
127              
128             =item 1 Default values hard-coded within the subroutine.
129              
130             =item 2 Command-line options.
131              
132             =item 3 Key-value pairs provided as arguments to the function.
133              
134             =back
135              
136             =cut
137              
138             1;