—

              
package App::Git::Workflow::Command::UpToDate;
# Created on: 2014-01-16 04:14:31
# Create by:  Ivan Wills
# $Id$
# $Revision$, $HeadURL$, $Date$
# $Revision$, $Source$, $Date$
use strict;
use warnings;
use version;
use English qw/ -no_match_vars /;
use App::Git::Workflow;
use App::Git::Workflow::Command qw/get_options/;
use Carp qw/cluck/;
our $VERSION  = version->new(1.1.20);
our $workflow = App::Git::Workflow->new;
our ($name)   = $PROGRAM_NAME =~ m{^.*/(.*?)$}mxs;
our %option;
our %p2u_extra;
sub run {
    my $self = shift;
    %option = (
        format      => 'test',
        max_history => $workflow->config('workflow.max-history') || 1,
        branches    => 0,
    );
    get_options(
        \%option,
        'tag|t=s',
        'branch|b=s',
        'local|l!',
        'remote|r!',
        'format|f=s',
        'quick|q!',
        'include|i=s',
        'exclude|e=s',
        'all',
        'max_history|max-history|m=i',
        'fetch|F',
        'fix|x',
    ) or return;
    my $action = shift @ARGV || 'am_i';
    my $format = 'format_' . $option{format};
    $action =~ s/-/_/g;
    $action = "do_$action";
    if ( !$self->can($action) ) {
        $action =~ s/^do_//;
        $action =~ s/_/-/;
        warn "Unknown action '$action'!\n";
        Pod::Usage::pod2usage( %p2u_extra, -verbose => 1 );
        return 1;
    }
    elsif ( $action eq 'do_show' && !$self->can($format) ) {
        warn "Unknown format '$option{format}'!\n";
        Pod::Usage::pod2usage( %p2u_extra, -verbose => 1 );
        return 1;
    }
    $workflow->{VERBOSE} = $option{verbose};
    $workflow->{TEST   } = $option{test};
    $workflow->git->fetch if $option{fetch};
    # do stuff here
    if ($option{branch_age}) {
        return branch_age();
    }
    if ($action eq 'do_show') {
        $option{branches} = 1;
    }
    my @releases = $workflow->releases(%option);
    if ($option{verbose}) {
        my $local = localtime($releases[-1]{time});
        my $now   = localtime;
        my $time  = time;
        warn <<"DETAILS";
Branch : $releases[-1]{name}
SHA    : $releases[-1]{sha}
Time   : $local ($releases[-1]{time})
Now    : $now ($time)
DETAILS
    }
    $option{all} = 1 if $action eq 'do_show' && $option{format} eq 'test';
    $self->$action(@releases);
    return;
}
sub do_show {
    my ($self, @releases) = @_;
    my $csv = branches_contain(@releases);
    if ($option{verbose}) {
        warn @$csv . " branches found\n";
    }
    my $format = 'format_' . $option{format};
    $self->$format($csv, @releases);
    return;
}
sub do_am_i {
    my (undef, @releases) = @_;
    # work out current branch, check that it contains a release branch
    my $format = q/--format=format:%H %at <%an>%ae/;
    my $bad = 0;
    for my $release (reverse @releases) {
        my ($ans) = grep {/$release->{sha}/} $workflow->git->log($format);
        chomp $ans if $ans;
        next if $ans;
        $bad++;
        warn "Missing release $release->{name}!\n";
    }
    if ($bad) {
        if ( $option{fix} ) {
            $workflow->git->merge($releases[-1]{name});
            return;
        }
        return $bad;
    }
    else {
        print "Up to date\n";
    }
    return;
}
sub do_current {
    my (undef, @releases) = @_;
    print "Current prod \"$releases[0]{name}\"\n";
    return;
}
sub do_update_me {
    my (undef, @releases) = @_;
    print "Merging \"$releases[0]{name}\"\n";
    $workflow->git->merge($releases[0]{name});
    return;
}
sub branches_contain {
    my @releases = @_;
    my @branches = $workflow->branches($option{remote} ? 'remote' : 'both');
    my $format = q/--format=format:%at <%an>%ae/;
    my @csv;
    BRANCH:
    for my $branch (@branches) {
        next BRANCH if $option{include} && $branch !~ /$option{include}/;
        next BRANCH if $option{exclude} && $branch =~ /$option{exclude}/;
        my ($first, $author, $found, $release);
        my ($log) = $workflow->git->log($format, qw/-n 1/, $branch);
        next if !$log;
        my ($time, $user) = split /\s+/, $log, 2;
        $first  = $time;
        $author = $user;
        if ( $time < $releases[-1]{time} ) {
            warn "skipping $branch\n" if $option{verbose} && $option{verbose} > 1;
            next BRANCH;
        }
        my $age = time - $releases[0]{time} + 10 * 60 * 60 * 24;
        my $ago = -1;
        RELEASE:
        for my $released (reverse @releases) {
            $ago++;
            next RELEASE if !$released->{branches}{$branch};
            $release = $released->{name};
            $age = $released == $releases[-1] ? 0 : time - $released->{time};
            last RELEASE;
        }
        next BRANCH if !$option{all} && !$option{verbose} && $found;
        push @csv, [ $release || "Out of date", $branch, $author, int $age / 60 / 60 / 24, $ago];
        warn +( $found ? 'up to date' : "missing $releases[-1]{name}" ) . "\t$branch\t$author\n" if $option{quick};
    }
    return \@csv;
}
sub format_text {
    my (undef, $csv, @releases) = @_;
    my @max = (0,0,0);
    for my $row (@$csv) {
        $max[0] = length $row->[0] if $max[0] < length $row->[0];
        $max[1] = length $row->[1] if $max[1] < length $row->[1];
        $max[2] = length $row->[2] if $max[2] < length $row->[2];
    }
    for my $row (@$csv) {
        printf "%$max[0]s %-$max[1]s %-$max[2]s (%2.0f days old)\n", @$row[0..3];
    }
    return;
}
sub format_csv {
    my (undef, $csv, @releases) = @_;
    my $sepperator = $option{format} eq 'tab' ? "\t" : ',';
    for my $row (@$csv) {
        print +(join $sepperator, @$row), "\n";
    }
    return;
}
{
    no warnings qw/once/;
    *format_tab = *format_csv;
}
sub format_json {
    my (undef, $csv, @releases) = @_;
    require JSON;
    my $repo   = $workflow->config('remote.origin.url');
    my ($name) = $repo =~ m{[/:](.*?)(?:[.]git)?$}xms;
    print JSON::encode_json({
        repository   => $repo,
        name         => $name,
        release      => $releases[-1]{name},
        release_date => '' . localtime($releases[-1]{time}),
        branches     => [
            map {{ status => $_->[0], name => $_->[1], last_author => $_->[2], release_age => $_->[3] }}
            @$csv
        ]
    });
    return;
}
sub format_html {
    my (undef, $csv, @releases) = @_;
    my $sepperator = "</td><td>";
    my $date       = localtime;
    my $repo       = $workflow->config('remote.origin.url');
    print <<"HTML";
<table>
    <caption>Branch statuses for <i>$repo</i> ($date)</caption>
    <thead>
        <tr>
            <th>Production Branch/Tag Status</th>
            <th>Branch Name</th>
            <th>Last commit owner</th>
            <th>Included release age (days)</th>
        </tr>
    </thead>
HTML
    for my $row (@$csv) {
        next if !$row && !$row->[2];
        my ($name, $email) = $row->[2] =~ /^<([^>]+)>(.*)$/;
        $row->[0] = $row->[0] eq $releases[-1]{name} ? $row->[0] : qq{<span class="old">$row->[0]</span>};
        $row->[2] = $row->[0] eq $releases[-1]{name} ? $name : qq{<a href="mailto:$email?subject=$row->[1]%20is%20out%20of%20date">$name</a>};
        print "<tr class=\"age_$row->[4]\"><td>" . (join $sepperator, @$row[0..3]), "</td></tr>\n";
    }
    print "</table>\n";
    return;
}
sub format_test {
    my (undef, $csv, @releases) = @_;
    require Test::More;
    Test::More->import();
    for my $row (@$csv) {
        is( $row->[0], $releases[-1]{name}, $row->[1] . ' is upto date')
            or note("Release is $row->[3] days old");
    }
    return;
}
1;
__DATA__
HideShow 152 lines of Pod
=head1 NAME
git-up-to-date - Check that git branches include latest production branch/tag
=head1 VERSION
This documentation refers to git-up-to-date version 1.1.20
=head1 SYNOPSIS
   git-up-to-date [am-i] [option]
   git-up-to-date show [option]
   git-up-to-date current [option]
   git-up-to-date update-me [option]
 SUB-COMMANDS
  am-i              (default) determine if the current branch is up-to-date
  show              Show's the status of all active branches (ie branches with
                    commits since last release)
  current           Show the current "production" branch or tag
  update-me         Merges in the latest release
 OPTIONS:
  -t --tab[=]str    Specify a tag that any branch with newer commits must contain
  -b --branch[=]str Similarly a branch that other branches with newer commits must
                    contain (Default origin/master)
  -l --local        Shorthand for --branch '^master$'
  -f --format[=](test|text|html|csv|tab|json)
                    Set the out put format
                      * test - TAP test formatted output (default)
                      * text - Simple formatted text
                      * html - A basic HTML page
                      * csv  - Comma seperated values formatted output
                      * tab  - Tab seperated values formatted output
  -q --quick        Print to STDERR the statuses as they are found (no formatting)
  -i --include[=]regexp
                    Include only "neweer" branches that match this regexp
  -e --exclude[=]regexp
                    Exclude any "neweer" branches that match this regexp
     --all          Show the status of all branches not just current ones.
  -m --max-history[=]int
                    Set the maximum number of release branches/tags to go back
                    (if more than one) to find where a branch was created from.
                    (Default 1)
  -s --branch-status
                    Shows the status (name, last committer, last commit date) of
                    all branches.
  -a --age-limit[=]date
                    With --branch-status limit to only branches created after
                    date (a YYYY-MM-DD formatted date)
  -F --fetch        Do a fetch before anything else.
  -x --fix          With am-i, merges in the current prod/release branch/tag
  -v --verbose      Shows changed branches that are upto date.
     --version      Prints the version information
     --help         Prints this help information
     --man          Prints the full documentation for git-up-to-date
=head1 DESCRIPTION
The C<git up-to-date> command can tell you the status of "active" branches as
compared to a release tag or branch. It does this by finding all tags or
branches that match the regular expression passed to C<--tag> or C<--branch>,
sorts them alpha-numerically assuming that the largest is the most recent.
 eg release_1, release_1_1
The branch release_1_1 would be considered the most recent. With the found
tag/branch the date/time it was created is used to find all branches that
have newer commits (unless C<--all> is used). These branches are then searched
to see if they contain the found release tag or branch (and if C<--max-history>
is specified and the branch doesn't contain the release branch or tag the older
releases are searched for).
=head1 SUBROUTINES/METHODS
=head2 C<run ()>
Executes the git workflow command
=head2 C<do_show ()>
=head2 C<do_am_i ()>
=head2 C<do_current ()>
=head2 C<do_update_me ()>
=head2 C<branches_contain ()>
=head2 C<format_text ()>
=head2 C<format_csv ()>
=head2 C<format_json ()>
=head2 C<format_html ()>
=head2 C<format_test ()>
=head2 C<format_tab ()>
=head1 DIAGNOSTICS
=head1 CONFIGURATION AND ENVIRONMENT
Defaults for this script can be set through C<git config>
 workflow.prod  Sets how a prod release is determined
                eg the default equivalent is branch=^origin/master$
 workflow.max-history
                Sets the default C<--max-history> value
You can set these values either by editing the repository local C<.git/config>
file or C<~/.gitconfig> or use the C<git config> command
 # eg Setting the global value
    git config --global workflow.max-history 10
 # or set a repository's local value
    git config workflow.prod 'tag=^release_\d{4}_\d{2}\d{2}$'
=head1 DEPENDENCIES
=head1 INCOMPATIBILITIES
=head1 BUGS AND LIMITATIONS
There are no known bugs in this module.
Please report problems to Ivan Wills (ivan.wills@gmail.com).
Patches are welcome.
=head1 AUTHOR
Ivan Wills - (ivan.wills@gmail.com)
=head1 LICENSE AND COPYRIGHT
Copyright (c) 2014 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW Australia 2077).
All rights reserved.
This module is free software; you can redistribute it and/or modify it under
the same terms as Perl itself. See L<perlartistic>.  This program is
distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.
=cut