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
|
|
|
|
|
|
|
|