File Coverage

blib/lib/Devel/Git/MultiBisect/Opts.pm
Criterion Covered Total %
statement 62 62 100.0
branch 23 26 88.4
condition 5 6 83.3
subroutine 11 11 100.0
pod 0 1 0.0
total 101 106 95.2


line stmt bran cond sub pod time code
1             package Devel::Git::MultiBisect::Opts;
2 8     8   1873 use v5.14.0;
  8         24  
3 8     8   36 use warnings;
  8         12  
  8         369  
4             our $VERSION = '0.20';
5             $VERSION = eval $VERSION;
6 8     8   39 use base qw( Exporter );
  8         22  
  8         1056  
7             our @EXPORT_OK = qw(
8             process_options
9             );
10 8     8   52 use Carp;
  8         11  
  8         468  
11 8     8   41 use Config;
  8         12  
  8         282  
12 8     8   38 use Cwd;
  8         14  
  8         424  
13 8     8   634 use Data::Dumper;
  8         6467  
  8         400  
14 8     8   51 use File::Path qw( mkpath );
  8         28  
  8         442  
15 8     8   670 use File::Temp qw( tempdir );
  8         18486  
  8         385  
16 8     8   5188 use Getopt::Long;
  8         73539  
  8         31  
17              
18             =head1 NAME
19              
20             Devel::Git::MultiBisect::Opts - Prepare parameters for Devel::Git::MultiBisect
21              
22             =head1 SYNOPSIS
23              
24             use Devel::Git::MultiBisect::Opts qw( process_options );
25              
26             my $params = process_options();
27              
28             =head1 DESCRIPTION
29              
30             This package exports on demand only one subroutine, C, used
31             to prepare parameters for Devel::Git::MultiBisect.
32              
33             C takes as arguments an optional list of key-value pairs.
34             This approach is useful in testing the subroutine but is not expected to be
35             used otherwise.
36              
37             C is a wrapper around C. It
38             returns a reference to a hash populated with values in the following order:
39              
40             =over 4
41              
42             =item 1 Default values hard-coded within the subroutine.
43              
44             =item 2 Command-line options.
45              
46             =item 3 Key-value pairs provided as arguments to the function.
47              
48             =back
49              
50             =cut
51              
52             sub process_options {
53 10 100   10 0 18488 croak "Must provide even list of key-value pairs to process_options()"
54             unless (@_ % 2 == 0);
55 9         28 my %args = @_;
56 9 100       21 if (defined $args{targets}) {
57             croak "Value of 'targets' must be an array reference"
58 6 100       105 unless ref($args{targets}) eq 'ARRAY';
59             }
60 8         116 my $found_make = $Config{make};
61 8 100       29 if ($args{verbose}) {
62 1         45 say "Arguments provided to process_options():";
63 1         10 say Dumper \%args;
64 1         135 say "";
65 1         9 say q|For 'make', %Config has: |, $found_make;
66             }
67              
68 8         46 my %defaults = (
69             'short' => 7,
70             'repository' => 'origin',
71             'branch' => 'master',
72             'verbose' => 0,
73             'configure_command' => 'perl Makefile.PL 1>/dev/null',
74             'make_command' => "$found_make 1>/dev/null",
75             'test_command' => 'prove -vb',
76             'probe' => 'error',
77             );
78              
79 8         12 my %opts;
80             GetOptions(
81             "gitdir=s" => \$opts{gitdir},
82             "target=s@" => \$opts{targets},
83             "last_before=s" => \$opts{last_before},
84             "last-before=s" => \$opts{last_before},
85             "first=s" => \$opts{first},
86             "last=s" => \$opts{last},
87             "compiler=s" => \$opts{compiler},
88             "configure_command=s" => \$opts{configure_command},
89             "make_command=s" => \$opts{make_command},
90             "test_command=s" => \$opts{test_command},
91             "outputdir=s" => \$opts{outputdir},
92             "short=i" => \$opts{short},
93             "repository=s" => \$opts{repository},
94             "branch=s" => \$opts{branch},
95             "probe=s" => \$opts{probe},
96             "verbose" => \$opts{verbose}, # flag
97 8 50       61 ) or croak("Error in command line arguments\n");
98              
99 8 100       7559 if ($opts{verbose}) {
100 1         26 say "Command-line arguments:";
101 1         3 my %defined_opts;
102 1         6 for my $k (keys %opts) {
103 15 100       41 $defined_opts{$k} = $opts{$k} if defined $opts{$k};
104             }
105 1         11 say Dumper \%defined_opts;
106             }
107              
108             # Final selection of params starts with defaults.
109 8         104 my %params = map { $_ => $defaults{$_} } keys %defaults;
  64         120  
110              
111             # Override with command-line arguments.
112 8         34 for my $o (keys %opts) {
113 120 100       172 if (defined $opts{$o}) {
114 4         8 $params{$o} = $opts{$o};
115             }
116             }
117             # Arguments provided directly to process_options() supersede command-line
118             # arguments. (Mainly used in testing of this module.)
119 8         17 for my $o (keys %args) {
120 25         35 $params{$o} = $args{$o};
121             }
122              
123             # If user has not supplied a value for 'outputdir' by this point, then we
124             # have to use a tempdir.
125              
126 8 50       16 if (! exists $params{outputdir}) {
127 8 50       25 $params{outputdir} = tempdir
128             or croak "Unable to create tempdir";
129             }
130              
131             croak "Must define only one of 'last_before' and 'first'"
132 8 100 100     2477 if (defined $params{last_before} and defined $params{first});
133              
134             croak "Must define one of 'last_before' and 'first'"
135 7 100 66     98 unless (defined $params{last_before} or defined $params{first});
136              
137 6         11 for my $p ( qw|
138             short
139             repository
140             branch
141             configure_command
142             make_command
143             test_command
144             outputdir
145              
146             gitdir
147             last
148             | ) {
149 53 100       306 croak "Undefined parameter: $p" unless defined $params{$p};
150             }
151              
152 4         24 return \%params;
153             }
154              
155             1;
156