| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package App::GitHooks::CommitMessage; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 12 |  |  | 12 |  | 21329 | use strict; | 
|  | 12 |  |  |  |  | 18 |  | 
|  | 12 |  |  |  |  | 419 |  | 
| 4 | 12 |  |  | 12 |  | 51 | use warnings; | 
|  | 12 |  |  |  |  | 17 |  | 
|  | 12 |  |  |  |  | 287 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 |  |  |  |  |  |  | # External dependencies. | 
| 7 | 12 |  |  | 12 |  | 48 | use Carp; | 
|  | 12 |  |  |  |  | 14 |  | 
|  | 12 |  |  |  |  | 720 |  | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | # Internal dependencies. | 
| 10 | 12 |  |  | 12 |  | 4338 | use App::GitHooks::Utils; | 
|  | 12 |  |  |  |  | 88 |  | 
|  | 12 |  |  |  |  | 300 |  | 
| 11 | 12 |  |  | 12 |  | 6281 | use Data::Validate::Type; | 
|  | 12 |  |  |  |  | 97884 |  | 
|  | 12 |  |  |  |  | 8004 |  | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  |  | 
| 14 |  |  |  |  |  |  | =head1 NAME | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | App::GitHooks::CommitMessage - A git commit message. | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | =head1 VERSION | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | Version 1.7.3 | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | =cut | 
| 24 |  |  |  |  |  |  |  | 
| 25 |  |  |  |  |  |  | our $VERSION = '1.7.3'; | 
| 26 |  |  |  |  |  |  |  | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  | =head1 METHODS | 
| 29 |  |  |  |  |  |  |  | 
| 30 |  |  |  |  |  |  | =head2 new() | 
| 31 |  |  |  |  |  |  |  | 
| 32 |  |  |  |  |  |  | my $commit_message = App::GitHooks::CommitMessage->new( | 
| 33 |  |  |  |  |  |  | app     => $app, | 
| 34 |  |  |  |  |  |  | message => $message, | 
| 35 |  |  |  |  |  |  | ); | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  | Arguments: | 
| 38 |  |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  | =over 4 | 
| 40 |  |  |  |  |  |  |  | 
| 41 |  |  |  |  |  |  | =item * app I<(mandatory)> | 
| 42 |  |  |  |  |  |  |  | 
| 43 |  |  |  |  |  |  | An C instance. | 
| 44 |  |  |  |  |  |  |  | 
| 45 |  |  |  |  |  |  | =item * message I<(mandatory)> | 
| 46 |  |  |  |  |  |  |  | 
| 47 |  |  |  |  |  |  | The commit message. | 
| 48 |  |  |  |  |  |  |  | 
| 49 |  |  |  |  |  |  | =back | 
| 50 |  |  |  |  |  |  |  | 
| 51 |  |  |  |  |  |  | =cut | 
| 52 |  |  |  |  |  |  |  | 
| 53 |  |  |  |  |  |  | sub new | 
| 54 |  |  |  |  |  |  | { | 
| 55 | 21 |  |  | 21 | 1 | 334112 | my ( $class, %args ) = @_; | 
| 56 | 21 |  |  |  |  | 84 | my $message = delete( $args{'message'} ); | 
| 57 | 21 |  |  |  |  | 46 | my $app = delete( $args{'app'} ); | 
| 58 |  |  |  |  |  |  |  | 
| 59 |  |  |  |  |  |  | # Check arguments. | 
| 60 | 21 | 100 |  |  |  | 96 | croak 'A "message" argument is mandatory' | 
| 61 |  |  |  |  |  |  | if !defined( $message ); | 
| 62 | 20 | 100 |  |  |  | 114 | croak 'An "app" argument is mandatory' | 
| 63 |  |  |  |  |  |  | if !Data::Validate::Type::is_instance( $app, class => 'App::GitHooks' ); | 
| 64 | 19 | 50 |  |  |  | 545 | croak 'Unknown arguments: ' . join( ', ', keys( %args ) ) | 
| 65 |  |  |  |  |  |  | if scalar( keys %args ) != 0; | 
| 66 |  |  |  |  |  |  |  | 
| 67 |  |  |  |  |  |  | # Create a new instance. | 
| 68 | 19 |  |  |  |  | 164 | return bless( | 
| 69 |  |  |  |  |  |  | { | 
| 70 |  |  |  |  |  |  | message          => $message, | 
| 71 |  |  |  |  |  |  | original_message => $message, | 
| 72 |  |  |  |  |  |  | app              => $app, | 
| 73 |  |  |  |  |  |  | }, | 
| 74 |  |  |  |  |  |  | $class, | 
| 75 |  |  |  |  |  |  | ); | 
| 76 |  |  |  |  |  |  | } | 
| 77 |  |  |  |  |  |  |  | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | =head2 update_message() | 
| 80 |  |  |  |  |  |  |  | 
| 81 |  |  |  |  |  |  | Update the commit message. | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | my $success = $commit_message->update_message( $new_message ); | 
| 84 |  |  |  |  |  |  |  | 
| 85 |  |  |  |  |  |  | =cut | 
| 86 |  |  |  |  |  |  |  | 
| 87 |  |  |  |  |  |  | sub update_message | 
| 88 |  |  |  |  |  |  | { | 
| 89 | 2 |  |  | 2 | 1 | 60 | my ( $self, $message ) = @_; | 
| 90 |  |  |  |  |  |  |  | 
| 91 |  |  |  |  |  |  | # Update the message. | 
| 92 | 2 |  |  |  |  | 5 | $self->{'message'} = $message; | 
| 93 |  |  |  |  |  |  |  | 
| 94 |  |  |  |  |  |  | # Remove various caches. | 
| 95 | 2 |  |  |  |  | 9 | delete( $self->{'lines'} ); | 
| 96 | 2 |  |  |  |  | 6 | delete( $self->{'ticket_id'} ); | 
| 97 |  |  |  |  |  |  |  | 
| 98 | 2 |  |  |  |  | 10 | return 1; | 
| 99 |  |  |  |  |  |  | } | 
| 100 |  |  |  |  |  |  |  | 
| 101 |  |  |  |  |  |  |  | 
| 102 |  |  |  |  |  |  | =head2 get_lines() | 
| 103 |  |  |  |  |  |  |  | 
| 104 |  |  |  |  |  |  | Return an arrayref of the lines that will be included in the commit message, | 
| 105 |  |  |  |  |  |  | excluding blank lines and comments. | 
| 106 |  |  |  |  |  |  |  | 
| 107 |  |  |  |  |  |  | my $lines = $commit_message->get_lines( | 
| 108 |  |  |  |  |  |  | include_comments    => $include_comments,    # default: 0 | 
| 109 |  |  |  |  |  |  | include_blank_lines => $include_blank_lines, # default: 1 | 
| 110 |  |  |  |  |  |  | ); | 
| 111 |  |  |  |  |  |  |  | 
| 112 |  |  |  |  |  |  | =cut | 
| 113 |  |  |  |  |  |  |  | 
| 114 |  |  |  |  |  |  | sub get_lines | 
| 115 |  |  |  |  |  |  | { | 
| 116 | 13 |  |  | 13 | 1 | 46 | my ( $self, %args ) = @_; | 
| 117 | 13 |  | 50 |  |  | 46 | my $include_comments = delete( $args{'include_comments'} ) // 0; | 
| 118 | 13 |  | 50 |  |  | 38 | my $include_blank_lines = delete( $args{'include_blank_lines'} ) // 1; | 
| 119 |  |  |  |  |  |  |  | 
| 120 | 13 |  |  |  |  | 37 | my $message = $self->get_message(); | 
| 121 |  |  |  |  |  |  |  | 
| 122 | 13 |  | 50 |  |  | 62 | my @lines = split( /\n/, $message // '' ); | 
| 123 | 13 | 100 |  |  |  | 38 | @lines = grep { $_ !~ /^#/ } @lines | 
|  | 27 |  |  |  |  | 74 |  | 
| 124 |  |  |  |  |  |  | if !$include_comments; | 
| 125 | 13 | 100 |  |  |  | 35 | @lines = grep { $_ !~ /^\s*$/ } @lines | 
|  | 15 |  |  |  |  | 846 |  | 
| 126 |  |  |  |  |  |  | if !$include_blank_lines; | 
| 127 |  |  |  |  |  |  |  | 
| 128 | 13 |  |  |  |  | 40 | return \@lines; | 
| 129 |  |  |  |  |  |  | } | 
| 130 |  |  |  |  |  |  |  | 
| 131 |  |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | =head2 get_summary() | 
| 133 |  |  |  |  |  |  |  | 
| 134 |  |  |  |  |  |  | Return the first line of the commit message. | 
| 135 |  |  |  |  |  |  |  | 
| 136 |  |  |  |  |  |  | my $summary = $commit_message->get_summary(); | 
| 137 |  |  |  |  |  |  |  | 
| 138 |  |  |  |  |  |  | =cut | 
| 139 |  |  |  |  |  |  |  | 
| 140 |  |  |  |  |  |  | sub get_summary | 
| 141 |  |  |  |  |  |  | { | 
| 142 | 1 |  |  | 1 | 1 | 4 | my ( $self ) = @_; | 
| 143 | 1 |  |  |  |  | 7 | my $lines = $self->get_lines( | 
| 144 |  |  |  |  |  |  | include_comments    => 0, | 
| 145 |  |  |  |  |  |  | include_blank_lines => 1, | 
| 146 |  |  |  |  |  |  | ); | 
| 147 |  |  |  |  |  |  |  | 
| 148 | 1 | 50 |  |  |  | 13 | return scalar( @$lines ) == 0 | 
| 149 |  |  |  |  |  |  | ? undef | 
| 150 |  |  |  |  |  |  | : $lines->[0]; | 
| 151 |  |  |  |  |  |  | } | 
| 152 |  |  |  |  |  |  |  | 
| 153 |  |  |  |  |  |  |  | 
| 154 |  |  |  |  |  |  | =head2 is_empty() | 
| 155 |  |  |  |  |  |  |  | 
| 156 |  |  |  |  |  |  | Indicate whether a commit message is empty, after excluding comment lines and | 
| 157 |  |  |  |  |  |  | blank lines. | 
| 158 |  |  |  |  |  |  |  | 
| 159 |  |  |  |  |  |  | my $is_empty = $commit_message->is_empty(); | 
| 160 |  |  |  |  |  |  |  | 
| 161 |  |  |  |  |  |  | =cut | 
| 162 |  |  |  |  |  |  |  | 
| 163 |  |  |  |  |  |  | sub is_empty | 
| 164 |  |  |  |  |  |  | { | 
| 165 | 4 |  |  | 4 | 1 | 7 | my ( $self ) = @_; | 
| 166 | 4 |  |  |  |  | 14 | my $lines = $self->get_lines( | 
| 167 |  |  |  |  |  |  | include_comments    => 0, | 
| 168 |  |  |  |  |  |  | include_blank_lines => 0, | 
| 169 |  |  |  |  |  |  | ); | 
| 170 |  |  |  |  |  |  |  | 
| 171 | 4 | 100 |  |  |  | 23 | return scalar( @$lines ) == 0 | 
| 172 |  |  |  |  |  |  | ? 1 | 
| 173 |  |  |  |  |  |  | : 0; | 
| 174 |  |  |  |  |  |  | } | 
| 175 |  |  |  |  |  |  |  | 
| 176 |  |  |  |  |  |  |  | 
| 177 |  |  |  |  |  |  | =head2 get_ticket_id() | 
| 178 |  |  |  |  |  |  |  | 
| 179 |  |  |  |  |  |  | Extract and return a ticket ID from the commit message. | 
| 180 |  |  |  |  |  |  |  | 
| 181 |  |  |  |  |  |  | my $ticket_id = $commit_message->get_ticket_id(); | 
| 182 |  |  |  |  |  |  |  | 
| 183 |  |  |  |  |  |  | =cut | 
| 184 |  |  |  |  |  |  |  | 
| 185 |  |  |  |  |  |  | sub get_ticket_id | 
| 186 |  |  |  |  |  |  | { | 
| 187 | 0 |  |  | 0 | 1 | 0 | my ( $self ) = @_; | 
| 188 | 0 |  |  |  |  | 0 | my $message = $self->get_message(); | 
| 189 | 0 |  |  |  |  | 0 | my $app = $self->get_app(); | 
| 190 |  |  |  |  |  |  |  | 
| 191 | 0 | 0 |  |  |  | 0 | if ( !defined( $self->{'ticket_id'} ) ) | 
| 192 |  |  |  |  |  |  | { | 
| 193 |  |  |  |  |  |  | # Get regex to extract the ticket ID. | 
| 194 | 0 |  |  |  |  | 0 | my $ticket_regex = App::GitHooks::Utils::get_ticket_id_from_commit_regex( $app ); | 
| 195 |  |  |  |  |  |  |  | 
| 196 |  |  |  |  |  |  | # Parse the first line of the commit message. | 
| 197 | 0 |  |  |  |  | 0 | my $summary = $self->get_summary(); | 
| 198 | 0 |  |  |  |  | 0 | my ( $ticket_id ) = $summary =~ /$ticket_regex/i; | 
| 199 | 0 |  |  |  |  | 0 | $self->{'ticket_id'} = $ticket_id; | 
| 200 |  |  |  |  |  |  | } | 
| 201 |  |  |  |  |  |  |  | 
| 202 | 0 |  |  |  |  | 0 | return $self->{'ticket_id'}; | 
| 203 |  |  |  |  |  |  | } | 
| 204 |  |  |  |  |  |  |  | 
| 205 |  |  |  |  |  |  |  | 
| 206 |  |  |  |  |  |  | =head2 has_changed() | 
| 207 |  |  |  |  |  |  |  | 
| 208 |  |  |  |  |  |  | Return whether the message has changed since the object was created. | 
| 209 |  |  |  |  |  |  |  | 
| 210 |  |  |  |  |  |  | my $has_changed = $commit_message->has_changed(); | 
| 211 |  |  |  |  |  |  |  | 
| 212 |  |  |  |  |  |  | =cut | 
| 213 |  |  |  |  |  |  |  | 
| 214 |  |  |  |  |  |  | sub has_changed | 
| 215 |  |  |  |  |  |  | { | 
| 216 | 2 |  |  | 2 | 1 | 5 | my ( $self ) = @_; | 
| 217 | 2 |  |  |  |  | 5 | my $message = $self->get_message(); | 
| 218 | 2 |  |  |  |  | 7 | my $original_message = $self->get_original_message(); | 
| 219 |  |  |  |  |  |  |  | 
| 220 |  |  |  |  |  |  | # If the defineness status doesn't match, it's definitely a change. | 
| 221 | 2 | 50 | 25 |  |  | 17 | return 1 | 
| 222 |  |  |  |  |  |  | if defined( $message ) xor defined( $original_message ); | 
| 223 |  |  |  |  |  |  |  | 
| 224 |  |  |  |  |  |  | # If both are undefined, there's no change. | 
| 225 | 2 | 0 | 33 |  |  | 5 | return 0 | 
| 226 |  |  |  |  |  |  | if !defined( $message ) && !defined( $original_message ); | 
| 227 |  |  |  |  |  |  |  | 
| 228 |  |  |  |  |  |  | # Both are defined, and we need to compare the messages. | 
| 229 | 2 | 100 |  |  |  | 12 | return $message eq $original_message ? 0 : 1; | 
| 230 |  |  |  |  |  |  | } | 
| 231 |  |  |  |  |  |  |  | 
| 232 |  |  |  |  |  |  |  | 
| 233 |  |  |  |  |  |  | =head1 ACCESSORS | 
| 234 |  |  |  |  |  |  |  | 
| 235 |  |  |  |  |  |  | =head2 get_original_message() | 
| 236 |  |  |  |  |  |  |  | 
| 237 |  |  |  |  |  |  | Return the original message that was provided when the object was created. | 
| 238 |  |  |  |  |  |  |  | 
| 239 |  |  |  |  |  |  | my $original_message = $commit_message->get_original_message(); | 
| 240 |  |  |  |  |  |  |  | 
| 241 |  |  |  |  |  |  | =cut | 
| 242 |  |  |  |  |  |  |  | 
| 243 |  |  |  |  |  |  | sub get_original_message | 
| 244 |  |  |  |  |  |  | { | 
| 245 | 3 |  |  | 3 | 1 | 9 | my ( $self ) = @_; | 
| 246 |  |  |  |  |  |  |  | 
| 247 | 3 |  |  |  |  | 14 | return $self->{'original_message'}; | 
| 248 |  |  |  |  |  |  | } | 
| 249 |  |  |  |  |  |  |  | 
| 250 |  |  |  |  |  |  |  | 
| 251 |  |  |  |  |  |  | =head2 get_message() | 
| 252 |  |  |  |  |  |  |  | 
| 253 |  |  |  |  |  |  | Return the commit message itself. | 
| 254 |  |  |  |  |  |  |  | 
| 255 |  |  |  |  |  |  | my $message = $commit_message->get_message(); | 
| 256 |  |  |  |  |  |  |  | 
| 257 |  |  |  |  |  |  | =cut | 
| 258 |  |  |  |  |  |  |  | 
| 259 |  |  |  |  |  |  | sub get_message | 
| 260 |  |  |  |  |  |  | { | 
| 261 | 18 |  |  | 18 | 1 | 30 | my ( $self ) = @_; | 
| 262 |  |  |  |  |  |  |  | 
| 263 | 18 |  |  |  |  | 67 | return $self->{'message'}; | 
| 264 |  |  |  |  |  |  | } | 
| 265 |  |  |  |  |  |  |  | 
| 266 |  |  |  |  |  |  |  | 
| 267 |  |  |  |  |  |  | =head2 get_app() | 
| 268 |  |  |  |  |  |  |  | 
| 269 |  |  |  |  |  |  | Return the parent C object. | 
| 270 |  |  |  |  |  |  |  | 
| 271 |  |  |  |  |  |  | my $app = $commit_message->get_app(); | 
| 272 |  |  |  |  |  |  |  | 
| 273 |  |  |  |  |  |  | =cut | 
| 274 |  |  |  |  |  |  |  | 
| 275 |  |  |  |  |  |  | sub get_app | 
| 276 |  |  |  |  |  |  | { | 
| 277 | 1 |  |  | 1 | 1 | 46 | my ( $self ) = @_; | 
| 278 |  |  |  |  |  |  |  | 
| 279 | 1 |  |  |  |  | 9 | return $self->{'app'}; | 
| 280 |  |  |  |  |  |  | } | 
| 281 |  |  |  |  |  |  |  | 
| 282 |  |  |  |  |  |  |  | 
| 283 |  |  |  |  |  |  | =head1 BUGS | 
| 284 |  |  |  |  |  |  |  | 
| 285 |  |  |  |  |  |  | Please report any bugs or feature requests through the web interface at | 
| 286 |  |  |  |  |  |  | L. | 
| 287 |  |  |  |  |  |  | I will be notified, and then you'll automatically be notified of progress on | 
| 288 |  |  |  |  |  |  | your bug as I make changes. | 
| 289 |  |  |  |  |  |  |  | 
| 290 |  |  |  |  |  |  |  | 
| 291 |  |  |  |  |  |  | =head1 SUPPORT | 
| 292 |  |  |  |  |  |  |  | 
| 293 |  |  |  |  |  |  | You can find documentation for this module with the perldoc command. | 
| 294 |  |  |  |  |  |  |  | 
| 295 |  |  |  |  |  |  | perldoc App::GitHooks::CommitMessage | 
| 296 |  |  |  |  |  |  |  | 
| 297 |  |  |  |  |  |  |  | 
| 298 |  |  |  |  |  |  | You can also look for information at: | 
| 299 |  |  |  |  |  |  |  | 
| 300 |  |  |  |  |  |  | =over | 
| 301 |  |  |  |  |  |  |  | 
| 302 |  |  |  |  |  |  | =item * GitHub's request tracker | 
| 303 |  |  |  |  |  |  |  | 
| 304 |  |  |  |  |  |  | L | 
| 305 |  |  |  |  |  |  |  | 
| 306 |  |  |  |  |  |  | =item * AnnoCPAN: Annotated CPAN documentation | 
| 307 |  |  |  |  |  |  |  | 
| 308 |  |  |  |  |  |  | L | 
| 309 |  |  |  |  |  |  |  | 
| 310 |  |  |  |  |  |  | =item * CPAN Ratings | 
| 311 |  |  |  |  |  |  |  | 
| 312 |  |  |  |  |  |  | L | 
| 313 |  |  |  |  |  |  |  | 
| 314 |  |  |  |  |  |  | =item * MetaCPAN | 
| 315 |  |  |  |  |  |  |  | 
| 316 |  |  |  |  |  |  | L | 
| 317 |  |  |  |  |  |  |  | 
| 318 |  |  |  |  |  |  | =back | 
| 319 |  |  |  |  |  |  |  | 
| 320 |  |  |  |  |  |  |  | 
| 321 |  |  |  |  |  |  | =head1 AUTHOR | 
| 322 |  |  |  |  |  |  |  | 
| 323 |  |  |  |  |  |  | L, | 
| 324 |  |  |  |  |  |  | C<<  >>. | 
| 325 |  |  |  |  |  |  |  | 
| 326 |  |  |  |  |  |  |  | 
| 327 |  |  |  |  |  |  | =head1 COPYRIGHT & LICENSE | 
| 328 |  |  |  |  |  |  |  | 
| 329 |  |  |  |  |  |  | Copyright 2013-2015 Guillaume Aubert. | 
| 330 |  |  |  |  |  |  |  | 
| 331 |  |  |  |  |  |  | This program is free software: you can redistribute it and/or modify it under | 
| 332 |  |  |  |  |  |  | the terms of the GNU General Public License version 3 as published by the Free | 
| 333 |  |  |  |  |  |  | Software Foundation. | 
| 334 |  |  |  |  |  |  |  | 
| 335 |  |  |  |  |  |  | This program is distributed in the hope that it will be useful, but WITHOUT ANY | 
| 336 |  |  |  |  |  |  | WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A | 
| 337 |  |  |  |  |  |  | PARTICULAR PURPOSE. See the GNU General Public License for more details. | 
| 338 |  |  |  |  |  |  |  | 
| 339 |  |  |  |  |  |  | You should have received a copy of the GNU General Public License along with | 
| 340 |  |  |  |  |  |  | this program. If not, see http://www.gnu.org/licenses/ | 
| 341 |  |  |  |  |  |  |  | 
| 342 |  |  |  |  |  |  | =cut | 
| 343 |  |  |  |  |  |  |  | 
| 344 |  |  |  |  |  |  | 1; |