File Coverage

blib/lib/Git/Database/Object/Commit.pm
Criterion Covered Total %
statement 62 67 92.5
branch 12 20 60.0
condition 7 9 77.7
subroutine 12 12 100.0
pod 2 3 66.6
total 95 111 85.5


line stmt bran cond sub pod time code
1             package Git::Database::Object::Commit;
2             $Git::Database::Object::Commit::VERSION = '0.012';
3 8     8   7045 use Git::Database::Actor;
  8         25  
  8         231  
4 8     8   6950 use DateTime;
  8         3500256  
  8         417  
5 8     8   93 use Encode qw( decode );
  8         18  
  8         539  
6              
7 8     8   55 use Moo;
  8         15  
  8         78  
8 8     8   3010 use namespace::clean;
  8         21  
  8         73  
9              
10             with 'Git::Database::Role::Object';
11              
12 801     801 1 155477 sub kind {'commit'}
13              
14             has commit_info => (
15             is => 'rwp',
16             required => 0,
17             predicate => 1,
18             lazy => 1,
19             builder => 1,
20             );
21              
22             sub BUILD {
23 544     544 0 290118 my ($self) = @_;
24 544 100 100     16109 die "One of 'digest' or 'content' or 'commit_info' is required"
25             if !$self->has_digest && !$self->has_content && !$self->has_commit_info;
26             }
27              
28             for my $attr (
29             qw(
30             tree_digest
31             author
32             author_date
33             committer
34             committer_date
35             comment
36             encoding
37             )
38             )
39             {
40 8     8   3217 no strict 'refs';
  8         22  
  8         6970  
41 1280     1280   28982 *$attr = sub { $_[0]->commit_info->{$attr} };
42             }
43              
44 160   50 160 1 362 sub parents_digest { @{ $_[0]->commit_info->{parents_digest} ||= [] }; }
  160         3173  
45              
46             sub _build_content {
47 258     258   4713 my ($self) = @_;
48              
49 258 100       1719 if ( !$self->has_commit_info ) {
50 98         681 my $attr = $self->_get_object_attributes();
51 84 50       2422 return $attr->{content} if exists $attr->{content};
52              
53 0 0       0 if ( exists $attr->{commit_info} ) {
54 0         0 $self->_set_commit_info( $attr->{commit_info} );
55             }
56             else {
57 0         0 die "Can't build content from these attributes: "
58             . join( ', ', sort keys %$attr );
59             }
60             }
61              
62 160         1004 my $content = 'tree ' . $self->tree_digest . "\n";
63 160         3011 $content .= "parent $_\n" for $self->parents_digest;
64 160         2786 $content .= join(
65             ' ',
66             author => $self->author->ident,
67             $self->author_date->epoch,
68             DateTime::TimeZone->offset_as_string( $self->author_date->offset )
69             ) . "\n";
70 160         23604 $content .= join(
71             ' ',
72             committer => $self->committer->ident,
73             $self->committer_date->epoch,
74             DateTime::TimeZone->offset_as_string( $self->committer_date->offset )
75             ) . "\n";
76 160         13865 $content .= "\n";
77 160         700 my $comment = $self->comment;
78 160         1745 chomp $comment;
79 160         764 $content .= "$comment\n";
80              
81 160         2888 return $content;
82             }
83              
84             sub _build_commit_info {
85 215     215   17666 my ($self) = @_;
86              
87 215 100       1620 if ( !$self->has_content ) {
88 35         240 my $attr = $self->_get_object_attributes();
89 28 50       372 return $attr->{commit_info} if exists $attr->{commit_info};
90              
91 28 50       215 if ( exists $attr->{content} ) {
92 28         256 $self->_set_content( $attr->{content} );
93             }
94             else {
95 0         0 die "Can't build content from these attributes: "
96             . join( ', ', sort keys %$attr );
97             }
98             }
99              
100 208         5176 my @lines = split "\n", $self->content;
101              
102             # parse the headers
103 208         3412 my %header;
104 208         686 my $mergetag_num = 0;
105 208         1843 while ( my $line = shift @lines ) {
106 780         3094 my ( $key, $value ) = split / /, $line, 2;
107              
108             # multiline value that may appear multiple times
109 780 50       2126 $key = $mergetag_num++ . $key if $key eq 'mergetag';
110              
111             # each key points to an array ref
112 780         1158 push @{ $header{$key} }, $value;
  780         4491  
113              
114             # handle continuation lines
115 780 50       3962 $header{''} = $header{$key} if $key;
116             }
117 208         874 delete $header{''};
118              
119             # construct commit_info from the header values
120             my %commit_info = (
121              
122             # those appear once and only once
123             tree_digest => ( delete $header{tree} )->[0],
124             author => ( delete $header{author} )->[0],
125             committer => ( delete $header{committer} )->[0],
126              
127             # may appear zero or one time (with a default value)
128             encoding => ( delete $header{encoding} || ['utf-8'] )->[0],
129              
130             # optional list
131 208   50     7183 parents_digest => delete $header{parent} || [],
      100        
132             );
133              
134             # we should have processed all possible keys at this stage
135 208 50       1835 die "Unknown commit keys: @{[ keys %header ]}"
  0         0  
136             if keys %header;
137              
138             # the message is made of the remaining lines
139             $commit_info{comment} =
140 208         3098 decode( $commit_info{encoding}, join "\n", @lines );
141              
142             # instantiate actors and datetimes
143 208         23872 for my $key (qw( author committer )) {
144 416         258636 my @data = split ' ', $commit_info{$key};
145 416         1973 my ( $email, $epoch, $tz ) = splice( @data, -3 );
146 416         14144 $commit_info{$key} = Git::Database::Actor->new(
147             name => join( ' ', @data ),
148             email => substr( $email, 1, -1 ),
149             );
150 416         17757 $commit_info{"${key}_date"} = DateTime->from_epoch(
151             epoch => $epoch,
152             time_zone => $tz
153             );
154             }
155              
156 208         148722 return \%commit_info;
157             }
158              
159             1;
160              
161             __END__
162              
163             =pod
164              
165             =for Pod::Coverage
166             BUILD
167             has_commit_info
168              
169             =head1 NAME
170              
171             Git::Database::Object::Commit - A commit object in the Git object database
172              
173             =head1 VERSION
174              
175             version 0.012
176              
177             =head1 SYNOPSIS
178              
179             my $r = Git::Database->new(); # current Git repository
180             my $commit = $r->get_object('ef25e8'); # abbreviated digest
181              
182             # attributes
183             $commit->kind; # commit
184             $commit->digest; # ef25e81ba86b7df16956c974c8a9c1ff2eca1326
185             $commit->tree_digest; # b52168be5ea341e918a9cbbb76012375170a439f
186             $commit->parents_digest; # []
187             ...; # etc., see below
188              
189             =head1 DESCRIPTION
190              
191             Git::Database::Object::Commit represents a C<commit> object
192             obtained via L<Git::Database> from a Git object database.
193              
194             =head1 ATTRIBUTES
195              
196             All major attributes (L</digest>, L</content>, L</size>, L</commit_info>)
197             have a predicate method.
198              
199             =head2 kind
200              
201             The object kind: C<commit>.
202              
203             =head2 digest
204              
205             The SHA-1 digest of the commit object.
206              
207             =head2 content
208              
209             The object's actual content.
210              
211             =head2 size
212              
213             The size (in bytes) of the object content.
214              
215             =head2 commit_info
216              
217             A hash reference containing the all the attributes listed below, as
218             values for the keys with the same names.
219              
220             =head2 tree_digest
221              
222             The SHA-1 digest of the tree object corresponding to the commit.
223              
224             =head2 parents_digest
225              
226             An array reference containing the list of SHA-1 digests of the
227             commit's parents.
228              
229             =head2 author
230              
231             A L<Git::Database::Actor> object representing the author of
232             the commit.
233              
234             =head2 author_date
235              
236             A L<DateTime> object representing the date at which the author
237             created the commit.
238              
239             =head2 committer
240              
241             A L<Git::Database::Actor> object representing the committer of
242             the commit.
243              
244             =head2 committer_date
245              
246             A L<DateTime> object representing the date at which the committer
247             created the commit.
248              
249             =head2 comment
250              
251             The text of the commit message.
252              
253             =head2 encoding
254              
255             The encoding of the commit message.
256              
257             =head1 METHODS
258              
259             =head2 new()
260              
261             Create a new Git::Object::Database::Commit object.
262              
263             One (and only one) of the C<content> or C<commit_info> arguments is
264             required.
265              
266             C<commit_info> is a reference to a hash containing the keys listed
267             above, i.e. C<tree_digest>, C<parents_digest> (optional), C<author>,
268             C<author_date>, C<committer>, C<committer_date>, C<comment>, and
269             C<encoding> (optional).
270              
271             =head1 SEE ALSO
272              
273             L<Git::Database>,
274             L<Git::Database::Role::Object>.
275              
276             =head1 AUTHOR
277              
278             Philippe Bruhat (BooK) <book@cpan.org>.
279              
280             =head1 COPYRIGHT
281              
282             Copyright 2013-2016 Philippe Bruhat (BooK), all rights reserved.
283              
284             =head1 LICENSE
285              
286             This program is free software; you can redistribute it and/or modify it
287             under the same terms as Perl itself.
288              
289             =cut