File Coverage

blib/lib/Dist/Zilla/Plugin/Git/CommitBuild.pm
Criterion Covered Total %
statement 100 104 96.1
branch 7 14 50.0
condition 2 2 100.0
subroutine 24 24 100.0
pod 0 2 0.0
total 133 146 91.1


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   3340265 use 5.008;
  3         13  
10 3     3   23 use strict;
  3         7  
  3         105  
11 3     3   19 use warnings;
  3         7  
  3         290  
12              
13             package Dist::Zilla::Plugin::Git::CommitBuild;
14             # ABSTRACT: Check in build results on separate branch
15              
16             our $VERSION = '2.046';
17              
18 3     3   24 use Git::Wrapper 0.021 (); # need -STDIN
  3         73  
  3         90  
19 3     3   18 use IPC::Open3;
  3         8  
  3         239  
20 3     3   1853 use IPC::System::Simple; # required for Fatalised/autodying system
  3         19140  
  3         164  
21 3     3   29 use File::chdir;
  3         8  
  3         369  
22 3     3   22 use File::Spec::Functions qw/ rel2abs catfile /;
  3         6  
  3         153  
23 3     3   22 use File::Temp;
  3         7  
  3         234  
24 3     3   20 use Moose;
  3         96  
  3         35  
25 3     3   22624 use namespace::autoclean;
  3         8  
  3         34  
26 3     3   254 use Path::Tiny qw();
  3         9  
  3         73  
27 3     3   1764 use Types::Path::Tiny 'Path';
  3         330848  
  3         32  
28 3     3   2970 use MooseX::Has::Sugar;
  3         2508  
  3         16  
29 3     3   351 use Types::Standard qw(Str Bool);
  3         8  
  3         23  
30 3     3   2617 use Cwd qw(abs_path);
  3         8  
  3         154  
31 3     3   21 use Try::Tiny;
  3         6  
  3         543  
32              
33             use String::Formatter (
34             method_stringf => {
35             -as => '_format_branch',
36             codes => {
37 7         1995 b => sub { shift->_source_branch },
38             },
39             },
40             method_stringf => {
41             -as => '_format_message',
42             codes => {
43 7         48163 b => sub { shift->_source_branch },
44 7         2302 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         353 v => sub { shift->zilla->version },
48             }
49             }
50 3     3   1355 );
  3         9487  
  3         61  
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   305 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 108464 my ( $self, $args) = @_;
108              
109             # because the build_root mysteriously change at
110             # the 'after_release' stage
111 7         341 $self->build_root( $args->{build_root} );
112              
113 7         314 $self->_commit_build( $args, $self->branch, $self->message );
114             }
115              
116             sub after_release {
117 1     1 0 155693 my ( $self, $args) = @_;
118              
119 1         67 $self->_commit_build( $args, $self->release_branch, $self->release_message );
120             }
121              
122             sub _commit_build {
123 8     8   58 my ( $self, undef, $branch, $message ) = @_;
124              
125 8 50       63 return unless $branch;
126              
127 8         153 my $dir = Path::Tiny->tempdir( CLEANUP => 1) ;
128 8         7141 my $src = $self->git;
129              
130 8         113 my $target_branch = _format_branch( $branch, $self );
131              
132 8         1273 for my $file ( @{ $self->zilla->files } ) {
  8         433  
133 16 50       1122 my ( $name, $content ) = ( $file->name, (Dist::Zilla->VERSION < 5
134             ? $file->content
135             : $file->encoded_content) );
136 16         3953 my ( $outfile ) = $dir->child( $name );
137 16         1450 $outfile->parent->mkpath();
138 16         3385 $outfile->spew_raw( $content );
139 16 50       8944 chmod $file->mode, "$outfile" or die "couldn't chmod $outfile: $!";
140             }
141              
142             # returns the sha1 of the created tree object
143 8         418 my $tree = $self->_create_tree($src, $dir);
144              
145 8     8   432 my ($last_build_tree) = try { $src->rev_parse("$target_branch^{tree}") };
  8         1093  
146 8   100     56548 $last_build_tree ||= 'none';
147              
148             ### $last_build_tree
149 8 50       102 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         1078 eval { $src->rev_parse({ 'q' => 1, 'verify'=>1}, $_ ) }
  8         57  
  8         231  
159             } $target_branch
160             );
161              
162             ### @parents
163              
164 8         52924 my $this_message = _format_message( $message, $self );
165 8         1536 my @commit = $src->commit_tree( { -STDIN => $this_message }, $tree, map { ( '-p' => $_) } @parents );
  3         136  
166              
167             ### @commit
168 8         60500 $src->update_ref( 'refs/heads/' . $target_branch, $commit[0] );
169             }
170              
171             sub _create_tree {
172 24     24   114 my ($self, $repo, $fs_obj) = @_;
173              
174             ### called with: "$fs_obj"
175 24 100       129 if (!$fs_obj->is_dir) {
176              
177 16         556 my ($sha) = $repo->hash_object({ w => 1 }, "$fs_obj");
178             ### hashed: "$sha $fs_obj"
179 16         123840 return $sha;
180             }
181              
182 8         172 my @entries;
183 8         97 for my $obj ($fs_obj->children) {
184              
185             ### working on: "$obj"
186 16         1561 my $sha = $self->_create_tree($repo, $obj);
187 16         362 my $mode = sprintf('%o', $obj->stat->mode); # $obj->is_dir ? '040000' : '
188 16 50       34406 my $type = $obj->is_dir ? 'tree' : 'blob';
189 16         637 my $name = $obj->basename;
190              
191 16         2114 push @entries, "$mode $type $sha\t$name";
192             }
193              
194             ### @entries
195              
196 8         426 my ($sha) = $repo->mktree({ -STDIN => join("\n", @entries, q{}) });
197              
198 8         55214 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.046
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