view release on metacpan or  search on metacpan

lib/App/Git/Workflow/Command/BranchAge.pm  view on Meta::CPAN

package App::Git::Workflow::Command::BranchAge;

# Created on: 2014-03-11 20:58:59
# Create by:  Ivan Wills
# $Id$
# $Revision$, $HeadURL$, $Date$
# $Revision$, $Source$, $Date$

use strict;
use warnings;
use version;
use English qw/ -no_match_vars /;
use List::MoreUtils qw/zip/;
use Term::ANSIColor qw/colored/;
use App::Git::Workflow;
use App::Git::Workflow::Command qw/get_options/;
use DateTime::Format::HTTP;
use Data::Dumper qw/Dumper/;

our $VERSION  = version->new(1.1.20);
our $workflow = App::Git::Workflow->new;
our ($name)   = $PROGRAM_NAME =~ m{^.*/(.*?)$}mxs;
our %option = (
    master => 'origin/master',
);

sub run {
    get_options(
        \%option,
        'all|a',
        'remote|r',
        'reverse|R',
        'unmerged|u!',
        'master|m=s',
        'limit|n=i',
        'format|f=s',
        'files|F!',
        'quiet|q',
    );
    my $fmt = join "-%09-%09-", qw/
        %(authordate)
        %(authoremail)
        %(authorname)
        %(body)
        %(HEAD)
        %(objectname)
        %(objecttype)
        %(refname)
        %(refname:short)
        %(subject)
    /;
    my @headings = qw/
        authordate
        authoremail
        authorname
        body
        HEAD
        objectname
        objecttype
        refname
        short
        subject
    /;

    my $arg = '';
    if ( $option{remote} ) {
        $arg .= ' -r';
    }
    my $match = '';
    my $files;
    if (@ARGV) {
        if ($option{files}) {
            $files = join ' ', @ARGV;
        }
        else {
            $match = @ARGV ? shift @ARGV : '';
        }
    }

    my @branches = `git branch $arg --format='$fmt'`;
    my $i = 0;
    my $last = '';
    my @data;

    for my $branch (@branches) {
        chomp $branch;
        if ($last) {
            $last .= "\n";
        }
        $last .= $branch;
        my @cols = split /-\t-\t-/, $last;
        if (@cols < @headings) {
            next;
        }

        $last = '';
        $branch = { zip @headings, @cols };
        next if $match && $branch->{short} !~ /$match/;
        warn 'bad head' if !$branch->{HEAD};
        next if !$branch->{HEAD};
        if ( defined $option{unmerged} ) {
            next if unmerged($branch->{short}, $option{master});
        }

        if ($files) {
            my $date = `git log -n 1 --format=format:%ai $branch->{short} -- $files`;
            chomp $date;

            if ($date) {
                $date = $branch->{authordate};
            }
        }

        my ($date, $tz) = $branch->{authordate} =~ /^(.*)\s+([+-]\d{4})$/;
        if ($date && $tz) {
            $branch->{age} = DateTime::Format::HTTP->parse_datetime($date, $tz)->iso8601;
        }
        else {
            $Data::Dumper::Sortkeys = 1;
            $Data::Dumper::Indent = 1;
            die Dumper $branch;
        }
        push @data, $branch;
    }

    my %max = map {$_ => length $_} @headings;
    for my $branch (@data) {
        for my $key (keys %{$branch}) {
            $max{$key} = length $branch->{$key} if !$max{$key} || $max{$key} < length $branch->{$key};
        }
    }

    @data = sort {$a->{age} cmp $b->{age}} @data;
    if ($option{reverse}) {
        @data = reverse @data;
    }

    my $count = 1;
    my $fmt_out = $option{verbose} ? "%-age\t%-authorname\t%-short"
        : $option{quiet}       ? '%short'
        : $option{format}      ? $option{format}
        :                        "%age\t%short";
    my ($format, @fields) = formatted($fmt_out, \%max);

    if ($option{limit} && @data > $option{limit}) {
        @data = splice @data, @data - $option{limit}, $option{limit};
    }
    for my $branch (@data) {
        printf $format, map {$branch->{$_}} @fields;
    }
}

sub formatted {
    my ($format, $max) = @_;
    my @fields;
    my $fmt = '';
    my @fmt_parts = split /%([+-]?)(\((?:[a-z]+)\)|[a-z]+)/, $format;

    while (defined (my $fixed = shift @fmt_parts)) {
        my $align = shift @fmt_parts;
        my $name = shift @fmt_parts;
        $name =~ s/^[(]|[)]$//g;
        push @fields, $name;
        $fmt .= $fixed . ( $align ? "%$align$max->{$name}s" : "%s" );
    }

    return ("$fmt\n", @fields);
}

my %dest;
sub unmerged {
    my ($source, $dest) = @_;

    if ( ! $dest{$dest} ) {
        @{$dest{$dest}} = map {/^(.*)\n/; $1} `git log --format=format:%H $dest`;
        die "No destination branch commits for '$dest'" if !@{$dest{$dest}};