File Coverage

blib/lib/Group/Git/Cmd/Stats.pm

Criterion	Covered	Total	%
statement	33	80	41.2
branch	0	32	0.0
condition	0	5	0.0
subroutine	11	14	78.5
pod	3	3	100.0
total	47	134	35.0

package Group::Git::Cmd::Stats;

# Created on: 2013-05-10 07:05:17
# Create by:  Ivan Wills
# $Id$
# $Revision$, $HeadURL$, $Date$
# $Revision$, $Source$, $Date$

use strict;
use version;
use Moose::Role;
use Carp;
use List::Util qw/max/;
use Data::Dumper qw/Dumper/;
use English qw/ -no_match_vars /;
use File::chdir;
use Path::Tiny;
use Getopt::Alt;
use YAML::Syck;

our $VERSION = version->new('0.0.2');

my $opt = Getopt::Alt->new(
    {
        helper  => 1,
        help    => __PACKAGE__,
        default => {
            by => 'name',
            of => 'commits',
        },
    },
    [
        'by|b=s',
        'of|o=s',
        'verbose|v+',
        'quiet|q!',
    ]
);

sub stats_start {
    $opt->process;

    return;
}

my $collected = {};
sub stats {
    my ($self, $name) = @_;

    return unless -d $name;

    $opt->process if !%{ $opt->opt || {} };

    my $dir = path($CWD);

    local $CWD = $name;

    my $cache = $dir->path('.stats', $name . '.yml');
    $cache->parent->mkpath;
    my %stats;

    if ( -f $cache ) {
        %stats = %{ LoadFile($cache) };
    }

    open my $pipe, '-|', q{git log --format=format:"%H';'%ai';'%an';'%ae"};

    while (my $log = <$pipe>) {
        chomp $log;
        my ($id, $date, $name, $email) = split q{';'}, $log, 4;

        last if $stats{$id};

        # dodgy date handling but hay
        $date =~ s/\s.+$//;

        open my $show, '-|', qq{git show $id | grep -v '^[+][+][+]|^[-][-][-]' | grep -v '^[^-+]'};
        my ($added, $removed) = (0, 0);
        while (my $change = <$show>) {
            $added++   if $change =~ /^[+]/;
            $removed++ if $change =~ /^[-]/;
        }

        $stats{$id} = {
            name    => $name,
            email   => $email,
            date    => $date,
            added   => $added,
            removed => $removed,
        };
    }

    $cache = $dir->path('.stats', $name . '.yml');
    DumpFile($cache, \%stats);

    $collected->{$name} = \%stats;

    return;
}

sub stats_end {
    if ( -d '.stats' ) {
        DumpFile('.stats/collated.yml', $collected);

        my $type = $opt->opt->by eq 'email' ? 'email'
            : $opt->opt->by eq 'name'       ? 'name'
            : $opt->opt->by eq 'date'       ? 'date'
            : $opt->opt->by eq 'total'      ? 'total'
            : $opt->opt->by eq 'repo'       ? ''
            :                                 die "Unknown --by '" . $opt->opt->by . "'! (must be one of email, name or date)\n";

        my $of = $opt->opt->of eq 'commits' ? 'commits'
            : $opt->opt->of eq 'additions'  ? 'added'
            : $opt->opt->of eq 'removals'   ? 'removed'
            :                                 die "Unknown --of '" . $opt->opt->of . "'! (must be one of commits, additions or removals)\n";

        my %stats;
        for my $repo (keys %{ $collected }) {
            for my $id (keys %{ $collected->{$repo} }) {
                $stats{ $collected->{$repo}{$id}{$type} // $repo } += $collected->{$repo}{$id}{$of} // 1;
            }
        }

        my @items = sort { $stats{$a} <=> $stats{$b} } keys %stats;
        my $max   = max map {length $_} @items;
        for my $item (@items) {
            printf "%-${max}s %d\n", $item, $stats{$item};
        }
    }

    return;
}

1;

__END__

=head1 NAME

Group::Git::Cmd::Stats - Group-Git tools to show statistics accross many repositories

=head1 VERSION

This documentation refers to Group::Git::Cmd::Stats version 0.0.2

=head1 SYNOPSIS

   use Group::Git::Cmd::Stats;

   # Brief but working code example(s) here showing the most common usage(s)
   # This section will be as far as many users bother reading, so make it as
   # educational and exemplary as possible.


=head1 DESCRIPTION

Adds the stats command to L<Group::Git> which allows you to collect statistics
accross many repositories.

=head1 SUBROUTINES/METHODS

=head2 C<stats ($name)>

Collects the stats for each repository.

=head2 C<stats_start ()>

Initialises stats

=head2 C<stats_end ()>

Outputs the stats results.

=head1 DIAGNOSTICS

=head1 CONFIGURATION AND ENVIRONMENT

=head1 DEPENDENCIES

=head1 INCOMPATIBILITIES

=head1 BUGS AND LIMITATIONS

There are no known bugs in this module.

Please report problems to Ivan Wills ([e-mail]).

Patches are welcome.

=head1 AUTHOR

Ivan Wills - ([e-mail])

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2013 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