line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Git::CPAN::Hook; |
2
|
|
|
|
|
|
|
|
3
|
5
|
|
|
5
|
|
571778
|
use strict; |
|
5
|
|
|
|
|
18
|
|
|
5
|
|
|
|
|
281
|
|
4
|
5
|
|
|
5
|
|
33
|
use warnings; |
|
5
|
|
|
|
|
15
|
|
|
5
|
|
|
|
|
187
|
|
5
|
5
|
|
|
5
|
|
2196
|
use Git::Repository; |
|
5
|
|
|
|
|
61591
|
|
|
5
|
|
|
|
|
64
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '0.03'; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
# the list of CPAN.pm methods we will replace |
10
|
|
|
|
|
|
|
my %cpan; |
11
|
|
|
|
|
|
|
my %hook = ( |
12
|
|
|
|
|
|
|
'CPAN::Distribution::install' => \&_install, |
13
|
|
|
|
|
|
|
'CPAN::HandleConfig::neatvalue' => \&_neatvalue, |
14
|
|
|
|
|
|
|
); |
15
|
|
|
|
|
|
|
my @keys = qw( __HOOK__ ); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# if we were called from within CPAN.pm's configuration |
18
|
|
|
|
|
|
|
_TSR_CPAN() if $INC{'CPAN.pm'}; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# |
21
|
|
|
|
|
|
|
# some private utilities |
22
|
|
|
|
|
|
|
# |
23
|
|
|
|
|
|
|
sub _TSR_CPAN { |
24
|
2
|
|
|
2
|
|
13
|
require CPAN; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# actually replace the code in CPAN.pm |
27
|
2
|
|
|
|
|
17
|
_replace( $_ => $hook{$_} ) for keys %hook; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# install our keys in CPAN.pm's config |
30
|
2
|
|
|
|
|
15
|
$CPAN::HandleConfig::keys{$_} = undef for @keys; |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub _replace { |
34
|
4
|
|
|
4
|
|
13
|
my ( $fullname, $meth ) = @_; |
35
|
4
|
|
|
|
|
17
|
my $name = ( split /::/, $fullname )[-1]; |
36
|
5
|
|
|
5
|
|
1375
|
no strict 'refs'; |
|
5
|
|
|
|
|
17
|
|
|
5
|
|
|
|
|
175
|
|
37
|
5
|
|
|
5
|
|
64
|
no warnings 'redefine'; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
899
|
|
38
|
4
|
|
|
|
|
9
|
$cpan{$name} = \&{$fullname}; |
|
4
|
|
|
|
|
107
|
|
39
|
4
|
|
|
|
|
52
|
*$fullname = $meth; |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub _commit_all { |
43
|
2
|
|
|
2
|
|
18
|
my ($r, @args) = @_; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# git add . fails on an empty repository for git between 1.5.3 and 1.6.3.2 |
46
|
2
|
50
|
|
|
|
13
|
return if ! eval { $r->run( add => '.' ); 1; }; |
|
2
|
|
|
|
|
22
|
|
|
2
|
|
|
|
|
67469
|
|
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# git status --porcelain exists only since git 1.7.0 |
49
|
2
|
50
|
|
|
|
38
|
$r->run( commit => @args ) |
|
|
50
|
|
|
|
|
|
50
|
|
|
|
|
|
|
if $r->version_lt('1.7.0') |
51
|
|
|
|
|
|
|
? $r->run('status') !~ /^nothing to commit/m |
52
|
|
|
|
|
|
|
: $r->run( status => '--porcelain' ); |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub import { |
56
|
3
|
|
|
3
|
|
27
|
my ($class) = @_; |
57
|
3
|
|
|
|
|
8
|
my $pkg = caller; |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# always export everything |
60
|
5
|
|
|
5
|
|
263
|
no strict 'refs'; |
|
5
|
|
|
|
|
20
|
|
|
5
|
|
|
|
|
3110
|
|
61
|
3
|
|
|
|
|
10
|
*{"$pkg\::$_"} = \&$_ for qw( install init uninstall ); |
|
9
|
|
|
|
|
534
|
|
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# |
65
|
|
|
|
|
|
|
# exported methods for repository setup |
66
|
|
|
|
|
|
|
# |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub init { |
69
|
2
|
50
|
|
2
|
0
|
174679
|
my ($path) = @_ ? @_ : @ARGV; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
# make this directory a Git repository |
72
|
2
|
|
|
|
|
40
|
Git::Repository->run( init => { cwd => $path } ); |
73
|
2
|
|
|
|
|
71760
|
my $r = Git::Repository->new( work_tree => $path ); |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
# activate it for Git::CPAN::Hook |
76
|
2
|
|
|
|
|
227039
|
$r->run( qw( config cpan-hook.active true ) ); |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# create an initial commit if needed (e.g. for local::lib) |
79
|
2
|
|
|
|
|
93263
|
_commit_all( $r => -m => 'Initial commit' ); |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
# setup ignore list |
82
|
2
|
|
|
|
|
121097
|
my $ignore = File::Spec->catfile( $path, '.gitignore' ); |
83
|
2
|
50
|
|
|
|
1188
|
open my $fh, '>>', $ignore or die "Can't open $ignore for appending: $!"; |
84
|
2
|
|
|
|
|
36
|
print $fh "$_\n" for qw( .packlist perllocal.pod ); |
85
|
2
|
|
|
|
|
128
|
close $fh; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# git add won't accept an absolute path before 1.5.5 |
88
|
2
|
|
|
|
|
32
|
$r->run( add => '.gitignore' ); |
89
|
2
|
|
|
|
|
88746
|
$r->run( commit => '-m', 'Basic files in an empty CPAN directory' ); |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# tag as the empty root commit |
92
|
0
|
|
|
|
|
|
$r->run( tag => '-m', 'empty CPAN install, configured', 'empty' ); |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
# |
96
|
|
|
|
|
|
|
# exported methods for CPAN.pm hijacking |
97
|
|
|
|
|
|
|
# |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub install { |
100
|
0
|
|
|
0
|
0
|
|
_TSR_CPAN; |
101
|
0
|
|
|
|
|
|
CPAN::HandleConfig->load(); |
102
|
0
|
|
|
0
|
|
|
$CPAN::Config->{__HOOK__} = sub { }; |
|
0
|
|
|
|
|
|
|
103
|
0
|
|
|
|
|
|
CPAN::HandleConfig->commit(); |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
sub uninstall { |
107
|
0
|
|
|
0
|
0
|
|
_TSR_CPAN; |
108
|
0
|
|
|
|
|
|
CPAN::HandleConfig->load(); |
109
|
0
|
|
|
|
|
|
delete $CPAN::Config->{$_} for @keys; |
110
|
0
|
|
|
|
|
|
CPAN::HandleConfig->commit(); |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# |
114
|
|
|
|
|
|
|
# our replacements for some CPAN.pm methods |
115
|
|
|
|
|
|
|
# |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
# commit after a successful install |
118
|
|
|
|
|
|
|
sub _install { |
119
|
0
|
|
|
0
|
|
|
my $dist = $_[0]; |
120
|
0
|
|
|
|
|
|
my @rv = $cpan{install}->(@_); |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
# do something only after a successful install |
123
|
0
|
0
|
|
|
|
|
if ( !$dist->{install}{FAILED} ) { |
124
|
0
|
|
|
|
|
|
__PACKAGE__->commit( $dist->{ID} ); |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# return what's expected |
128
|
0
|
|
|
|
|
|
return @rv; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# make sure we always get loaded |
132
|
|
|
|
|
|
|
sub _neatvalue { |
133
|
0
|
|
|
0
|
|
|
my $nv = $cpan{neatvalue}->(@_); |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
# CPAN's neatvalue just stringifies coderefs, which we then replace |
136
|
|
|
|
|
|
|
# with some code to hook us back in CPAN for next time |
137
|
0
|
0
|
|
|
|
|
return $nv =~ /^CODE/ |
138
|
|
|
|
|
|
|
? 'do { require Git::CPAN::Hook; sub { } }' |
139
|
|
|
|
|
|
|
: $nv; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
# |
143
|
|
|
|
|
|
|
# core methods, available to all CPAN clients |
144
|
|
|
|
|
|
|
# |
145
|
|
|
|
|
|
|
sub commit { |
146
|
0
|
|
|
0
|
1
|
|
my ( $class, $dist ) = @_; |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
# assume distributions are always installed somewhere in @INC |
149
|
0
|
|
|
|
|
|
for my $inc ( grep -e, @INC ) { |
150
|
0
|
|
|
|
|
|
my $r = eval { Git::Repository->new( work_tree => $inc ); }; |
|
0
|
|
|
|
|
|
|
151
|
0
|
0
|
|
|
|
|
next if !$r; # not a Git repository |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# do not commit in random directories! |
154
|
0
|
0
|
|
|
|
|
next if $r->run(qw( config --bool cpan-hook.active )) ne 'true'; |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# commit step |
157
|
0
|
|
|
|
|
|
_commit_all( $r => -m => $dist ); |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
1; |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
__END__ |