377 lines
6.4 KiB
Perl
377 lines
6.4 KiB
Perl
package Git::PunchCard;
|
|
|
|
use 5.006;
|
|
use strict;
|
|
use warnings;
|
|
use base 'Error::Helper';
|
|
use Cwd;
|
|
|
|
=head1 NAME
|
|
|
|
Git::PunchCard - Gathers info for making punchcard style graphs for git.
|
|
|
|
=head1 VERSION
|
|
|
|
Version 0.0.0
|
|
|
|
=cut
|
|
|
|
our $VERSION = '0.0.0';
|
|
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
Quick summary of what the module does.
|
|
|
|
Perhaps a little code snippet.
|
|
|
|
use Git::PunchCard;
|
|
use Data::Dumper;
|
|
|
|
my $gpc = Git::PunchCard->new();
|
|
|
|
$gpc->dir($some_git_repo_dir);
|
|
if ( $gpc->error ){
|
|
print "Could not process the directory.\n";
|
|
}
|
|
print Dumper( $gpc );
|
|
|
|
=head1 EXPORT
|
|
|
|
A list of functions that can be exported. You can delete this section
|
|
if you don't export anything, such as for a purely object-oriented module.
|
|
|
|
=head1 SUBROUTINES/METHODS
|
|
|
|
=head2 new
|
|
|
|
Inits the object.
|
|
|
|
=cut
|
|
|
|
sub new {
|
|
my $self={
|
|
perror=>undef,
|
|
error=>undef,
|
|
errorString=>'',
|
|
errorExtra=>{
|
|
flags=>{
|
|
1=>'gitError',
|
|
},
|
|
},
|
|
card=>{
|
|
total=>0,
|
|
hourly_max=>0,
|
|
Sun=>{
|
|
total=>0,
|
|
'00'=>0,
|
|
'01'=>0,
|
|
'02'=>0,
|
|
'03'=>0,
|
|
'04'=>0,
|
|
'05'=>0,
|
|
'06'=>0,
|
|
'07'=>0,
|
|
'08'=>0,
|
|
'09'=>0,
|
|
'10'=>0,
|
|
'11'=>0,
|
|
'12'=>0,
|
|
'13'=>0,
|
|
'14'=>0,
|
|
'15'=>0,
|
|
'16'=>0,
|
|
'17'=>0,
|
|
'18'=>0,
|
|
'19'=>0,
|
|
'20'=>0,
|
|
'21'=>0,
|
|
'22'=>0,
|
|
'23'=>0,
|
|
},
|
|
Mon=>{
|
|
total=>0,
|
|
'00'=>0,
|
|
'01'=>0,
|
|
'02'=>0,
|
|
'03'=>0,
|
|
'04'=>0,
|
|
'05'=>0,
|
|
'06'=>0,
|
|
'07'=>0,
|
|
'08'=>0,
|
|
'09'=>0,
|
|
'10'=>0,
|
|
'11'=>0,
|
|
'12'=>0,
|
|
'13'=>0,
|
|
'14'=>0,
|
|
'15'=>0,
|
|
'16'=>0,
|
|
'17'=>0,
|
|
'18'=>0,
|
|
'19'=>0,
|
|
'20'=>0,
|
|
'21'=>0,
|
|
'22'=>0,
|
|
'23'=>0,
|
|
},
|
|
Tue=>{
|
|
total=>0,
|
|
'00'=>0,
|
|
'01'=>0,
|
|
'02'=>0,
|
|
'03'=>0,
|
|
'04'=>0,
|
|
'05'=>0,
|
|
'06'=>0,
|
|
'07'=>0,
|
|
'08'=>0,
|
|
'09'=>0,
|
|
'10'=>0,
|
|
'11'=>0,
|
|
'12'=>0,
|
|
'13'=>0,
|
|
'14'=>0,
|
|
'15'=>0,
|
|
'16'=>0,
|
|
'17'=>0,
|
|
'18'=>0,
|
|
'19'=>0,
|
|
'20'=>0,
|
|
'21'=>0,
|
|
'22'=>0,
|
|
'23'=>0,
|
|
},
|
|
Wed=>{
|
|
total=>0,
|
|
'00'=>0,
|
|
'01'=>0,
|
|
'02'=>0,
|
|
'03'=>0,
|
|
'04'=>0,
|
|
'05'=>0,
|
|
'06'=>0,
|
|
'07'=>0,
|
|
'08'=>0,
|
|
'09'=>0,
|
|
'10'=>0,
|
|
'11'=>0,
|
|
'12'=>0,
|
|
'13'=>0,
|
|
'14'=>0,
|
|
'15'=>0,
|
|
'16'=>0,
|
|
'17'=>0,
|
|
'18'=>0,
|
|
'19'=>0,
|
|
'20'=>0,
|
|
'21'=>0,
|
|
'22'=>0,
|
|
'23'=>0,
|
|
},
|
|
Thu=>{
|
|
total=>0,
|
|
'00'=>0,
|
|
'01'=>0,
|
|
'02'=>0,
|
|
'03'=>0,
|
|
'04'=>0,
|
|
'05'=>0,
|
|
'06'=>0,
|
|
'07'=>0,
|
|
'08'=>0,
|
|
'09'=>0,
|
|
'10'=>0,
|
|
'11'=>0,
|
|
'12'=>0,
|
|
'13'=>0,
|
|
'14'=>0,
|
|
'15'=>0,
|
|
'16'=>0,
|
|
'17'=>0,
|
|
'18'=>0,
|
|
'19'=>0,
|
|
'20'=>0,
|
|
'21'=>0,
|
|
'22'=>0,
|
|
'23'=>0,
|
|
},
|
|
Fri=>{
|
|
total=>0,
|
|
'00'=>0,
|
|
'01'=>0,
|
|
'02'=>0,
|
|
'03'=>0,
|
|
'04'=>0,
|
|
'05'=>0,
|
|
'06'=>0,
|
|
'07'=>0,
|
|
'08'=>0,
|
|
'09'=>0,
|
|
'10'=>0,
|
|
'11'=>0,
|
|
'12'=>0,
|
|
'13'=>0,
|
|
'14'=>0,
|
|
'15'=>0,
|
|
'16'=>0,
|
|
'17'=>0,
|
|
'18'=>0,
|
|
'19'=>0,
|
|
'20'=>0,
|
|
'21'=>0,
|
|
'22'=>0,
|
|
'23'=>0,
|
|
},
|
|
Sat=>{
|
|
total=>0,
|
|
'00'=>0,
|
|
'01'=>0,
|
|
'02'=>0,
|
|
'03'=>0,
|
|
'04'=>0,
|
|
'05'=>0,
|
|
'06'=>0,
|
|
'07'=>0,
|
|
'08'=>0,
|
|
'09'=>0,
|
|
'10'=>0,
|
|
'11'=>0,
|
|
'12'=>0,
|
|
'13'=>0,
|
|
'14'=>0,
|
|
'15'=>0,
|
|
'16'=>0,
|
|
'17'=>0,
|
|
'18'=>0,
|
|
'19'=>0,
|
|
'20'=>0,
|
|
'21'=>0,
|
|
'22'=>0,
|
|
'23'=>0,
|
|
},
|
|
},
|
|
};
|
|
bless $self;
|
|
|
|
return $self;
|
|
}
|
|
|
|
|
|
|
|
sub dir {
|
|
my $self=$_[0];
|
|
my $dir=$_[1];
|
|
|
|
if( ! $self->errorblank ){
|
|
return undef;
|
|
}
|
|
|
|
if (! defined( $dir ) ){
|
|
$dir=getcwd;
|
|
}
|
|
|
|
chdir( $dir );
|
|
|
|
my $output=`git log --pretty=format:"%ad" --date=local --date=format:'%a %H'`;
|
|
if ( $? != 0){
|
|
$self->{error}=1;
|
|
$self->{errorString}='"--pretty=format:\"%ad\" --date=local --date=format:\'%a %H\'" exited with a non-zero value';
|
|
$self->warn;
|
|
}
|
|
|
|
my @lines=split(/\n/, $output);
|
|
|
|
foreach my $line ( @lines ){
|
|
my ($day, $hour)=split(/\ +/, $line);
|
|
|
|
# Should never be undef, but just make sure.
|
|
if (
|
|
defined( $day ) &&
|
|
defined( $hour )
|
|
){
|
|
# increment the one we hit on
|
|
$self->{card}{$day}{$hour}++;
|
|
$self->{card}{$day}{total}++;
|
|
$self->{card}{total}++;
|
|
|
|
if ( $self->{card}{$day}{$hour} > $self->{card}{hourly_max}){
|
|
$self->{card}{hourly_max}=$self->{card}{$day}{$hour};
|
|
}
|
|
}
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
sub get_card{
|
|
my $self=$_[0];
|
|
my $dir=$_[1];
|
|
|
|
if( ! $self->errorblank ){
|
|
return undef;
|
|
}
|
|
|
|
return $self->{card};
|
|
}
|
|
|
|
=head1 AUTHOR
|
|
|
|
Zane C. Bowers-Hadley, C<< <vvelox at vvelox.net> >>
|
|
|
|
=head1 BUGS
|
|
|
|
Please report any bugs or feature requests to C<bug-git-punchcard at rt.cpan.org>, or through
|
|
the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Git-PunchCard>. I will be notified, and then you'll
|
|
automatically be notified of progress on your bug as I make changes.
|
|
|
|
|
|
|
|
|
|
=head1 SUPPORT
|
|
|
|
You can find documentation for this module with the perldoc command.
|
|
|
|
perldoc Git::PunchCard
|
|
|
|
|
|
You can also look for information at:
|
|
|
|
=over 4
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here)
|
|
|
|
L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Git-PunchCard>
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation
|
|
|
|
L<http://annocpan.org/dist/Git-PunchCard>
|
|
|
|
=item * CPAN Ratings
|
|
|
|
L<https://cpanratings.perl.org/d/Git-PunchCard>
|
|
|
|
=item * Search CPAN
|
|
|
|
L<https://metacpan.org/release/Git-PunchCard>
|
|
|
|
=back
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT
|
|
|
|
This software is Copyright (c) 2019 by Zane C. Bowers-Hadley.
|
|
|
|
This is free software, licensed under:
|
|
|
|
The Artistic License 2.0 (GPL Compatible)
|
|
|
|
|
|
=cut
|
|
|
|
1; # End of Git::PunchCard
|