git-unreleased-vimplugins

#!/usr/bin/env perl
use strict;
use warnings;
use utf8;

# gnu_compat: --opt="..." is allowed.
# no_bundling: single character option is not bundled.
# no_ignore_case: no ignore case on long option.
use Getopt::Long qw(:config posix_default gnu_compat bundling no_ignore_case);
use Pod::Usage;
use File::Spec::Functions qw(catfile);
use File::Basename qw(basename);
use Cwd ();
use IO::Handle;

# Not in CORE
use LWP::UserAgent;
use HTTP::Request;
use JSON qw(decode_json);
use URI;
use File::Find::Rule;
use Guard qw(guard);
use List::MoreUtils qw(first_index);

my $DEBUG_LEVEL = 1;


sub usage () {
    pod2usage(-verbose => 1);
}

sub msg {
    print "@_\n" if $DEBUG_LEVEL >= 1;
}
sub msg_n {
    print "@_"   if $DEBUG_LEVEL >= 1;
}

sub info {
    print "[info] @_\n" if $DEBUG_LEVEL >= 2;
}

sub debug {
    print "[debug] @_\n" if $DEBUG_LEVEL >= 3;
}

sub prompt {
    my ($msg) = @_;
    my $input;
    do {
        print $msg;
        $input = <STDIN>;
        exit unless defined $input;
        chomp $input;
    } until $input ne '';
    return $input;
}

sub get_user {
    my $user = git_nodie(qw<config --get github.user>);
    chomp $user;
    if ($user eq '') {
        $user = prompt("Input github username: ");
    }
    return $user;
}

sub get_password {
    my $password = git_nodie(qw<config --get github.password>);
    chomp $password;
    if ($password eq '') {
        $password = prompt("Input github password: ");
    }
    return $password;
}

### Communiate with Github API ###
{
    my $ENDPOINT = "https://api.github.com";
    my $USER;
    my $PASSWORD;

    sub set_up_useragent {
        my ($user, $password) = @_;
        $USER = $user;
        $PASSWORD = $password;
    }

    sub api_get {
        my ($path, %param) = @_;

        my $url = URI->new("${ENDPOINT}${path}");
        if (%param) {
            $url->query_form(%param);
        }

        die 'call set_up_useragent($user, $password) before.'
            if !defined($USER) || !defined($PASSWORD);
        my $req = HTTP::Request->new(GET => $url);
        $req->authorization_basic($USER, $PASSWORD);

        my $ua = LWP::UserAgent->new;
        return $ua->request($req);
    }

    sub api_get_json {
        my ($path) = @_;

        my $res = api_get(@_);
        unless ($res->is_success) {
            die "GET $path: ".$res->status_line;
        }
        return decode_json($res->content);
    }
}

sub filter_vimplugin_repos {
    my ($gh_repos) = @_;

    # URL host is (www.)vim.org
    my $host_is_vim_org = sub {
        my ($repo) = @_;
        return 0 unless defined $repo->{homepage};
        return 0 if $repo->{homepage} =~ /^\s*$/;
        my $homepage = eval { URI->new($repo->{homepage}) };
        return $homepage->can('host') &&
               $homepage->host() =~ /\A(?:www\.)vim\.org\Z/;
    };
    # language is VimL
    my $lang_is_viml = sub {
        my ($repo) = @_;
        return defined($repo->{language})
            && $repo->{language} eq 'VimL';
    };
    # repos has bundle-ready dirctory hierarchy
    my $has_bundle_dirs = sub {
        return 0;    # TODO
    };

    return grep {
        $host_is_vim_org->($_)
            or
        $lang_is_viml->($_)
            or
        $has_bundle_dirs->($_)
    } @$gh_repos;
}

sub get_github_repos {
    my ($user, $password) = @_;

    my @repos;
    my $page = 1;
    my $PER_PAGE = 100;    # max value
    my $retry = 0;
    my $MAX_RETRY = 2;

    debug("getting repos from Github API...");
    while (1) {
        my $res = api_get("/user/repos", page => $page, per_page => $PER_PAGE);
        unless ($res->is_success) {
            if ($retry++ < $MAX_RETRY) {
                info("got failure response, "
                   . "retrying... ($retry/$MAX_RETRY)");
            }
            die "failed to authenticate with github API: "
                . $res->status_line;
        }
        $retry = 0;
        # Decode JSON.
        my $json = decode_json($res->content);
        unless (ref($json) eq 'ARRAY') {
            die "Github API returned a value which is not an array.";
        }
        unless (@$json) {
            # No more repos.
            last;
        }
        # Add repos to @repos.
        push @repos, @$json;
        $page++;
    }
    debug(sprintf "'%s' has %d repos on Github.",
                  $user, scalar(@repos));
    return \@repos;
}

sub get_plugins_from_bundle {
    my ($vimbundle_dir) = @_;

    return map {
        +{name => basename($_)}
    } glob("$vimbundle_dir/*");
}

sub filter_my_repos {
    my ($plugins, $gh_repos) = @_;

    my %my_repos = map {
        $_->{name} => 1
    } @$gh_repos;
    return grep {
        exists $my_repos{ $_->{name} }
    } @$plugins;
}

sub uniq_repos {
    my ($plugins) = @_;
    my %h;
    return grep {
        my $name = $_->{name};
        my $dup = exists $h{$name};
        if ($dup) {
            warn "warning: '$name' was given more than twice?\n";
        }
        $h{$name} = 1;
        not $dup;
    } @$plugins;
}

sub git {
    my @args = ('git', @_);
    debug("[git] ".join(' ', @args));

    pipe my $logrh, my $logwh
        or die "failed to create pipe:$!";

    my $status = -1;
    my $output;
    if (my $pid = fork) {
        close $logwh;
        $output = do { local $/; <$logrh> };
        close $logrh;
        1 while wait == -1;
        $status = $?;
    } elsif (defined $pid) {
        close $logrh;
        open STDERR, '>&', $logwh
            or die "failed to redirect STDERR to pipe";
        open STDOUT, '>&', $logwh
            or die "failed to redirect STDOUT to pipe";
        close $logwh;
        exec @args;
        die "exec(2) failed:$!: @args";
    } else {
        close $logrh;
        close $logwh;
    }

    # from 'perldoc -f system'
    if ($status == -1) {
        die "failed to execute git: $!\n";
    }
    elsif ($status & 127) {
        die sprintf "git died with "
                . "signal %d, %s coredump\n",
                  ($status & 127),  ($status & 128) ? 'with' : 'without';
    }
    elsif ($status != 0) {
        die sprintf "git exited with value %d\n", $status >> 8;
    }

    chomp $output;
    return $output;
}

sub git_nodie {
    open(my $fh, '-|', 'git', @_) or die "Can't open pipe: $!";
    my $output = do { local $/; <$fh> };
    close $fh;

    return $output;
}

sub git_lines {
    split /\n/, git(@_)
}

sub dirty_working_tree {
    git_nodie('status', '--porcelain', '--untracked-files=no') ne '';
}

sub blob2content {
    git('cat-file', '-p', $_[0]);
}

sub path2blob {
    git('rev-parse', "HEAD:$_[0]");
}

sub get_vim_related_files {
    my ($dir) = @_;
    my $cwd = Cwd::getcwd();
    chdir $dir or die "can't chdir to '$dir': $!";
    my $guard = guard { chdir $cwd };
    my $FILE = File::Find::Rule->new()
                ->file();
    my $VIM  = File::Find::Rule->new()
                ->file()->name('*.vim');
    my $DOC  = File::Find::Rule->new()
                ->file()->name(qr/\.(txt|..x)/);
    my @files =
        $VIM->in(catfile($dir, "plugin")),
        $VIM->in(catfile($dir, "autoload")),
        $VIM->in(catfile($dir, "ftplugin")),
        $VIM->in(catfile($dir, "ftdetect")),
        $VIM->in(catfile($dir, "indent")),
        $VIM->in(catfile($dir, "syntax")),
        $VIM->in(catfile($dir, "colors")),
        $VIM->in(catfile($dir, "compiler")),
        $DOC->in(catfile($dir, "doc")),
        $FILE->in(catfile($dir, "macros")),
        (-d catfile($dir, 'after') ?
            get_vim_related_files(catfile($dir, 'after')) : ())
        ;
    return @files;
}

sub get_blobs_of_vimorg {
    my ($repo) = @_;
    my $TMP_REMOTE = 'tmp-vimorg';
    my %blob;
    my @guard;

    # Change remote URL temporarily.
    my ($remote_url) = map {
        s/$TMP_REMOTE\s+//; $_
    } grep /^$TMP_REMOTE/, git_lines('remote', '-v');
    # Restore remote URL.
    if (defined $remote_url) {
        push @guard, guard {
            git('remote', 'rm', $TMP_REMOTE);
            git('remote', 'add', $TMP_REMOTE, "git://github.com/vim-scripts/".$repo->{name});
        };
    }
    else {
        push @guard, guard {
            git('remote', 'rm', $TMP_REMOTE);
        };
    }

    # Fetch blob objects from remote.
    defined $remote_url && git('remote', 'rm', $TMP_REMOTE);
    git('remote', 'add', $TMP_REMOTE, "git://github.com/vim-scripts/".$repo->{name});

    # If a repository is not found, this git() will die().
    eval { git('fetch', $TMP_REMOTE) };
    if ($@) {
        info("$repo->{name}: repository is not found...skip.");
        return undef;
    }

    # Change working tree temporarily.
    if (dirty_working_tree()) {
        git('stash', 'save');
        # Restore working tree.
        push @guard, guard {
            git('stash', 'pop');
        };
    }

    # Change current branch temporarily.
    my ($branch) = map {
        s/^\* //; $_
    } grep /^\*/, git_lines('branch');
    push @guard, guard {
        # Restore branch.
        git('checkout', $branch);
    };
    git('checkout', "$TMP_REMOTE/master");

    # Get blob SHA-1.
    for my $file (get_vim_related_files('.')) {
        my $filelist = ($blob{path2blob($file)} ||= []);
        push @$filelist, $file;
    }

    return \%blob;
}

sub look_up_latest_commit {
    my ($name, $blob) = @_;
    my $the_commit;
    # TODO: $rewrite_msg = 0 when terminal width has no room to print $msg.
    my $rewrite_msg = (-t STDOUT);
    my $prev_msg_len;
    my @log = git_lines('log', '--pretty=format:%T %t %H %h');
    for my $log (@log) {
        my ($tree, $abbr_tree, $commit, $abbr_commit) = split /\s+/, $log;
        find_blob($tree, sub {
            my ($sha1, $filename) = @_;
            # Print message.
            my $abbr_sha1 = substr($sha1, 0, 7);
            # Too long.
            #my $msg = "$name: $abbr_commit(commit)/$abbr_tree(tree)/$sha1(blob)";
            my $msg = "$name: $abbr_tree(tree)/$abbr_sha1(blob)";
            if ($rewrite_msg) {
                my $padding = "";
                if (defined($prev_msg_len) && $prev_msg_len > length($msg)) {
                    $padding = " " x ($prev_msg_len - length($msg));
                }
                msg_n("\r${msg}${padding}");
                $prev_msg_len = length($msg);
            }
            else {
                msg_n($msg);
            }
            # Find $sha1 from $blob.
            if (ref($blob->{$sha1}) eq 'ARRAY') {
                my $idx = first_index { $_ eq $filename } @{ $blob->{$sha1} };
                delete $blob->{$sha1}[$idx];
                delete $blob->{$sha1} unless @{ $blob->{$sha1} };
            }
            unless (%$blob) {
                # All blobs are matched!
                # The commit must have same files as $TMP_BRANCH.
                $the_commit = $commit;
                goto JUMP;
            }
        });
    }
JUMP:
    print "\n";
    return $the_commit;
}

sub find_blob {
    my ($tree, $sub, $_parent_dir) = @_;

    for (git_lines('ls-tree', $tree)) {
        my ($type, $sha1, $filename) = m/^\S+\s+(\S+)\s+(\S+)\s+(.+)/;
        if ($type eq 'blob') {
            # Pass always a fullpath to callback.
            $filename = catfile($_parent_dir, $filename) if defined $_parent_dir;
            $sub->($sha1, $filename);
        }
        elsif ($type eq 'tree') {
            if (defined $_parent_dir) {
                $_parent_dir = catfile($_parent_dir, $filename);
            }
            else {
                $_parent_dir = $filename;
            }
            # depth first
            find_blob($sha1, $sub, $_parent_dir);
        }
    }
}

sub get_unreleased_plugins {
    my ($plugins, $user, $opt_all) = @_;

    my %unreleased;
    for my $plugin (@$plugins) {
        msg("Entering $plugin->{name} ...");
        my $cwd = Cwd::getcwd();
        my $guard = guard {
            chdir $cwd;
            msg("Leaving $plugin->{name} ...");
        };
        chdir $plugin->{name} or do {
            info("warning: can't chdir into '$plugin->{name}'... skip.");
            next;
        };

        # Guess repo name on github/vim-scripts.
        my $orgname = $plugin->{name};
        my $repo = find_vimscripts_repo($plugin, $user);

        # Try to guess also by 'git remote -v' output.
        unless (defined $repo) {
            my $re = qr{^\S+\s+git://github\.com/vim-scripts/(\S+?)(?:\.git|\s)};
            my @remote_names = grep m/$re/, git_lines('remote', '-v');
            for (@remote_names) {
                $repo = find_vimscripts_repo({
                    name => $_
                }, $user);
                last if defined $repo;
            }
        }

        # Failed to guess github/vim-scripts repository name.
        unless (defined $repo) {
            $unreleased{$orgname} = sub {
                $_ = {
                    github_name => $orgname,
                    upload => 0,
                };
                print <<EOM;
$_->{github_name}:
    Latest commit on vim.org: (not uploaded yet)
EOM
            };
            next;
        }
        msg("$orgname: Found github/vim-scripts repository: $repo->{name}");

        # Get blob SHA-1 from github/vim-scripts.
        my $blob = eval { get_blobs_of_vimorg($repo) };
        if (!defined($blob) || $@) {
            die "error: found a repository for '$orgname' "
              . "but could not fetch blobs: $@\n";
        }

        # Look up a commit which has entirely same blob objects
        # all I have in %blob.
        my $commit = look_up_latest_commit($orgname, $blob);
        if (defined $commit) {
            my $abbr_commit = git('rev-parse', '--short', $commit);
            msg("$orgname: Found the same commit "
              . "on vim.org: $abbr_commit");
            my $count = scalar git_lines('log', '--oneline', "$commit..HEAD");
            if ($count > 0) {
                msg("$orgname: has unreleased commits.");
                $unreleased{$orgname} = sub {
                    $_ = {
                        github_name => $orgname,
                        vimorg_name => $repo->{name},
                        upload => 1,
                        commit => $commit,
                        abbr_commit => $abbr_commit,
                        count => $count,
                        user => $user,
                    };
                    print <<EOM;
$_->{github_name}:
    Latest commit on vim.org: $_->{commit} ($_->{count} commits between the HEADs)
    Repository on vim.org: http://github.com/vim-scripts/$_->{vimorg_name}
    Repository on github: http://github.com/$_->{user}/$_->{github_name}
EOM
                };
            }
            else {
                msg("$orgname: uploaded plugin on vim.org is up to date.");
                if ($opt_all) {
                    $unreleased{$orgname} = sub {
                        $_ = {
                            github_name => $orgname,
                            vimorg_name => $repo->{name},
                            upload => 1,
                            commit => $commit,
                            abbr_commit => $abbr_commit,
                            count => 0,
                            user => $user,
                        };
                        print <<EOM;
$_->{github_name}:
    Latest commit on vim.org: (plugin is up to date)
    Repository on vim.org: http://github.com/vim-scripts/$_->{vimorg_name}
    Repository on github: http://github.com/$_->{user}/$_->{github_name}
EOM
                    };
                }
            }
        }
        else {
            msg("$orgname: Not found the same commit on vim.org ...");
            if ($opt_all) {
                $unreleased{$orgname} = sub {
                    $_ = {
                        github_name => $orgname,
                        vimorg_name => $repo->{name},
                        upload => 1,
                        commit => undef,
                        abbr_commit => undef,
                        count => 0,
                        user => $user,
                    };
                    print <<EOM;
$_->{github_name}:
    Latest commit on vim.org: (could not find the same commits)
    Repository on vim.org: http://github.com/vim-scripts/$_->{vimorg_name}
    Repository on github: http://github.com/$_->{user}/$_->{github_name}
EOM
                };
            }
        }
    }
    return \%unreleased;
}

sub find_vimscripts_repo {
    my ($plugin, $user) = @_;
    for my $guessed (guess_repo_name($plugin, $user)) {
        debug("guessing repo name is "
            . "'$guessed->{name}' ...");
        # Github API is case-insensitive.
        # If a repo name "winmove" can hit
        # "github.com/vim-scripts/WinMove".
        my $json = eval {
            api_get_json("/repos/vim-scripts/$guessed->{name}");
        };
        if (ref($json) eq 'HASH' && defined $json->{name}) {
            return {
                %$guessed,
                # correct repo name.
                # e.g.) "WinMove"
                name => $json->{name},
            };
        }
        debug("failed to guess repo name: "
            . "github.com/vim-scripts/$guessed->{name} "
            . "is not found.");
    }
    return undef;
}

sub guess_repo_name {
    my ($plugin, $user) = @_;
    $_ = $plugin->{name};

    my @guessed = ($_);
    if (/^vim[-_](.+)$/i) {
        push @guessed, $1;
    }
    if (/(.+)[.-_]vim$/i) {
        push @guessed, $1;
    }
    if (/(.+)\.vim$/i) {
        push @guessed, "$1-vim";
    }
    if (/(.+)-vim$/i) {
        push @guessed, "$1.vim";
    }
    if (! /^vim\b/ && ! /\bvim$/) {
        push @guessed, "$_.vim";
        push @guessed, "$_-vim";
        push @guessed, "vim-$_";
    }
    if (/[^[:alnum:]]/) {
        push @guessed, $_;
        $guessed[-1] =~ s/[^[:alnum:]]//g;
    }
    # https://github.com/vim-scripts/rvm.vim--Pope
    push @guessed, "$_--$user";
    # e.g.) https://github.com/vim-scripts/skk.vim-B
    push @guessed, "$_-B";
    # push @guessed, "$_-C";

    return map {
        +{%$plugin, name => $_}
    } @guessed;
}



my $SEE_GITHUB = 0;
my $SEE_BUNDLE = 1;
my $opt_see = $SEE_BUNDLE;
my $save_repo_map = 0;    # TODO: Turn on if the feature was implemented.
my $opt_all = 0;
GetOptions(
    'h|help' => \&usage,
    'q|quiet' => sub { $DEBUG_LEVEL-- },
    'v|verbose' => sub { $DEBUG_LEVEL++ },
    'github' => sub { $opt_see = $SEE_GITHUB },
    'bundle' => sub { $opt_see = $SEE_BUNDLE },
    'no-save' => sub { $save_repo_map = 0 },
    'all' => \$opt_all,
) or usage();

STDOUT->autoflush(1);
STDERR->autoflush(1);


my $vimbundle_dir = shift;
unless (defined $vimbundle_dir) {
    warn "error: please specify vim bundle dir on your filesystem.\n\n\n";
    sleep 1;
    usage();
}
unless (-e $vimbundle_dir) {
    warn "error: github dir does not seem to exist: $vimbundle_dir\n\n\n";
    sleep 1;
    usage();
}
chdir $vimbundle_dir or die "$vimbundle_dir: $!";

my $user     = get_user();
my $password = get_password();
set_up_useragent($user, $password);
my $gh_repos = get_github_repos($user, $password);

# Get a list of vim plugin names.
my @plugins;
if ($opt_see == $SEE_GITHUB) {
    @plugins = filter_vimplugin_repos($gh_repos);
}
else {
    @plugins = get_plugins_from_bundle($vimbundle_dir);
    # Filter plugins which has a repository
    # on user's Github account.
    @plugins = filter_my_repos(\@plugins, $gh_repos);
}
unless (@plugins) {
    die "you don't seem to have vim plugins on github.\n";
}

msg("vim plugins:") if @plugins;
msg("  $_->{name}") for @plugins;

# Uniq @plugins by $_->{name}.
@plugins = uniq_repos(\@plugins);

# Get unreleased/un-uploaded plugins.
my $unreleased = get_unreleased_plugins(\@plugins, $user, $opt_all);

if ($save_repo_map) {
    for my $name (keys %$unreleased) {
        # TODO: escape $name
        if (exists $unreleased->{$name}{vimorg_name}) {
            my $vimorg_name = $unreleased->{$name}{vimorg_name};
            debug("saving a repo name on github/vim-scripts "
                . "for '$name': '$vimorg_name'");
            git('config', '--global', '--replace-all',
                "unreleased-vimplugins.$_", $vimorg_name);
        }
    }
}

# Show unreleased/un-uploaded plugins.
print "\n\n";
unless (%$unreleased) {
    print "All plugins are up to date. nice work!\n";
}
# NOTE: %$unreleased is not empty also when --all was given.
for my $print_summary (
    map { $unreleased->{$_} } sort keys %$unreleased
) {
    $print_summary->();
}



__END__

=head1 NAME

    git-unreleased-vimplugins - show unreleased vimplugins


=head1 SYNOPSIS

    $ git unreleased-vimplugins OPTIONS <vim bundle dir>

=head1 OPTIONS

=over

=item -h, --help

Show this help.

=item -q, --quiet

Decrement debug level.

Default debug level is MSG (=1).
QUIET = 0
MSG   = 1
INFO  = 2
DEBUG = 3

=item -v, --verbose

Increment debug level.

See C<--quiet> about debug level.

=item --github

Get vimplugin names list from your Github account.
But you must have repositories which has the same names
under vim bundle dir, that is specified to the 1st argument.
(Pseudo code below)

    $repos = github.get_repos()
                .filter(seems vimplugin)
    where
        seems vimplugin =
            URL host is (www.)vim.org
                or
            language is VimL
                or
            has bundle-ready directory hierarchy

Default behavior is to see vim bundle dir. (See C<--bundle>)

If you combine this option with C<--bundle>,
latter option is only effective.

=item --bundle

Get vimplugin names list from your vim bundle dir
that is specified to the 1st argument.
(Pseudo code below)

    $repos = vimbundledir.get_repos()
                .filter(on github)

This is default behavior. (See C<--github> to change)

If you combine this option with C<--github>,
latter option is only effective.

=item --no-save

Don't save vimplugin names list mapping
between repositories of vim bundle dir (C<--bundle>)
or Github account (C<--github>),
and repositories of C<http://github.com/vim-scripts>.

By default, this mapping is automatically created
in your global gitconfig, unless specified this option.

After this mapping is created,
this script doesn't need to *scan* repositories
on C<http://github.com/vim-scripts>
correspond to vimplugin names list.
so next time, you don't need to wait for a long time.


B<...But not implemented even auto-saving feature yet!>

=item --all

Show also up-to-date vimplugins.

=back


=head1 AUTHOR

tyru <tyru.exe@gmail.com>