File Coverage

blib/lib/Gentoo/App/Pram.pm
Criterion Covered Total %
statement 48 141 34.0
branch 0 50 0.0
condition 0 11 0.0
subroutine 16 25 64.0
pod 3 9 33.3
total 67 236 28.3


line stmt bran cond sub pod time code
1             #!/usr/bin/env perl
2             package Gentoo::App::Pram;
3              
4             our $VERSION = '0.200000';
5              
6 1     1   609 use warnings;
  1         2  
  1         33  
7 1     1   5 use strict;
  1         1  
  1         23  
8              
9 1     1   579 use Term::ANSIColor qw/colored/;
  1         8096  
  1         773  
10 1     1   11 use File::Basename qw/basename/;
  1         2  
  1         54  
11 1     1   546 use File::Which qw/which/;
  1         1069  
  1         53  
12 1     1   544 use Encode qw/decode/;
  1         9932  
  1         105  
13 1     1   697 use File::Temp;
  1         16660  
  1         69  
14 1     1   682 use HTTP::Tiny;
  1         40311  
  1         1837  
15              
16 1     1   21 use constant E_ERROR => colored('ERROR', 'red');
  1         2  
  1         9  
17 1     1   202 use constant E_NO => colored('NO', 'red');
  1         2  
  1         4  
18 1     1   90 use constant E_YES => colored('YES', 'green');
  1         2  
  1         7  
19 1     1   100 use constant E_OK => colored('OK', 'green');
  1         3  
  1         3  
20 1     1   84 use constant E_MERGE => colored('MERGE', 'blue');
  1         2  
  1         3  
21              
22 1     1   117 use constant CLOSES_GITHUB => qr#\ACloses: https?://github\.com#;
  1         2  
  1         47  
23              
24 1     1   895 use Getopt::Long;
  1         12560  
  1         7  
25 1     1   721 use Pod::Usage;
  1         40108  
  1         1589  
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              
79             # Automatically pass the Sign-Off option to the git am command if the
80             # repository is Gentoo.
81 0 0         if ($repo_name =~ /gentoo\/gentoo/) {
82 0           $git_command = "$git_command -s";
83             }
84              
85             # But don't add the option again if the -s option is passed to pram.
86 0 0         if ($self->{signoff}) {
87 0 0         if ($repo_name !~ /gentoo\/gentoo/) {
88 0           $git_command = "$git_command -s";
89             }
90             }
91              
92 0           my $patch_url = "https://patch-diff.githubusercontent.com/raw/$repo_name/pull/$pr_number.patch";
93 0           $self->{pr_url} = "https://github.com/$repo_name/pull/$pr_number";
94            
95             # Go!
96 0           $self->apply_patch(
97             $editor,
98             $git_command,
99             $self->modify_patch(
100             $self->fetch_patch($patch_url)
101             )
102             );
103             }
104              
105             sub run_checks {
106 0 0   0 0   @_ == 2 || die qq#Usage: run_checks(obj, error_msg)#;
107 0           my ($obj, $error_msg) = @_;
108              
109 0 0         $obj || pod2usage(
110             -message => E_ERROR . qq#! $error_msg\n#,
111             -verbose => 1
112             );
113              
114 0 0         $obj =~ /^\d+$/ || pod2usage(
115             -message => E_ERROR . qq#! "$obj" is NOT a number!\n#,
116             -verbose => 1
117             );
118             }
119              
120             sub my_sleep {
121 0     0 0   select(undef, undef, undef, 0.50);
122             }
123              
124             sub fetch_patch {
125 0 0   0 1   @_ == 2 || die qq#Usage: fetch_patch(patch_url)\n#;
126 0           my ($self, $patch_url) = @_;
127              
128 0           print "Fetching $patch_url ... ";
129              
130 0           my $response = HTTP::Tiny->new->get($patch_url);
131 0           my $status = $response->{status};
132            
133 0 0         $status != 200 and die "\n" . E_ERROR . qq#! Unreachable URL! Got HTTP status $status!\n#;
134 0           my $patch = $response->{content};
135              
136 0           print E_OK . "!\n";
137            
138 0           return decode('UTF-8', $patch);
139             }
140              
141             sub add_header {
142 0 0   0 0   @_ == 3 || die qq#Usage: add_header(patch, header, msg)\n#;
143 0           my ($patch, $header, $msg) = @_;
144              
145 0           print qq#$msg#;
146 0           my_sleep();
147 0           my $confirm = E_ERROR;
148 0           my $is_sub = $patch =~ s#---#$header#;
149 0 0         $is_sub and $confirm = E_OK;
150 0           print "$confirm!\n";
151 0           my_sleep();
152 0           return $patch;
153             }
154              
155             sub modify_patch {
156 0 0   0 1   @_ == 2 || die qq#Usage: modify_patch(patch)\n#;
157 0           my ($self, $patch) = @_;
158              
159 0 0         if (not $patch =~ CLOSES_GITHUB) {
160 0           my $pr_url = $self->{pr_url};
161 0           $patch = add_header(
162             $patch,
163             qq#Closes: $pr_url\n---#,
164             qq#Adding Github "Closes:" header ... #
165             );
166             }
167              
168 0 0         if ($self->{bug}) {
169 0           my $bug = $self->{bug};
170 0           $patch = add_header(
171             $patch,
172             qq#Bug: https://bugs.gentoo.org/$bug\n---#,
173             qq#Adding Gentoo "Bug:" header with bug $bug ... #
174             );
175             }
176              
177 0 0         if ($self->{closes}) {
178 0           my $closes = $self->{closes};
179 0           $patch = add_header(
180             $patch,
181             qq#Closes: https://bugs.gentoo.org/$closes\n---#,
182             qq#Adding Gentoo "Closes:" header with bug $closes ... #
183             );
184             }
185              
186 0           return $patch;
187             }
188              
189             sub apply_patch {
190 0 0   0 1   @_ == 4 || die qq#Usage: apply_patch(editor, git_command, patch)\n#;
191 0           my ($self, $editor, $git_command, $patch) = @_;
192              
193 0           my $patch_location = File::Temp->new() . '.patch';
194 0   0       open my $fh, '>:encoding(UTF-8)', $patch_location || die E_ERROR . qq#! Can't write to $patch_location: $!!\n#;
195 0           print $fh $patch;
196 0           close $fh;
197              
198 0           print "Opening $patch_location with $editor ... ";
199 0           my_sleep();
200 0           my $exit = system $editor => $patch_location;
201 0 0         $exit eq 0 || die E_ERROR . qq#! Could not open $patch_location: $!!\n#;
202 0           print E_OK . "!\n";
203            
204 0           print E_MERGE . "? Do you want to apply this patch and merge this PR? [y/n] ";
205              
206 0           chomp(my $answer = );
207              
208 0 0         if ($answer =~ /^[Yy]$/) {
209 0           $git_command = "$git_command $patch_location";
210 0           print E_YES . "!\n";
211 0           print "Launching '$git_command' ... \n";
212 0           $exit = system join ' ', $git_command;
213 0 0         $exit eq 0 || die E_ERROR . qq#! Error when launching '$git_command': $!!\n#;
214 0           print E_OK . "!\n";
215             } else {
216 0           print E_NO . "!\nBailing out.\n";
217             }
218            
219 0           print "Removing $patch_location ... ";
220 0   0       unlink $patch_location || die E_ERROR . qq#! Couldn't remove '$patch_location'!\n#;
221 0           print E_OK . "!\n";
222             }
223              
224             1;
225              
226             __END__