File Coverage

blib/lib/Git/Message.pm
Criterion Covered Total %
statement 57 82 69.5
branch 15 32 46.8
condition 1 3 33.3
subroutine 10 13 76.9
pod 9 9 100.0
total 92 139 66.1


line stmt bran cond sub pod time code
1 2     2   13 use warnings;
  2         4  
  2         126  
2              
3             package Git::Message;
4             # ABSTRACT: A Git commit message
5             $Git::Message::VERSION = '3.5.0';
6 2     2   26 use v5.16.0;
  2         8  
7 2     2   13 use utf8;
  2         3  
  2         12  
8 2     2   56 use Carp;
  2         4  
  2         2549  
9              
10             sub new {
11 2     2 1 10 my ($class, $msg) = @_;
12              
13             # We assume that $msg is the contents of a commit message file as
14             # returned by Git::Repository::Plugin::GitHooks::read_commit_msg_file,
15             # i.e., with whitespace cleaned up.
16              
17             # Our first mission is to split it up into blocks of consecutive
18             # non-blank lines separated by blank lines. The blocks all end in
19             # a newline.
20              
21 2         29 my @blocks = split /(?<=\n)\n+/, $msg;
22              
23             # The message blocks are aggregated in three components: title, body,
24             # and footer.
25              
26             # The title is the first block, but only if it has a single line.
27             # The footer is the last block, but only if it complies with a
28             # strict syntax, which we parse later. The body is comprised by
29             # the blocks in the middle, joined by blank lines. Note that all
30             # three components can be defined or not independently.
31              
32 2 50 33     39 my $title = (@blocks && ($blocks[0] =~ tr/\n/\n/) == 1)
33             ? shift @blocks
34             : undef;
35              
36             # Our second mission is to parse the footer as a set of key:value
37             # specifications, in the same way that Gerrit's commit-msg hook
38             # does (http://goo.gl/tyjri). We parse the footer and populate a
39             # hash.
40              
41 2         9 my %footer = ();
42              
43 2 100       10 if (my $footer = pop @blocks) {
44 1         16 my $key = '';
45 1         7 my $in_footer_comment = 0;
46 1         7 foreach (split /^/m, $footer) {
47 2 50       51 if ($in_footer_comment) {
    50          
    50          
48             # A footer comment may span multiple lines and we
49             # simply keep appending them to what came previously.
50 0         0 $footer{$key}[-1] .= $_;
51             # A line ending in a ']' marks the end of the comment.
52 0 0       0 $in_footer_comment = 0 if /\]$/;
53             } elsif (/^\[[\w-]+:/i) {
54             # A line beginning with '[key:' starts a comment.
55 0         0 push @{$footer{$key}}, $_;
  0         0  
56 0         0 $in_footer_comment = 1;
57             } elsif (/^([\w-]+):\s*(.*)/i) {
58             # This is a key:value line
59 2         10 $key = lc $1;
60 2         9 push @{$footer{$key}}, [$1, $2];
  2         29  
61             } else {
62             # Oops. This is not a valid footer. So, let's push
63             # $footer back to @blocks,
64 0         0 push @blocks, $footer;
65             # clean up %footer,
66 0         0 %footer = ();
67             # and break out of the loop.
68 0         0 last;
69             }
70             }
71             # What should we do if $in_footer_comment is still true here?
72             # I think it's too drastic to consider the block a non-footer
73             # in this case. But I'm not sure about what to do with the
74             # unfinished comment we're reading. For now I'll leave it
75             # unfinished there.
76             }
77              
78 2 50       57 return bless {
79             title => $title,
80             body => @blocks ? join("\n\n", @blocks) : undef,
81             footer => \%footer,
82             } => $class;
83             }
84              
85             sub title {
86 8     8 1 33 my ($self, $title) = @_;
87 8 50       29 if (defined $title) {
88 0 0       0 $title =~ /^[^\n]+\n$/s
89             or croak "A title must be a single line ending in a newline.\n";
90 0         0 $self->{title} = $title;
91             }
92 8         97 return $self->{title};
93             }
94              
95             sub body {
96 4     4 1 13 my ($self, $body) = @_;
97 4 50       15 if (defined $body) {
98 0 0       0 $body =~ /\n$/s
99             or croak "A body must be end in a newline.\n";
100 0         0 $self->{body} = $body;
101             }
102 4         17 return $self->{body};
103             }
104              
105             sub footer {
106 4     4 1 8 my ($self) = @_;
107              
108             # Reconstruct the footer. The keys are ordered lexicographically,
109             # except that the 'Signed-off-by' key must be the last one.
110              
111 4         15 my $footer = $self->{footer};
112 4 100       19 return unless %$footer;
113 3         17 my $foot = '';
114 3         13 my @keys;
115 3 100       41 if (my $signoff = delete $footer->{'signed-off-by'}) {
116 2         14 @keys = sort keys %$footer;
117 2         7 push @keys, 'signed-off-by';
118 2         15 $footer->{'signed-off-by'} = $signoff;
119             } else {
120 1         8 @keys = sort keys %$footer;
121             }
122 3         20 foreach my $key (@keys) {
123 4         17 foreach my $line (@{$footer->{$key}}) {
  4         18  
124 6 50       28 if (ref $line) {
125 6         31 $foot .= join(': ', @$line);
126             } else {
127 0         0 $foot .= $line;
128             }
129 6         16 $foot .= "\n";
130             }
131             }
132              
133 3         15 return $foot;
134             }
135              
136             sub get_footer_keys {
137 0     0 1 0 my ($self) = @_;
138 0         0 return keys %{$self->{footer}};
  0         0  
139             }
140              
141             sub delete_footer_key {
142 0     0 1 0 my ($self, $key) = @_;
143 0         0 delete $self->{footer}{lc $key};
144 0         0 return;
145             }
146              
147             sub get_footer_values {
148 0     0 1 0 my ($self, $key) = @_;
149 0 0       0 if (my $values = $self->{footer}{lc $key}) {
150 0         0 return map {$_->[1]} grep {ref $_} @$values;
  0         0  
  0         0  
151             } else {
152 0         0 return ();
153             }
154             }
155              
156             sub add_footer_values {
157 2     2 1 28324 my ($self, $key, @values) = @_;
158 2 50       44 croak "Malformed footer key: '$key'\n"
159             unless $key =~ /^[\w-]+$/i;
160              
161             ## no critic (BuiltinFunctions::ProhibitComplexMappings)
162 2         30 push @{$self->{footer}{lc $key}},
163 2         14 map { [$key => $_] }
164 2         8 map { s/\n+$//r } # strip trailing newlines to keep the footer structure
  2         15  
165             @values;
166             ## use critic
167              
168 2         14 return;
169             }
170              
171             sub as_string {
172 4     4 1 24 my ($self) = @_;
173              
174 4         33 return join("\n", grep {defined} ($self->title, $self->body, $self->footer));
  11         123  
175             }
176              
177            
178             1; # End of Git::Message
179              
180             __END__