File Coverage

blib/lib/Group/Git.pm
Criterion Covered Total %
statement 36 85 42.3
branch 0 16 0.0
condition 0 6 0.0
subroutine 12 16 75.0
pod 2 2 100.0
total 50 125 40.0


line stmt bran cond sub pod time code
1             package Group::Git;
2              
3             # Created on: 2013-05-04 16:16:56
4             # Create by: Ivan Wills
5             # $Id$
6             # $Revision$, $HeadURL$, $Date$
7             # $Revision$, $Source$, $Date$
8              
9 1     1   1606 use Moo;
  1         13065  
  1         6  
10 1     1   1637 use strict;
  1         3  
  1         21  
11 1     1   5 use warnings;
  1         2  
  1         28  
12 1     1   671 use version;
  1         2080  
  1         7  
13 1     1   80 use Carp;
  1         2  
  1         95  
14 1     1   596 use English qw/ -no_match_vars /;
  1         1944  
  1         7  
15 1     1   1327 use Path::Tiny;
  1         12279  
  1         89  
16 1     1   709 use File::chdir;
  1         3491  
  1         137  
17 1     1   649 use Group::Git::Repo;
  1         5  
  1         59  
18 1     1   11 use Types::Standard qw/Str Int Bool HashRef/;
  1         2  
  1         12  
19 1     1   1324 use Type::Utils;
  1         3  
  1         7  
20 1     1   2195 use Module::Pluggable require => 1, search_path => ['Group::Git::Cmd', 'Group::Git::Taggers'];
  1         8573  
  1         10  
21              
22             our $VERSION = version->new('0.7.6');
23             our $AUTOLOAD;
24              
25             has conf => (
26             is => 'rw',
27             isa => HashRef,
28             );
29             has repos => (
30             is => 'rw',
31             isa => HashRef[class_type({ class => 'Group::Git::Repo' })],
32             builder => '_repos',
33             lazy_build => 1,
34             );
35             has recurse => (
36             is => 'rw',
37             isa => Bool,
38             );
39             has verbose => (
40             is => 'rw',
41             isa => Int,
42             default => 0,
43             );
44             has test => (
45             is => 'rw',
46             isa => Bool,
47             );
48             has runs => (
49             is => 'rw',
50             isa => Int,
51             default => 1,
52             );
53             has paging => (
54             is => 'rw',
55             isa => Bool,
56             );
57              
58             # load all roles in the namespace Group::Git::Cmd::*
59             my @plugins = Group::Git->plugins;
60             our $taggers = {};
61             for my $plugin (@plugins) {
62             if ($plugin =~ /Group::Git::Cmd::/) {
63             with $plugin;
64             }
65             else {
66             my $tag = $plugin;
67             $tag =~ s/^.*:://;
68             $taggers->{lc $tag} = $plugin;
69             }
70             }
71              
72             sub _repos {
73 0     0     my ($self) = @_;
74 0           my %repos;
75 0           my @files = path('.')->children;
76 0           my %tags;
77 0           for my $tag ( keys %{ $self->conf->{tags} } ) {
  0            
78 0           $tags{$tag} = { map { $_ => 1 } @{ $self->conf->{tags}{$tag} } };
  0            
  0            
79             }
80              
81 0           while ( my $file = shift @files ) {
82 0 0         next unless -d $file;
83 0           my $config = $file->path('.git', 'config');
84              
85 0 0         if ( !-f $config ) {
86 0 0 0       if ( $self->recurse && $file->basename ne '.git' ) {
87 0           push @files, $file->children;
88             }
89 0           next;
90             }
91              
92 0           my ($url) = grep {/^\s*url\s*=\s*/} $config->slurp;
  0            
93 0 0         if ($url) {
94 0           chomp $url;
95 0           $url =~ s/^\s*url\s*=\s*//;
96             }
97             else {
98 0           $url = '';
99             }
100              
101 0           my $glob = "$file/.*.tag";
102 0           $glob =~ s/\s/?/g;
103              
104             $repos{$file} = Group::Git::Repo->new(
105             name => $file,
106             git => $url,
107             tags => {
108 0           map { m{/[.](.*?)[.]tag$}; $1 => 1 }
  0            
  0            
109             glob $glob
110             },
111             );
112              
113 0           for my $tag (keys %{ $repos{$file}->tags } ) {
  0            
114 0           $tags{$tag}{$file} = 1;
115             }
116             }
117              
118 0           for my $tag (keys %tags) {
119 0           $self->conf->{tags}{$tag} = [ sort keys %{ $tags{$tag} } ];
  0            
120             }
121              
122 0           return \%repos;
123             }
124              
125             sub cmd {
126 0     0 1   my ($self, $type, $command, $project) = @_;
127 0 0 0       return if !$project || !-d $project;
128              
129 0           local $CWD = $project;
130 0           local @ARGV = @ARGV;
131 0           my $cmd = join ' ', map { $self->shell_quote }
132 0 0         grep { defined $_ && $_ ne '' }
  0            
133             $type, $command, @ARGV;
134              
135 0           return scalar `$cmd`;
136             }
137              
138             sub shell_quote {
139 0     0 1   s{ ( [^\w\-./?*+] ) }{\\$1}gxms;
140 0           return $_;
141             }
142              
143             sub AUTOLOAD {
144              
145             # ignore the method if it is the DESTROY method
146 0 0   0     return if $AUTOLOAD =~ /DESTROY$/;
147              
148             # make sure that this is being called as a method
149 0 0         croak( "AUTOLOAD(): This function is not being called by a ref: $AUTOLOAD( ".join (', ', @_)." )\n" ) unless ref $_[0];
150              
151             # get the object
152 0           my $self = shift;
153              
154             # get the function name sans package name
155 0           my ($method) = $AUTOLOAD =~ /::([^:]+)$/;
156              
157 0           return $self->cmd($method, @_);
158             }
159              
160             1;
161              
162             __END__
163              
164             =head1 NAME
165              
166             Group::Git - Base module for group of git repository operations.
167              
168             =head1 VERSION
169              
170             This documentation refers to Group::Git version 0.7.6.
171              
172             =head1 SYNOPSIS
173              
174             use Group::Git;
175              
176             my $group = Group::Git->new( conf => {...} );
177              
178             # pull remote versions for all repositories
179             $group->pull();
180              
181             # any other arbitary command
182             $group->log;
183              
184             =head1 DESCRIPTION
185              
186             This is the base module it will try to use all roles in the C<Group::Git::Cmd::*>
187             namespace. This allows the creation of new command by just putting a role in that
188             namespace. Classes may extend this class to implement their own methods for
189             finding repositories (eg L<Group::Git::Github>, L<Group::Git::Bitbucket>,
190             L<Group::Git::Gitosis> and L<Group::Git::Stash>)
191              
192             =head2 Group-Git vs Git Submodule
193              
194             It has been pointed out that something similar could be achieved using the git
195             submodule command so here are some reasons for using C<Group-Git>:
196              
197             =over 4
198              
199             =item *
200              
201             No git repository needed to manage all the repositories in fact no configuration
202             is required at all.
203              
204             =item *
205              
206             Group-Git just cares about repositories not their commits as submodule does.
207              
208             =item *
209              
210             When using one of github.com / bitbucket.com or gitosis configurations when
211             new repositories are added the next C<group-git pull> will get those new
212             repositories.
213              
214             =item *
215              
216             You can add your own commands to C<group-git> currently via perl modules but
217             in the future in the same fashion as C<git> does (eg adding a program called
218             C<group-git-command> somewhere on your path will result in you being able to
219             run C<group-git command>)
220              
221             =back
222              
223             =head1 SUBROUTINES/METHODS
224              
225             =over 4
226              
227             =item C<cmd ($name)>
228              
229             Run the git command C<$name> for each repository.
230              
231             =item C<shell_quote ()>
232              
233             Returns the shell quoted string for $_
234              
235             =back
236              
237             =head1 DIAGNOSTICS
238              
239             =head1 CONFIGURATION AND ENVIRONMENT
240              
241             =head1 DEPENDENCIES
242              
243             =head1 INCOMPATIBILITIES
244              
245             =head1 BUGS AND LIMITATIONS
246              
247             There are no known bugs in this module.
248              
249             Please report problems to Ivan Wills (ivan.wills@gmail.com).
250              
251             Patches are welcome.
252              
253             =head1 AUTHOR
254              
255             Ivan Wills - (ivan.wills@gmail.com)
256              
257             =head1 LICENSE AND COPYRIGHT
258              
259             Copyright (c) 2013 Ivan Wills (14 Mullion Close, Hornsby Heights, NSW Australia 2077).
260             All rights reserved.
261              
262             This module is free software; you can redistribute it and/or modify it under
263             the same terms as Perl itself. See L<perlartistic>. This program is
264             distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
265             without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
266             PARTICULAR PURPOSE.
267              
268             =cut