File Coverage

blib/lib/Gentoo/App/Pram.pm
Criterion Covered Total %
statement 48 137 35.0
branch 0 46 0.0
condition 0 11 0.0
subroutine 16 25 64.0
pod 3 9 33.3
total 67 228 29.3


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__