File Coverage

blib/lib/Git/Hooks.pm
Criterion Covered Total %
statement 61 139 43.8
branch 0 46 0.0
condition 3 14 21.4
subroutine 14 20 70.0
pod 5 5 100.0
total 83 224 37.0


line stmt bran cond sub pod time code
1 2     2   14 use warnings;
  2         6  
  2         143  
2              
3             package Git::Hooks;
4             # ABSTRACT: Framework for implementing Git (and Gerrit) hooks
5             $Git::Hooks::VERSION = '3.4.0';
6 2     2   36 use v5.16.0;
  2         9  
7 2     2   11 use utf8;
  2         11  
  2         26  
8 2     2   58 use Carp;
  2         4  
  2         178  
9 2     2   18 use Exporter qw/import/;
  2         9  
  2         78  
10 2     2   12 use Path::Tiny;
  2         12  
  2         124  
11 2     2   19 use Log::Any '$log';
  2         4  
  2         10  
12 2     2   409 use Git::Repository qw/GitHooks Log/;
  2         11  
  2         65  
13              
14             our @EXPORT; ## no critic (Modules::ProhibitAutomaticExportation)
15              
16             my %Hooks;
17              
18             BEGIN { ## no critic (RequireArgUnpacking)
19 2     2   15 my @directives =
20             qw/ APPLYPATCH_MSG PRE_APPLYPATCH POST_APPLYPATCH
21             PRE_COMMIT PREPARE_COMMIT_MSG COMMIT_MSG
22             POST_COMMIT PRE_REBASE POST_CHECKOUT POST_MERGE
23             PRE_PUSH PRE_RECEIVE UPDATE POST_RECEIVE POST_UPDATE
24             PUSH_TO_CHECKOUT PRE_AUTO_GC POST_REWRITE
25              
26             REF_UPDATE PATCHSET_CREATED DRAFT_PUBLISHED
27             COMMIT_RECEIVED SUBMIT
28             /;
29              
30 2         6 my @drivers =
31             qw/ GITHOOKS_CHECK_AFFECTED_REFS
32             GITHOOKS_CHECK_PRE_COMMIT
33             GITHOOKS_CHECK_PATCHSET
34             GITHOOKS_CHECK_MESSAGE_FILE
35             /;
36              
37 2         4 for my $directive (@directives) {
38 46         67 my $hook = $directive;
39 46         71 $hook =~ tr/A-Z_/a-z-/;
40 2     2   10117 no strict 'refs'; ## no critic (ProhibitNoStrict)
  2         9  
  2         244  
41 46         198 *{"Git::Hooks::$directive"} = sub (&) {
42 2     2   3 push @{$Hooks{$hook}}, {
  2         12  
43             package => scalar(caller),
44             sub => shift(@_),
45             };
46             }
47 46         120 }
48              
49 2         3304 @EXPORT = (@directives, @drivers, 'run_hook');
50             }
51              
52             sub GITHOOKS_CHECK_AFFECTED_REFS (&;$) {
53 1     1 1 3 my ($check_ref, $options) = @_;
54 1   50     5 $options //= {};
55 1         3 my $caller = caller;
56              
57             my $hook = {
58             package => $caller,
59             sub => sub {
60 0     0   0 my ($git) = @_;
61              
62 0         0 $log->debug("$caller(GITHOOKS_CHECK_AFFECTED_REFS)");
63              
64 0 0       0 $options->{config}($git) if exists $options->{config};
65              
66 0 0       0 return 1 if $git->im_admin();
67              
68 0         0 my $errors = 0;
69              
70 0         0 foreach my $ref ($git->get_affected_refs()) {
71 0 0       0 next unless $git->is_reference_enabled($ref);
72 0         0 $errors += $check_ref->($git, $ref);
73             }
74              
75 0 0       0 $options->{destroy}($git) if exists $options->{destroy};
76              
77 0         0 return $errors == 0;
78             },
79 1         9 };
80              
81 1         6 foreach my $name (qw/commit-received pre-receive ref-update submit update/) {
82 5         13 push @{$Hooks{$name}}, $hook;
  5         22  
83             }
84              
85 1         4 return;
86             }
87              
88             sub GITHOOKS_CHECK_PRE_COMMIT (&;$) {
89 0     0 1 0 my ($check_commit, $options) = @_;
90 0   0     0 $options //= {};
91 0         0 my $caller = caller;
92              
93             my $hook = {
94             package => $caller,
95             sub => sub {
96 0     0   0 my ($git) = @_;
97              
98 0         0 $log->debug("$caller(GITHOOKS_CHECK_COMMIT)");
99              
100 0 0       0 return 1 if $git->im_admin();
101              
102 0 0       0 $options->{config}($git) if exists $options->{config};
103              
104 0         0 my $current_branch = $git->get_current_branch();
105              
106 0 0       0 return 1 unless $git->is_reference_enabled($current_branch);
107              
108 0         0 my $errors = $check_commit->($git, $current_branch);
109              
110 0 0       0 $options->{destroy}($git) if exists $options->{destroy};
111              
112 0         0 return $errors == 0;
113             },
114 0         0 };
115              
116 0         0 foreach my $name (qw/pre-applypatch pre-commit/) {
117 0         0 push @{$Hooks{$name}}, $hook;
  0         0  
118             }
119              
120 0         0 return;
121             }
122              
123             sub GITHOOKS_CHECK_PATCHSET (&;$) {
124 1     1 1 3 my ($check_patchset, $options) = @_;
125 1   50     3 $options //= {};
126 1         2 my $caller = caller;
127              
128             my $hook = {
129             package => $caller,
130             sub => sub {
131 0     0   0 my ($git, $opts) = @_;
132              
133 0         0 $log->debug("$caller(GITHOOKS_CHECK_PATCHSET)");
134              
135 0 0       0 return 1 if $git->im_admin();
136              
137 0 0       0 $options->{config}($git) if exists $options->{config};
138              
139 0         0 my $sha1 = $opts->{'--commit'};
140 0         0 my $commit = $git->get_commit($sha1);
141              
142             # The --branch argument contains the branch short-name if it's in the
143             # refs/heads/ namespace. But we need to always use the branch long-name,
144             # so we change it here.
145 0         0 my $branch = $opts->{'--branch'};
146 0 0       0 $branch = "refs/heads/$branch"
147             unless $branch =~ m:^refs/:;
148              
149 0 0       0 return 1 unless $git->is_reference_enabled($branch);
150              
151 0         0 my $errors = $check_patchset->($git, $branch, $commit);
152              
153 0 0       0 $options->{destroy}($git) if exists $options->{destroy};
154              
155 0         0 return $errors == 0;
156             },
157 1         8 };
158              
159 1         4 foreach my $name (qw/draft-published patchset-created/) {
160 2         3 push @{$Hooks{$name}}, $hook;
  2         5  
161             }
162              
163 1         3 return;
164             }
165              
166             sub GITHOOKS_CHECK_MESSAGE_FILE (&;$) {
167 1     1 1 2 my ($check_message_file, $options) = @_;
168 1   50     3 $options //= {};
169 1         3 my $caller = caller;
170 1         7 (my $cfg = $caller) =~ s/.*::/githooks./;
171              
172             my $hook = {
173             package => $caller,
174             sub => sub {
175 0     0   0 my ($git, $commit_msg_file) = @_;
176              
177 0         0 $log->debug("$caller(GITHOOKS_CHECK_MESSAGE_FILE)");
178              
179 0 0       0 return 1 if $git->im_admin();
180              
181 0 0       0 $options->{config}($git) if exists $options->{config};
182              
183 0         0 my $current_branch = $git->get_current_branch();
184              
185 0 0       0 return 1 unless $git->is_reference_enabled($current_branch);
186              
187 0         0 my $msg = eval {$git->read_commit_msg_file($commit_msg_file)};
  0         0  
188              
189 0 0       0 unless (defined $msg) {
190 0         0 $git->fault(<<"EOS", {details => $@});
191             I cannot read the commit message file '$commit_msg_file'.
192             EOS
193 0         0 return 0;
194             }
195              
196 0         0 my $errors = $check_message_file->($git, $msg, $current_branch);
197              
198 0 0       0 $options->{destroy}($git) if exists $options->{destroy};
199              
200 0         0 return $errors == 0;
201             },
202 1         7 };
203              
204 1         2 foreach my $name (qw/applypatch-msg commit-msg/) {
205 2         3 push @{$Hooks{$name}}, $hook;
  2         7  
206             }
207              
208 1         2 return;
209             }
210              
211             # This is the main routine of Git::Hooks. It gets the original hook
212             # name and arguments, sets up the environment, loads plugins and
213             # invokes the appropriate hook functions.
214              
215             sub run_hook {
216 0     0 1   my ($hook_name, @args) = @_;
217              
218 0           my $hook_basename = path($hook_name)->basename;
219              
220             # Contextualize the logs with the PID on server hooks. However, note that
221             # the Log::Any::context method was implemented on Log::Any version 1.050.
222 0 0 0       $log->context->{pid} = $$
223             if $hook_basename =~ /^(?:(pre|post)?-receive|(post-)?update|push-to-checkout)$/
224             && $log->can('context');
225              
226 0           $log->info("run_hook($hook_basename)", {args => \@args});
227              
228 0           my $git = Git::Repository->new();
229              
230 0           local $ENV{GITHOOKS_AUTHENTICATED_USER} = $git->authenticated_user();
231              
232 0           $git->prepare_hook($hook_name, \@args);
233              
234 0           $git->load_plugins();
235              
236             # Call every hook function installed by the hook scripts before.
237 0           for my $hook (@{$Hooks{$hook_basename}}) {
  0            
238 0           my $ok = eval { $hook->{sub}->($git, @args) };
  0            
239 0 0         if (defined $ok) {
    0          
240             # Modern hooks return a boolean value indicating their success.
241             # If they fail they invoke
242             # Git::Repository::Plugin::GitHooks::fault.
243 0 0         unless ($ok) {
244             # Let's see if there is a help-on-error message configured
245             # specifically for this plugin.
246 0           my $CFG = $hook->{package} =~ s/.*::/githooks./r;
247 0 0         if (my $help = $git->get_config(lc $CFG => 'help-on-error')) {
248 0           $git->fault($help, {prefix => $hook->{package}});
249             }
250             }
251             } elsif (length $@) {
252             # Old hooks die when they fail...
253 0           $git->fault("Hook failed", {
254             prefix => __PACKAGE__ . "($hook_basename)",
255             details => $@,
256             });
257             } else {
258             # ...and return undef when they succeed.
259             }
260             } continue {
261 0           $git->check_timeout();
262             }
263              
264             # Invoke enabled external hooks. This doesn't work in Windows yet.
265 0           $git->invoke_external_hooks(@args);
266              
267             # Some hooks want to do some post-processing
268 0           foreach my $post_hook ($git->post_hooks) {
269 0           $post_hook->($hook_basename, $git, @args);
270             } continue {
271 0           $git->check_timeout();
272             }
273              
274 0   0       $git->fail_on_faults(
275             ($hook_basename eq 'commit-msg' or $hook_basename eq 'pre-commit')
276             and not $git->get_config_boolean(githooks => 'abort-commit')
277             );
278              
279 0           return;
280             }
281              
282            
283             1; # End of Git::Hooks
284              
285             __END__