File Coverage

blib/lib/Group/Git/Cmd/Tag.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package Group::Git::Cmd::Tag;
2              
3             # Created on: 2013-05-10 07:05:17
4             # Create by: Ivan Wills
5             # $Id$
6             # $Revision$, $HeadURL$, $Date$
7             # $Revision$, $Source$, $Date$
8              
9 1     1   500 use strict;
  1         1  
  1         29  
10 1     1   391 use version;
  1         1359  
  1         4  
11 1     1   298 use Moose::Role;
  0            
  0            
12             use Carp;
13             use Data::Dumper qw/Dumper/;
14             use English qw/ -no_match_vars /;
15             use File::chdir;
16             use Term::ANSIColor qw/colored/;
17             use Getopt::Alt;
18              
19             our $VERSION = version->new('0.0.2');
20              
21             my $opt = Getopt::Alt->new(
22             {
23             helper => 1,
24             help => __PACKAGE__,
25             },
26             [
27             'min|m',
28             'verbose|v+',
29             ]
30             );
31              
32             sub tag {
33             my ($self, $name) = @_;
34             return unless -d $name;
35              
36             $opt->process if !%{ $opt->opt || {} };
37              
38             my $tag = shift @ARGV;
39              
40             my $repo = $self->repos->{$name};
41              
42             local $CWD = $name;
43             my %tags;
44             for my $tag (`git tag`) {
45             chomp $tag;
46             $tags{$tag}++;
47             }
48             my %branches;
49             for my $branch (`git branch`) {
50             chomp $branch;
51             $branch =~ s/^.*\s//;
52             $branches{$branch}++;
53             }
54              
55             my $count = 0;
56             my $tagged = 0;
57             my $i = 0;
58             my @logs = `git log --format=format:'%h %d'`;
59             my %logs;
60             for (@logs) {
61             $i++;
62             chomp;
63             my ($hash, $branc_tag) = split /\s[(]/, $_;
64             $branc_tag ||= '';
65             chop $branc_tag;
66             my $tag = join ', ', grep { $tags{$_} } map {/^(?:tag:\s+)?(.*)/; $1} split /,\s+/, $branc_tag;
67             $count++;
68             my $min = !$tagged;
69             $tagged++ if $tag;
70              
71             $logs{$hash} = $tag ? $tag . colored(" ($count)", $min ? 'green' : '' ) : '';
72             last if $tag && $opt->opt->min;
73             }
74              
75             %logs
76             = map {
77             ( $_ => $logs{$_} );
78             }
79             grep {
80             $logs{$_} && ( $tag ? $logs{$_} =~ /$tag/ : 1 )
81             }
82             keys %logs;
83              
84             return unless %logs;
85              
86             return join '', map {
87             "$_ $logs{$_}\n"
88             }
89             sort {
90             my $A = $logs{$a};
91             my $B = $logs{$b};
92             $A =~ s/(\d+)/sprintf '%06d', $1/eg;
93             $B =~ s/(\d+)/sprintf '%06d', $1/eg;
94             $B cmp $A
95             }
96             keys %logs;
97             }
98              
99             1;
100              
101             __END__
102              
103             =head1 NAME
104              
105             Group::Git::Cmd::Tag - Finds tags in each repository
106              
107             =head1 VERSION
108              
109             This documentation refers to Group::Git::Cmd::Tag version 0.0.2
110              
111             =head1 SYNOPSIS
112              
113             group-git tag [options]
114              
115             Options:
116             -m --min Show only tag with minimum number of commits
117             -v --verbose Show more details about tags
118              
119             =head1 DESCRIPTION
120              
121             =head1 SUBROUTINES/METHODS
122              
123             =head2 C<tag ($name)>
124              
125             Does the work of finding tags
126              
127             =head1 DIAGNOSTICS
128              
129             =head1 CONFIGURATION AND ENVIRONMENT
130              
131             =head1 DEPENDENCIES
132              
133             =head1 INCOMPATIBILITIES
134              
135             =head1 BUGS AND LIMITATIONS
136              
137             There are no known bugs in this module.
138              
139             Please report problems to Ivan Wills (ivan.wills@gmail.com).
140              
141             Patches are welcome.
142              
143             =head1 AUTHOR
144              
145             Ivan Wills - (ivan.wills@gmail.com)
146              
147             =head1 LICENSE AND COPYRIGHT
148              
149             Copyright (c) 2013 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW Australia 2077).
150             All rights reserved.
151              
152             This module is free software; you can redistribute it and/or modify it under
153             the same terms as Perl itself. See L<perlartistic>. This program is
154             distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
155             without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
156             PARTICULAR PURPOSE.
157              
158             =cut