line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/env perl |
2
|
|
|
|
|
|
|
package Gentoo::App::Pram; |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
our $VERSION = '0.100200'; |
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
569
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
31
|
|
7
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
20
|
|
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
526
|
use Term::ANSIColor qw/colored/; |
|
1
|
|
|
|
|
7078
|
|
|
1
|
|
|
|
|
627
|
|
10
|
1
|
|
|
1
|
|
7
|
use File::Basename qw/basename/; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
45
|
|
11
|
1
|
|
|
1
|
|
446
|
use File::Which qw/which/; |
|
1
|
|
|
|
|
922
|
|
|
1
|
|
|
|
|
46
|
|
12
|
1
|
|
|
1
|
|
517
|
use Encode qw/decode/; |
|
1
|
|
|
|
|
8880
|
|
|
1
|
|
|
|
|
66
|
|
13
|
1
|
|
|
1
|
|
680
|
use File::Temp; |
|
1
|
|
|
|
|
14594
|
|
|
1
|
|
|
|
|
58
|
|
14
|
1
|
|
|
1
|
|
595
|
use HTTP::Tiny; |
|
1
|
|
|
|
|
34836
|
|
|
1
|
|
|
|
|
64
|
|
15
|
|
|
|
|
|
|
|
16
|
1
|
|
|
1
|
|
7
|
use constant E_ERROR => colored('ERROR', 'red'); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
28
|
|
17
|
1
|
|
|
1
|
|
127
|
use constant E_NO => colored('NO', 'red'); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
4
|
|
18
|
1
|
|
|
1
|
|
69
|
use constant E_YES => colored('YES', 'green'); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
5
|
|
19
|
1
|
|
|
1
|
|
82
|
use constant E_OK => colored('OK', 'green'); |
|
1
|
|
|
|
|
11
|
|
|
1
|
|
|
|
|
3
|
|
20
|
1
|
|
|
1
|
|
67
|
use constant E_MERGE => colored('MERGE', 'blue'); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2
|
|
21
|
|
|
|
|
|
|
|
22
|
1
|
|
|
1
|
|
80
|
use constant CLOSES_GITHUB => qr#\ACloses: https?://github\.com#; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
35
|
|
23
|
|
|
|
|
|
|
|
24
|
1
|
|
|
1
|
|
630
|
use Getopt::Long; |
|
1
|
|
|
|
|
8671
|
|
|
1
|
|
|
|
|
4
|
|
25
|
1
|
|
|
1
|
|
555
|
use Pod::Usage; |
|
1
|
|
|
|
|
32957
|
|
|
1
|
|
|
|
|
1248
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub new { |
28
|
0
|
|
|
0
|
0
|
|
my ($class, @args) = @_; |
29
|
0
|
0
|
|
|
|
|
return bless { ref $args[0] ? %{ $args[0] } : @args }, $class; |
|
0
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub new_with_opts { |
33
|
0
|
|
|
0
|
0
|
|
my ($class) = @_; |
34
|
0
|
|
|
|
|
|
my @opts = ( |
35
|
|
|
|
|
|
|
'repository|r=s', |
36
|
|
|
|
|
|
|
'closes|c=s', |
37
|
|
|
|
|
|
|
'editor|e=s', |
38
|
|
|
|
|
|
|
'signoff|s', |
39
|
|
|
|
|
|
|
'bug|b=s', |
40
|
|
|
|
|
|
|
'help|h', |
41
|
|
|
|
|
|
|
'man|m' |
42
|
|
|
|
|
|
|
); |
43
|
0
|
|
|
|
|
|
my %opts; |
44
|
0
|
0
|
|
|
|
|
if (!GetOptions(\%opts, @opts)) { |
45
|
0
|
|
|
|
|
|
print "\n"; |
46
|
0
|
|
|
|
|
|
pod2usage(-verbose => 1) |
47
|
|
|
|
|
|
|
} |
48
|
0
|
|
|
|
|
|
$opts{pr_number} = shift @ARGV; |
49
|
0
|
|
|
|
|
|
return $class->new(\%opts); |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub run { |
53
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
54
|
|
|
|
|
|
|
|
55
|
0
|
|
|
|
|
|
my $pr_number = $self->{pr_number}; |
56
|
0
|
|
|
|
|
|
my $closes = $self->{closes}; |
57
|
0
|
|
|
|
|
|
my $bug = $self->{bug}; |
58
|
|
|
|
|
|
|
|
59
|
0
|
|
|
|
|
|
$| = 1; |
60
|
|
|
|
|
|
|
|
61
|
0
|
0
|
|
|
|
|
$self->{help} and pod2usage(-verbose => 1); |
62
|
0
|
0
|
|
|
|
|
$self->{man} and pod2usage(-verbose => 2); |
63
|
|
|
|
|
|
|
|
64
|
0
|
0
|
0
|
|
|
|
$bug and $closes and pod2usage( |
65
|
|
|
|
|
|
|
-message => E_ERROR . qq#! --bug and --closes options are mutually exclusive!\n#, |
66
|
|
|
|
|
|
|
-verbose => 1 |
67
|
|
|
|
|
|
|
); |
68
|
|
|
|
|
|
|
|
69
|
0
|
|
|
|
|
|
run_checks($pr_number, "You must specify a Pull Request number!"); |
70
|
0
|
0
|
|
|
|
|
$bug and run_checks($bug, "You must specify a bug number when using --bug!"); |
71
|
0
|
0
|
|
|
|
|
$closes and run_checks($closes, "You must specify a bug number when using --closes!"); |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# Defaults to 'gentoo/gentoo' because we're worth it. |
74
|
0
|
|
0
|
|
|
|
my $repo_name = $self->{repository} || 'gentoo/gentoo'; |
75
|
0
|
|
0
|
|
|
|
my $editor = $self->{editor} || $ENV{EDITOR} || 'less'; |
76
|
|
|
|
|
|
|
|
77
|
0
|
|
|
|
|
|
my $git_command = which('git') . ' am --keep-cr -S'; |
78
|
0
|
0
|
|
|
|
|
$self->{signoff} and $git_command = "$git_command -s"; |
79
|
|
|
|
|
|
|
|
80
|
0
|
|
|
|
|
|
my $patch_url = "https://patch-diff.githubusercontent.com/raw/$repo_name/pull/$pr_number.patch"; |
81
|
0
|
|
|
|
|
|
$self->{pr_url} = "https://github.com/$repo_name/pull/$pr_number"; |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# Go! |
84
|
0
|
|
|
|
|
|
$self->apply_patch( |
85
|
|
|
|
|
|
|
$editor, |
86
|
|
|
|
|
|
|
$git_command, |
87
|
|
|
|
|
|
|
$self->modify_patch( |
88
|
|
|
|
|
|
|
$self->fetch_patch($patch_url) |
89
|
|
|
|
|
|
|
) |
90
|
|
|
|
|
|
|
); |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub run_checks { |
94
|
0
|
0
|
|
0
|
0
|
|
@_ == 2 || die qq#Usage: run_checks(obj, error_msg)#; |
95
|
0
|
|
|
|
|
|
my ($obj, $error_msg) = @_; |
96
|
|
|
|
|
|
|
|
97
|
0
|
0
|
|
|
|
|
$obj || pod2usage( |
98
|
|
|
|
|
|
|
-message => E_ERROR . qq#! $error_msg\n#, |
99
|
|
|
|
|
|
|
-verbose => 1 |
100
|
|
|
|
|
|
|
); |
101
|
|
|
|
|
|
|
|
102
|
0
|
0
|
|
|
|
|
$obj =~ /^\d+$/ || pod2usage( |
103
|
|
|
|
|
|
|
-message => E_ERROR . qq#! "$obj" is NOT a number!\n#, |
104
|
|
|
|
|
|
|
-verbose => 1 |
105
|
|
|
|
|
|
|
); |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub my_sleep { |
109
|
0
|
|
|
0
|
0
|
|
select(undef, undef, undef, 0.50); |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub fetch_patch { |
113
|
0
|
0
|
|
0
|
1
|
|
@_ == 2 || die qq#Usage: fetch_patch(patch_url)\n#; |
114
|
0
|
|
|
|
|
|
my ($self, $patch_url) = @_; |
115
|
|
|
|
|
|
|
|
116
|
0
|
|
|
|
|
|
print "Fetching $patch_url ... "; |
117
|
|
|
|
|
|
|
|
118
|
0
|
|
|
|
|
|
my $response = HTTP::Tiny->new->get($patch_url); |
119
|
0
|
|
|
|
|
|
my $status = $response->{status}; |
120
|
|
|
|
|
|
|
|
121
|
0
|
0
|
|
|
|
|
$status != 200 and die "\n" . E_ERROR . qq#! Unreachable URL! Got HTTP status $status!\n#; |
122
|
0
|
|
|
|
|
|
my $patch = $response->{content}; |
123
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
|
print E_OK . "!\n"; |
125
|
|
|
|
|
|
|
|
126
|
0
|
|
|
|
|
|
return decode('UTF-8', $patch); |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub add_header { |
130
|
0
|
0
|
|
0
|
0
|
|
@_ == 3 || die qq#Usage: add_header(patch, header, msg)\n#; |
131
|
0
|
|
|
|
|
|
my ($patch, $header, $msg) = @_; |
132
|
|
|
|
|
|
|
|
133
|
0
|
|
|
|
|
|
print qq#$msg#; |
134
|
0
|
|
|
|
|
|
my_sleep(); |
135
|
0
|
|
|
|
|
|
my $confirm = E_ERROR; |
136
|
0
|
|
|
|
|
|
my $is_sub = $patch =~ s#---#$header#; |
137
|
0
|
0
|
|
|
|
|
$is_sub and $confirm = E_OK; |
138
|
0
|
|
|
|
|
|
print "$confirm!\n"; |
139
|
0
|
|
|
|
|
|
my_sleep(); |
140
|
0
|
|
|
|
|
|
return $patch; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
sub modify_patch { |
144
|
0
|
0
|
|
0
|
1
|
|
@_ == 2 || die qq#Usage: modify_patch(patch)\n#; |
145
|
0
|
|
|
|
|
|
my ($self, $patch) = @_; |
146
|
|
|
|
|
|
|
|
147
|
0
|
0
|
|
|
|
|
if (not $patch =~ CLOSES_GITHUB) { |
148
|
0
|
|
|
|
|
|
my $pr_url = $self->{pr_url}; |
149
|
0
|
|
|
|
|
|
$patch = add_header( |
150
|
|
|
|
|
|
|
$patch, |
151
|
|
|
|
|
|
|
qq#Closes: $pr_url\n---#, |
152
|
|
|
|
|
|
|
qq#Adding Github "Closes:" header ... # |
153
|
|
|
|
|
|
|
); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
0
|
0
|
|
|
|
|
if ($self->{bug}) { |
157
|
0
|
|
|
|
|
|
my $bug = $self->{bug}; |
158
|
0
|
|
|
|
|
|
$patch = add_header( |
159
|
|
|
|
|
|
|
$patch, |
160
|
|
|
|
|
|
|
qq#Bug: https://bugs.gentoo.org/$bug\n---#, |
161
|
|
|
|
|
|
|
qq#Adding Gentoo "Bug:" header with bug $bug ... # |
162
|
|
|
|
|
|
|
); |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
0
|
0
|
|
|
|
|
if ($self->{closes}) { |
166
|
0
|
|
|
|
|
|
my $closes = $self->{closes}; |
167
|
0
|
|
|
|
|
|
$patch = add_header( |
168
|
|
|
|
|
|
|
$patch, |
169
|
|
|
|
|
|
|
qq#Closes: https://bugs.gentoo.org/$closes\n---#, |
170
|
|
|
|
|
|
|
qq#Adding Gentoo "Closes:" header with bug $closes ... # |
171
|
|
|
|
|
|
|
); |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
0
|
|
|
|
|
|
return $patch; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
sub apply_patch { |
178
|
0
|
0
|
|
0
|
1
|
|
@_ == 4 || die qq#Usage: apply_patch(editor, git_command, patch)\n#; |
179
|
0
|
|
|
|
|
|
my ($self, $editor, $git_command, $patch) = @_; |
180
|
|
|
|
|
|
|
|
181
|
0
|
|
|
|
|
|
my $patch_location = File::Temp->new() . '.patch'; |
182
|
0
|
|
0
|
|
|
|
open my $fh, '>:encoding(UTF-8)', $patch_location || die E_ERROR . qq#! Can't write to $patch_location: $!!\n#; |
183
|
0
|
|
|
|
|
|
print $fh $patch; |
184
|
0
|
|
|
|
|
|
close $fh; |
185
|
|
|
|
|
|
|
|
186
|
0
|
|
|
|
|
|
print "Opening $patch_location with $editor ... "; |
187
|
0
|
|
|
|
|
|
my_sleep(); |
188
|
0
|
|
|
|
|
|
my $exit = system $editor => $patch_location; |
189
|
0
|
0
|
|
|
|
|
$exit eq 0 || die E_ERROR . qq#! Could not open $patch_location: $!!\n#; |
190
|
0
|
|
|
|
|
|
print E_OK . "!\n"; |
191
|
|
|
|
|
|
|
|
192
|
0
|
|
|
|
|
|
print E_MERGE . "? Do you want to apply this patch and merge this PR? [y/n] "; |
193
|
|
|
|
|
|
|
|
194
|
0
|
|
|
|
|
|
chomp(my $answer = ); |
195
|
|
|
|
|
|
|
|
196
|
0
|
0
|
|
|
|
|
if ($answer =~ /^[Yy]$/) { |
197
|
0
|
|
|
|
|
|
$git_command = "$git_command $patch_location"; |
198
|
0
|
|
|
|
|
|
print E_YES . "!\n"; |
199
|
0
|
|
|
|
|
|
print "Launching '$git_command' ... \n"; |
200
|
0
|
|
|
|
|
|
$exit = system join ' ', $git_command; |
201
|
0
|
0
|
|
|
|
|
$exit eq 0 || die E_ERROR . qq#! Error when launching '$git_command': $!!\n#; |
202
|
0
|
|
|
|
|
|
print E_OK . "!\n"; |
203
|
|
|
|
|
|
|
} else { |
204
|
0
|
|
|
|
|
|
print E_NO . "!\nBailing out.\n"; |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
0
|
|
|
|
|
|
print "Removing $patch_location ... "; |
208
|
0
|
|
0
|
|
|
|
unlink $patch_location || die E_ERROR . qq#! Couldn't remove '$patch_location'!\n#; |
209
|
0
|
|
|
|
|
|
print E_OK . "!\n"; |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
1; |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
__END__ |