File Coverage

blib/lib/Dist/Zilla/Plugin/Git/CommitBuild.pm
Criterion Covered Total %
statement 98 102 96.0
branch 7 14 50.0
condition 2 2 100.0
subroutine 24 24 100.0
pod 0 2 0.0
total 131 144 90.9


line stmt bran cond sub pod time code
1             #
2             # This file is part of Dist-Zilla-Plugin-Git
3             #
4             # This software is copyright (c) 2009 by Jerome Quelin.
5             #
6             # This is free software; you can redistribute it and/or modify it under
7             # the same terms as the Perl 5 programming language system itself.
8             #
9 3     3   3416669 use 5.008;
  3         13  
10 3     3   21 use strict;
  3         6  
  3         89  
11 3     3   16 use warnings;
  3         6  
  3         294  
12              
13             package Dist::Zilla::Plugin::Git::CommitBuild;
14             # ABSTRACT: Check in build results on separate branch
15              
16             our $VERSION = '2.048';
17              
18 3     3   25 use Git::Wrapper 0.021 (); # need -STDIN
  3         91  
  3         85  
19 3     3   21 use IPC::Open3;
  3         15  
  3         241  
20 3     3   2616 use IPC::System::Simple; # required for Fatalised/autodying system
  3         20408  
  3         181  
21 3     3   33 use File::chdir;
  3         7  
  3         382  
22 3     3   25 use File::Spec::Functions qw/ rel2abs catfile /;
  3         8  
  3         162  
23 3     3   21 use File::Temp;
  3         8  
  3         240  
24 3     3   19 use Moose;
  3         9  
  3         70  
25 3     3   22520 use namespace::autoclean;
  3         7  
  3         51  
26 3     3   288 use Path::Tiny qw();
  3         9  
  3         83  
27 3     3   1983 use Types::Path::Tiny 'Path';
  3         349864  
  3         42  
28 3     3   3667 use MooseX::Has::Sugar;
  3         2535  
  3         17  
29 3     3   396 use Types::Standard qw(Str Bool);
  3         9  
  3         28  
30 3     3   2933 use Cwd qw(abs_path);
  3         7  
  3         161  
31 3     3   24 use Try::Tiny;
  3         6  
  3         565  
32              
33             use String::Formatter (
34             method_stringf => {
35             -as => '_format_branch',
36             codes => {
37 7         2040 b => sub { shift->_source_branch },
38             },
39             },
40             method_stringf => {
41             -as => '_format_message',
42             codes => {
43 7         71347 b => sub { shift->_source_branch },
44 7         2725 h => sub { (shift->git->rev_parse( '--short', 'HEAD' ))[0] },
45 0         0 H => sub { (shift->git->rev_parse('HEAD'))[0] },
46 0 0       0 t => sub { shift->zilla->is_trial ? '-TRIAL' : '' },
47 1         429 v => sub { shift->zilla->version },
48             }
49             }
50 3     3   1698 );
  3         10099  
  3         78  
51              
52             # debugging...
53             #use Smart::Comments '###';
54              
55             with 'Dist::Zilla::Role::AfterBuild',
56             'Dist::Zilla::Role::AfterRelease',
57             'Dist::Zilla::Role::Git::Repo';
58              
59             # -- attributes
60              
61             has branch => ( ro, isa => Str, default => 'build/%b', required => 1 );
62             has release_branch => ( ro, isa => Str, required => 0 );
63             has message => ( ro, isa => Str, default => 'Build results of %h (on %b)', required => 1 );
64             has release_message => ( ro, isa => Str, lazy => 1, builder => '_build_release_message' );
65             has build_root => ( rw, coerce => 1, isa => Path );
66              
67             has _source_branch => (
68             is => 'ro',
69             isa => Str,
70             lazy => 1,
71             init_arg=> undef,
72             default => sub {
73             ($_[0]->git->name_rev( '--name-only', 'HEAD' ))[0];
74             },
75             );
76              
77             has multiple_inheritance => (
78             is => 'ro',
79             isa => Bool,
80             default => 0,
81             );
82              
83             # -- attribute builders
84              
85 6     6   249 sub _build_release_message { return shift->message; }
86              
87             # -- role implementation
88              
89             around dump_config => sub
90             {
91             my $orig = shift;
92             my $self = shift;
93              
94             my $config = $self->$orig;
95              
96             $config->{+__PACKAGE__} = {
97             (map +($_ => $self->$_),
98             qw(branch release_branch message release_message build_root)),
99             multiple_inheritance => $self->multiple_inheritance ? 1 : 0,
100             blessed($self) ne __PACKAGE__ ? ( version => $VERSION ) : (),
101             };
102              
103             return $config;
104             };
105              
106             sub after_build {
107 7     7 0 116367 my ( $self, $args) = @_;
108              
109             # because the build_root mysteriously change at
110             # the 'after_release' stage
111 7         342 $self->build_root( $args->{build_root} );
112              
113 7         310 $self->_commit_build( $args, $self->branch, $self->message );
114             }
115              
116             sub after_release {
117 1     1 0 204571 my ( $self, $args) = @_;
118              
119 1         80 $self->_commit_build( $args, $self->release_branch, $self->release_message );
120             }
121              
122             sub _commit_build {
123 8     8   55 my ( $self, undef, $branch, $message ) = @_;
124              
125 8 50       48 return unless $branch;
126              
127 8         115 my $dir = Path::Tiny->tempdir( CLEANUP => 1) ;
128 8         8301 my $src = $self->git;
129              
130 8         131 my $target_branch = _format_branch( $branch, $self );
131              
132 8         1363 for my $file ( @{ $self->zilla->files } ) {
  8         486  
133 16 50       1291 my ( $name, $content ) = ( $file->name, (Dist::Zilla->VERSION < 5
134             ? $file->content
135             : $file->encoded_content) );
136 16         4348 my ( $outfile ) = $dir->child( $name );
137 16         1643 $outfile->parent->mkpath();
138 16         3835 $outfile->spew_raw( $content );
139 16 50       9901 chmod $file->mode, "$outfile" or die "couldn't chmod $outfile: $!";
140             }
141              
142             # returns the sha1 of the created tree object
143 8         451 my $tree = $self->_create_tree($src, $dir);
144              
145 8     8   550 my ($last_build_tree) = try { $src->rev_parse("$target_branch^{tree}") };
  8         1657  
146 8   100     84395 $last_build_tree ||= 'none';
147              
148             ### $last_build_tree
149 8 50       105 if ($tree eq $last_build_tree) {
150              
151 0         0 $self->log("No changes since the last build; not committing");
152 0         0 return;
153             }
154              
155             my @parents = (
156             ( $self->_source_branch ) x $self->multiple_inheritance,
157             grep
158 8         1360 eval { $src->rev_parse({ 'q' => 1, 'verify'=>1}, $_ ) },
  8         375  
159             $target_branch
160             );
161              
162             ### @parents
163              
164 8         78345 my $this_message = _format_message( $message, $self );
165 8         1922 my @commit = $src->commit_tree( { -STDIN => $this_message }, $tree, map +( '-p' => $_), @parents );
166              
167             ### @commit
168 8         84640 $src->update_ref( 'refs/heads/' . $target_branch, $commit[0] );
169             }
170              
171             sub _create_tree {
172 24     24   159 my ($self, $repo, $fs_obj) = @_;
173              
174             ### called with: "$fs_obj"
175 24 100       185 if (!$fs_obj->is_dir) {
176              
177 16         686 my ($sha) = $repo->hash_object({ w => 1 }, "$fs_obj");
178             ### hashed: "$sha $fs_obj"
179 16         164287 return $sha;
180             }
181              
182 8         252 my @entries;
183 8         137 for my $obj ($fs_obj->children) {
184              
185             ### working on: "$obj"
186 16         1622 my $sha = $self->_create_tree($repo, $obj);
187 16         408 my $mode = sprintf('%o', $obj->stat->mode); # $obj->is_dir ? '040000' : '
188 16 50       38317 my $type = $obj->is_dir ? 'tree' : 'blob';
189 16         869 my $name = $obj->basename;
190              
191 16         2305 push @entries, "$mode $type $sha\t$name";
192             }
193              
194             ### @entries
195              
196 8         546 my ($sha) = $repo->mktree({ -STDIN => join("\n", @entries, q{}) });
197              
198 8         79418 return $sha;
199             }
200              
201             __PACKAGE__->meta->make_immutable;
202             1;
203              
204             __END__
205              
206             =pod
207              
208             =encoding UTF-8
209              
210             =head1 NAME
211              
212             Dist::Zilla::Plugin::Git::CommitBuild - Check in build results on separate branch
213              
214             =head1 VERSION
215              
216             version 2.048
217              
218             =head1 SYNOPSIS
219              
220             In your F<dist.ini>:
221              
222             [Git::CommitBuild]
223             ; these are the defaults
224             branch = build/%b
225             message = Build results of %h (on %b)
226             multiple_inheritance = 0
227              
228             =head1 DESCRIPTION
229              
230             Once the build is done, this plugin will commit the results of the
231             build to a branch that is completely separate from your regular code
232             branches (i.e. with a different root commit). This potentially makes
233             your repository more useful to those who may not have L<Dist::Zilla>
234             and all of its dependencies installed.
235              
236             The plugin accepts the following options:
237              
238             =over 4
239              
240             =item * branch - L<String::Formatter> string for where to commit the
241             build contents.
242              
243             A single formatting code (C<%b>) is defined for this attribute and will be
244             substituted with the name of the current branch in your git repository.
245              
246             Defaults to C<build/%b>, but if set explicitly to an empty string
247             causes no build contents checkin to be made.
248              
249             =item * release_branch - L<String::Formatter> string for where to commit the
250             build contents
251              
252             Same as C<branch>, but commit the build content only after a release. No
253             default, meaning no release branch.
254              
255             =item * message - L<String::Formatter> string for what commit message
256             to use when committing the results of the build.
257              
258             This option supports five formatting codes:
259              
260             =over 4
261              
262             =item * C<%b> - Name of the current branch
263              
264             =item * C<%H> - Commit hash
265              
266             =item * C<%h> - Abbreviated commit hash
267              
268             =item * C<%v> - The release version number
269              
270             =item * C<%V> - The release version number, but with a leading C<v> removed
271             if it exists
272              
273             =item * C<%t> - The string "-TRIAL" if this is a trial release
274              
275             =back
276              
277             =item * release_message - L<String::Formatter> string for what
278             commit message to use when committing the results of the release.
279              
280             Defaults to the same as C<message>.
281              
282             =item * multiple_inheritance - Indicates whether the commit containing
283             the build results should have the source commit as a parent.
284              
285             If false (the default), the build branch will be completely separate
286             from the regular code branches. If set to a true value, commits on a
287             build branch will have two parents: the previous build commit and the
288             source commit from which the build was generated.
289              
290             =back
291              
292             =for Pod::Coverage after_build
293             after_release
294              
295             =head1 SUPPORT
296              
297             Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Dist-Zilla-Plugin-Git>
298             (or L<bug-Dist-Zilla-Plugin-Git@rt.cpan.org|mailto:bug-Dist-Zilla-Plugin-Git@rt.cpan.org>).
299              
300             There is also a mailing list available for users of this distribution, at
301             L<http://dzil.org/#mailing-list>.
302              
303             There is also an irc channel available for users of this distribution, at
304             L<C<#distzilla> on C<irc.perl.org>|irc://irc.perl.org/#distzilla>.
305              
306             =head1 AUTHOR
307              
308             Jerome Quelin
309              
310             =head1 COPYRIGHT AND LICENCE
311              
312             This software is copyright (c) 2009 by Jerome Quelin.
313              
314             This is free software; you can redistribute it and/or modify it under
315             the same terms as the Perl 5 programming language system itself.
316              
317             =cut