File Coverage

blib/lib/Test/Requires/Git.pm
Criterion Covered Total %
statement 82 82 100.0
branch 35 36 97.2
condition 11 11 100.0
subroutine 12 12 100.0
pod 1 1 100.0
total 141 142 99.3


line stmt bran cond sub pod time code
1             package Test::Requires::Git;
2             $Test::Requires::Git::VERSION = '1.007';
3 14     14   200812 use strict;
  14         22  
  14         331  
4 14     14   61 use warnings;
  14         18  
  14         323  
5              
6 14     14   52 use Carp;
  14         17  
  14         1021  
7 14     14   6356 use Git::Version::Compare ();
  14         18169  
  14         408  
8              
9 14     14   66 use base 'Test::Builder::Module';
  14         19  
  14         3021  
10              
11             our $GIT = 'git';
12              
13             my %check = (
14             version_eq => \&Git::Version::Compare::eq_git,
15             version_ne => \&Git::Version::Compare::ne_git,
16             version_gt => \&Git::Version::Compare::gt_git,
17             version_le => \&Git::Version::Compare::le_git,
18             version_lt => \&Git::Version::Compare::lt_git,
19             version_ge => \&Git::Version::Compare::ge_git,
20             );
21              
22             # aliases
23             $check{'=='} = $check{eq} = $check{version} = $check{version_eq};
24             $check{'!='} = $check{ne} = $check{version_ne};
25             $check{'>'} = $check{gt} = $check{version_gt};
26             $check{'<='} = $check{le} = $check{version_le};
27             $check{'<'} = $check{lt} = $check{version_lt};
28             $check{'>='} = $check{ge} = $check{version_ge};
29              
30             my $quiet = 0;
31             my $lock = '.test.requires.git.lock';
32              
33             sub import {
34 15     15   3327 my $class = shift;
35 15         31 my $caller = caller(0);
36              
37             # export methods
38             {
39 14     14   65 no strict 'refs';
  14         18  
  14         4837  
  15         17  
40 15         21 *{"$caller\::test_requires_git"} = \&test_requires_git;
  15         73  
41             }
42              
43 15 100 100     5918 return if @_ == 1 && $_[0] eq '-nocheck';
44              
45             # reset the global $GIT value
46 10         59 my $args = _extract_arguments(@_);
47 10 100       27 $GIT = $args->{git} if exists $args->{git};
48              
49             # test arguments
50 10         24 test_requires_git(@_);
51             }
52              
53             sub _extract_arguments {
54 312     312   515 my (@args) = @_;
55              
56 312         256 my ( %args, @spec );
57 312         678 while (@args) {
58              
59             # assume a lone parameter is a minimum git version
60 570 100       901 unshift @args, 'version_ge' if @args == 1;
61              
62 570         674 my ( $key, $val ) = splice @args, 0, 2;
63 570 100       1673 if ( $key =~ /^(?:git|skip)/ ) {
    100          
64 274 100       535 croak "Duplicate '$key' argument" if exists $args{$key};
65 273         733 $args{$key} = $val;
66             }
67             elsif ( !exists $check{$key} ) {
68 2 100       10 if ( @args % 2 ) { # odd number of arguments (see above)
69 1         2 unshift @args, version_ge => $key, $val;
70 1         2 redo;
71             }
72 1         168 croak "Unknown git specification '$key'";
73             }
74             else {
75 294         626 push @spec, $key, $val;
76             }
77             }
78 310 100       940 return wantarray ? ( \%args, @spec ) : \%args;
79             }
80              
81 5     5   10166 sub _git_version { qx{$GIT --version} }
82              
83             sub test_requires_git {
84 302     302 1 75665 my ( $args, @spec ) = _extract_arguments(@_);
85 300         400 my $skip = $args->{skip};
86 300 100       505 local $GIT = $args->{git} if exists $args->{git};
87              
88             # get the git version
89 300         228 my ($version) = do {
90 14     14   71 no warnings 'uninitialized';
  14         24  
  14         3369  
91 300         663 __PACKAGE__->_git_version(); # tests may override this
92             };
93              
94 300         1381 my $builder = __PACKAGE__->builder;
95 300 100 100     6176 if ( !$quiet && time - ( ( stat $lock )[9] || 0 ) > 60 ) {
      100        
96 1         39 $builder->diag($version);
97 1         155 $quiet++;
98 1 50       117 open my $fh, '>', $lock if !-e $lock;
99 1         46 utime( undef, undef, $lock );
100             }
101              
102             # perform the check
103 300         471 my ( $ok, $why ) = ( 1, '' );
104 300 100 100     878 if ( defined $version && Git::Version::Compare::looks_like_git($version) ) {
105 295         3038 while ( my ( $spec, $arg ) = splice @spec, 0, 2 ) {
106 290 100       6783 if ( !$check{$spec}->( $version, $arg ) ) {
107 160         1787 $ok = 0;
108 160         670 $version =~ s/^git version|[\012\015]+$//g;
109 160         282 $why = "$version $spec $arg";
110 160         202 last;
111             }
112             }
113             }
114             else {
115 5         28 $ok = 0;
116 5         26 $why = "`$GIT` binary not available or broken";
117             }
118              
119             # skip if needed
120 298 100       14085 if ( !$ok ) {
121              
122             # skip a specified number of tests
123 165 100       274 if ( $skip ) {
    100          
    100          
124 156         526 $builder->skip($why) for 1 .. $skip;
125 14     14   73 no warnings 'exiting';
  14         17  
  14         2231  
126 156         31899 last SKIP;
127             }
128              
129             # no plan declared yet
130             elsif ( !defined $builder->has_plan ) {
131 3 100       37 if ( $builder->summary ) {
132 1         16 $builder->skip($why);
133 1         347 $builder->done_testing;
134 1         338 exit 0;
135             }
136             else {
137 2         19 $builder->skip_all($why);
138             }
139             }
140              
141             # the plan is no_plan
142             elsif ( $builder->has_plan eq 'no_plan' ) {
143 1         16 $builder->skip($why);
144 1         572 exit 0;
145             }
146              
147             # some plan was declared, skip all tests one by one
148             else {
149 5         106 $builder->skip($why) for 1 + $builder->summary .. $builder->has_plan;
150 5         1632 exit 0;
151             }
152             }
153             }
154              
155             'git';
156              
157             __END__