File Coverage

blib/lib/Gentoo/App/Pram.pm

Criterion	Covered	Total	%
statement	48	138	34.7
branch	0	46	0.0
condition	0	11	0.0
subroutine	16	25	64.0
pod	3	9	33.3
total	67	229	29.2

#!/usr/bin/env perl
package Gentoo::App::Pram;

our $VERSION = '0.100000';

use warnings;
use strict;

use Term::ANSIColor qw/colored/;
use File::Basename qw/basename/;
use File::Which qw/which/;
use Encode qw/decode/;
use File::Temp;
use HTTP::Tiny;

use constant E_ERROR => colored('ERROR', 'red');
use constant E_NO    => colored('NO',    'red');
use constant E_YES   => colored('YES',   'green');
use constant E_OK    => colored('OK',    'green');
use constant E_MERGE => colored('MERGE', 'blue');

use constant CLOSES_GITHUB => qr#\ACloses: https?://github\.com#;

use Getopt::Long;
use Pod::Usage;

sub new {
    my ($class, @args) = @_;
    return bless { ref $args[0] ? %{ $args[0] } : @args }, $class;
}

sub new_with_opts {
    my ($class) = @_;
    my @opts = (
        'repository|r=s',
        'closes|c=s',
        'editor|e=s',
        'signoff|s',
        'bug|b=s',
        'help|h',
        'man|m'
    );
    my %opts;
    if (!GetOptions(\%opts, @opts)) {
        print "\n";
        pod2usage(-verbose => 1)
    }
    $opts{pr_number} = shift @ARGV;
    return $class->new(\%opts);
}

sub run {
    my ($self) = @_;

    my $pr_number = $self->{pr_number};
    my $closes = $self->{closes};
    my $bug = $self->{bug};

    $| = 1;

    $self->{help} and pod2usage(-verbose => 1);
    $self->{man} and pod2usage(-verbose => 2);

    $bug and $closes and pod2usage(
        -message => E_ERROR . qq#! --bug and --closes options are mutually exclusive!\n#,
        -verbose => 1
    );

    run_checks($pr_number, "You must specify a Pull Request number!");
    $bug and run_checks($bug, "You must specify a bug number when using --bug!");
    $closes and run_checks($closes, "You must specify a bug number when using --closes!");

    # Defaults to 'gentoo/gentoo' because we're worth it.
    my $repo_name   = $self->{repository} || 'gentoo/gentoo';
    my $editor      = $self->{editor} || $ENV{EDITOR} || 'less';

    my $git_command = which('git') . ' am --keep-cr -S';
    $self->{signoff} and $git_command = "$git_command -s";

    my $patch_url   = "https://patch-diff.githubusercontent.com/raw/$repo_name/pull/$pr_number.patch";
    $self->{pr_url} = "https://github.com/$repo_name/pull/$pr_number";

    # Go!
    $self->apply_patch(
        $editor,
        $git_command,
        $self->modify_patch(
            $self->fetch_patch($patch_url)
        )
    );
}

sub run_checks {
    @_ == 2 || die qq#Usage: run_checks(obj, error_msg)#;
    my ($obj, $error_msg) = @_;

    $obj || pod2usage(
        -message => E_ERROR . qq#! $error_msg\n#,
        -verbose => 1
    );

    $obj =~ /^\d+$/ || pod2usage(
        -message => E_ERROR . qq#! "$obj" is NOT a number!\n#,
        -verbose => 1
    );
}

sub my_sleep {
    select(undef, undef, undef, 0.50);
}

sub fetch_patch {
    @_ == 2 || die qq#Usage: fetch_patch(patch_url)\n#;
    my ($self, $patch_url) = @_;

    print "Fetching $patch_url ... ";

    my $response = HTTP::Tiny->new->get($patch_url);
    my $status = $response->{status};

    $status != 200 and die "\n" . E_ERROR . qq#! Unreachable URL! Got HTTP status $status!\n#;

    my $patch = $response->{content};
    chomp $patch;

    print E_OK . "!\n";

    return decode('UTF-8', $patch);
}

sub add_header {
    @_ == 3 || die qq#Usage: add_header(patch, header, msg)\n#;
    my ($patch, $header, $msg) = @_;

    print qq#$msg#;
    my_sleep();
    my $confirm = E_ERROR;
    my $is_sub = $patch =~ s#---#$header#;
    $is_sub and $confirm = E_OK;
    print "$confirm!\n";
    my_sleep();
    return $patch;
}

sub modify_patch {
    @_ == 2 || die qq#Usage: modify_patch(patch)\n#;
    my ($self, $patch) = @_;

    if (not $patch =~ CLOSES_GITHUB) {
        my $pr_url = $self->{pr_url};
        $patch = add_header(
            $patch,
            qq#Closes: $pr_url\n---#,
            qq#Adding Github "Closes:" header ... #
        );
    }

    if ($self->{bug}) {
        my $bug = $self->{bug};
        $patch = add_header(
            $patch,
            qq#Bug: https://bugs.gentoo.org/$bug\n---#,
            qq#Adding Gentoo "Bug:" header with bug $bug ... #
        );
    }

    if ($self->{closes}) {
        my $closes = $self->{closes};
        $patch = add_header(
            $patch,
            qq#Closes: https://bugs.gentoo.org/$closes\n---#,
            qq#Adding Gentoo "Closes:" header with bug $closes ... #
        );
    }

    return $patch;
}

sub apply_patch {
    @_ == 4 || die qq#Usage: apply_patch(editor, git_command, patch)\n#;
    my ($self, $editor, $git_command, $patch) = @_;

    my $patch_location = File::Temp->new() . '.patch';
    open my $fh, '>:encoding(UTF-8)', $patch_location || die E_ERROR . qq#! Can't write to $patch_location: $!!\n#;
    print $fh $patch;
    close $fh;

    print "Opening $patch_location with $editor ... ";
    my_sleep();
    my $exit = system $editor => $patch_location;
    $exit eq 0 || die E_ERROR . qq#! Could not open $patch_location: $!!\n#;
    print E_OK . "!\n";

    print E_MERGE . "? Do you want to apply this patch and merge this PR? [y/n] ";

    chomp(my $answer = );

    if ($answer =~ /^[Yy]$/) {
        $git_command = "$git_command $patch_location";
        print E_YES . "!\n";
        print "Launching '$git_command' ... ";
        $exit = system join ' ', $git_command;
        $exit eq 0 || die E_ERROR . qq#! Error when launching '$git_command': $!!\n#;
        print E_OK . "!\n";
    } else {
        print E_NO . "!\nBailing out.\n";
    }

    print "Removing $patch_location ... ";
    unlink $patch_location || die E_ERROR . qq#! Couldn't remove '$patch_location'!\n#;
    print E_OK . "!\n";
}

1;

__END__