view release on metacpan or  search on metacpan

lib/App/GitHub.pm  view on Meta::CPAN

package App::GitHub;

use strict;
use warnings;

# ABSTRACT: GitHub Command Tools

use Carp;
use Moose;
use Net::GitHub;
use Term::ReadKey;
use Term::ReadLine;
use JSON::XS;
use IPC::Cmd qw/can_run/;

our $VERSION = '1.0.1';

has 'term' => (
    is       => 'rw',
    required => 1,
    default  => sub { Term::ReadLine->new('Perl-App-GitHub') }
);
has 'prompt' => (
    is       => 'rw',
    required => 1,
    default  => sub { 'github> ' }
);

has 'out_fh' => (
    is       => 'rw',
    required => 1,
    lazy     => 1,
    default  => sub {
        shift->term->OUT || \*STDOUT;
    }
);

has 'repo_regexp' => (
    is       => 'ro',
    required => 1,
    isa      => 'RegexpRef',
    default  => sub { qr/^([\-\w]+)[\/\\\s]([\-\w]+)$/ }
);

# For non-interactive mode
has 'silent' => (
    is       => 'rw',
    required => 1,
    default  => 0,
);

sub print_err {
    shift->print( @_, 1 );
}

sub print {
    my ( $self, $message, $error ) = @_;
    return 1 if $self->silent and not $error;

    my $fh;
    local $@;
    my $rows         = ( GetTerminalSize( $self->out_fh ) )[1];
    my $message_rows = $message =~ tr/\n/\n/;
    my $pager_use    = 0;

    # let less exit if one screen
    no warnings 'uninitialized';
    local $ENV{LESS} ||= "";
    $ENV{LESS} .= " -F";
    use warnings;

    if ( $@ or $message_rows < $rows ) {
        chomp $message;
        $message .= "\n";

        $fh = $self->out_fh;
    }
    else {
        eval {
            open $fh, '|-', $self->_get_pager
              or croak "unable to open more: $!";
        }
          or $fh = $self->out_fh;
        $pager_use = 1;
    }

    no warnings 'uninitialized';
    print $fh "$message";
    print $fh "\n" if $self->term->ReadLine =~ /Gnu/;
    close($fh) if $pager_use;
}

sub _get_pager {
    my $pager =
         $ENV{PAGER}
      || can_run("less")
      || can_run("more")
      || croak "no pager found";
}

sub read {
    my ( $self, $prompt ) = @_;
    $prompt ||= $self->prompt;
    return $self->term->readline($prompt);
}

has 'github' => (
    is  => 'rw',
    isa => 'Net::GitHub',
);

has '_data' => ( is => 'rw', isa => 'HashRef', default => sub { {} } );

my $dispatch = {
    'exit' => sub { exit; },
    'quit' => sub { exit; },
    'q'    => sub { exit; },
    '?'    => \&help,
    'h'    => \&help,

    # Common
    repo    => \&set_repo,
    login   => \&set_login,
    loadcfg => \&set_loadcfg,

    # Repo
    'r.show' => sub { shift->run_basic_repo_cmd( 'repos', 'get', shift ); },
    'r.list'  => \&repo_list,
    'r.watch' => sub { shift->run_basic_repo_cmd( 'repos', 'watch', shift ); },
    'r.unwatch' =>
      sub { shift->run_basic_repo_cmd( 'repos', 'unwatch', shift ); },
    'r.fork' =>
      sub { shift->run_basic_repo_cmd( 'repos', 'create_fork', shift ); },
    'r.create'      => \&repo_create,
    'r.set_private' => sub { shift->repo_update( private => \1, shift ); },
    'r.set_public'  => sub { shift->repo_update( private => \0, shift ); },

    # XXX? TODO, deploy_keys collaborators
    'r.commit' =>
      sub { shift->run_github_with_repo( 'git_data', 'commit', shift ); },

    # Issues
    'i.list' => sub {
        my ( $self, $type ) = @_;
        $type ||= 'open';
        $self->run_github_with_repo( 'issue', 'repos_issues',
            { state => $type } );
    },
    'i.view' => sub { shift->run_github_with_repo( 'issue', 'issue', shift ); },
    'i.open' => sub { shift->issue_open_or_edit('open') },
    'i.edit'  => sub { shift->issue_open_or_edit( 'edit', @_ ) },
    'i.close' => sub {
        shift->run_github_with_repo( 'issue', 'update_issue', shift,
            { state => 'closed' } );
    },
    'i.reopen' => sub {
        shift->run_github_with_repo( 'issue', 'update_issue', shift,
            { state => 'open' } );
    },
    'i.label'   => \&issue_label,
    'i.comment' => \&issue_comment,

    # User
    'u.show'   => sub { shift->run_github( 'user', 'show', shift ); },

lib/App/GitHub.pm  view on Meta::CPAN

 i.list    open|closed       see a list of issues for a project
 i.view    :number           get data on an individual issue by number
 i.open                      open a new issue (auth required)
 i.close   :number           close an issue (auth required)
 i.reopen  :number           reopen an issue (auth required)
 i.edit    :number           edit an issue (auth required)
 i.comment :number
 i.label   add|del :num :label
                             add/remove a label (auth required)

Users
 u.show                      get extended information on user
 u.update                    update your users info (auth required)
 u.followers
 u.following
 u.follow  :user             follow :user (auth required)
 u.unfollow :user            unfollow :user (auth required)
 u.pub_keys                  Public Key Management (auth required)
 u.pub_keys.add
 u.pub_keys.del :number

Objects
 o.tree    :tree_sha1        get the contents of a tree by tree sha
 o.trees   :tree_sha1        get the contents of a tree by tree sha and recursively descend down the tree
 o.blob    :sha1             get the data of a blob (tree, file or commits)

Others
 r.show    :user :repo       more in-depth information for a repository
 r.list    :user             list out all the repositories for a user
 u.show    :user             get extended information on :user
HELP
}

sub set_repo {
    my ( $self, $repo ) = @_;

    # validate
    unless ( $repo =~ $self->repo_regexp ) {
        $self->print("Wrong repo args ($repo), eg 'fayland perl-app-github'");
        return;
    }
    my ( $owner, $name ) = ( $repo =~ $self->repo_regexp );
    $self->{_data}->{owner} = $owner;
    $self->{_data}->{repo}  = $name;

    # when call 'login' before 'repo'
    my @logins = ( $self->{_data}->{login} and $self->{_data}->{pass} )
      ? (
        login => $self->{_data}->{login},
        pass  => $self->{_data}->{pass}
      )
      : ();

    $self->{github} = Net::GitHub->new(
        owner   => $owner,
        repo    => $name,
        version => 3,
        pass    => $self->{_data}->{pass},
        @logins,
    );
    $self->{prompt} = "$owner/$name> ";
}

sub set_login {
    my ( $self, $login ) = @_;

    ( $login, my $pass ) = split( /\s+/, $login, 2 );
    unless ( $login and $pass ) {
        $self->print("Wrong login args ($login $pass), eg fayland password");
        return;
    }

    $self->_do_login( $login, $pass );
}

sub set_loadcfg {
    my ( $self, $ign ) = @_;

    my $login = `git config --global github.user`;
    my $pass  = `git config --global github.pass`;
    chomp($login);
    chomp($pass);
    unless ( ( $login and $pass ) or $ign ) {
        $self->print("run git config --global github.user|pass fails");
        return;
    }

    $self->_do_login( $login, $pass ) if $login and $pass;
}

sub _do_login {
    my ( $self, $login, $pass ) = @_;

    # save for set_repo
    $self->{_data}->{login} = $login;
    $self->{_data}->{pass}  = $pass;

    if ( $self->{_data}->{repo} ) {
        $self->{github} = Net::GitHub->new(
            version => 3,
            owner   => $self->{_data}->{owner},
            repo    => $self->{_data}->{repo},
            login   => $self->{_data}->{login},
            pass    => $self->{_data}->{pass}
        );
    }
    else {

        # Create a Net::GitHub object with the owner set to the logged in user
        # Super convenient if you don't want to set a user first
        $self->{github} = Net::GitHub->new(
            version => 3,
            login   => $self->{_data}->{login},
            pass    => $self->{_data}->{pass},
            owner   => $self->{_data}->{login}
        );
    }
}

sub run_github {
    my ( $self, $c1, $c2 ) = @_;