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

use warnings;

package Git::Message;
# ABSTRACT: A Git commit message
$Git::Message::VERSION = '3.4.0';
use v5.16.0;
use utf8;
use Carp;

sub new {
    my ($class, $msg) = @_;

    # We assume that $msg is the contents of a commit message file as
    # returned by Git::Repository::Plugin::GitHooks::read_commit_msg_file,
    # i.e., with whitespace cleaned up.

    # Our first mission is to split it up into blocks of consecutive
    # non-blank lines separated by blank lines. The blocks all end in
    # a newline.

    my @blocks = split /(?<=\n)\n+/, $msg;

    # The message blocks are aggregated in three components: title, body,
    # and footer.

    # The title is the first block, but only if it has a single line.
    # The footer is the last block, but only if it complies with a
    # strict syntax, which we parse later.  The body is comprised by
    # the blocks in the middle, joined by blank lines.  Note that all
    # three components can be defined or not independently.

    my $title = (@blocks && ($blocks[0] =~ tr/\n/\n/) == 1)
        ? shift @blocks
            : undef;

    # Our second mission is to parse the footer as a set of key:value
    # specifications, in the same way that Gerrit's commit-msg hook
    # does (http://goo.gl/tyjri). We parse the footer and populate a
    # hash.

    my %footer = ();

    if (my $footer = pop @blocks) {
        my $key = '';
        my $in_footer_comment = 0;
        foreach (split /^/m, $footer) {
            if ($in_footer_comment) {
                # A footer comment may span multiple lines and we
                # simply keep appending them to what came previously.
                $footer{$key}[-1] .= $_;
                # A line ending in a ']' marks the end of the comment.
                $in_footer_comment = 0 if /\]$/;
            } elsif (/^\[[\w-]+:/i) {
                # A line beginning with '[key:' starts a comment.
                push @{$footer{$key}}, $_;
                $in_footer_comment = 1;
            } elsif (/^([\w-]+):\s*(.*)/i) {
                # This is a key:value line
                $key = lc $1;
                push @{$footer{$key}}, [$1, $2];
            } else {
                # Oops. This is not a valid footer. So, let's push
                # $footer back to @blocks,
                push @blocks, $footer;
                # clean up %footer,
                %footer = ();
                # and break out of the loop.
                last;
            }
        }
        # What should we do if $in_footer_comment is still true here?
        # I think it's too drastic to consider the block a non-footer
        # in this case. But I'm not sure about what to do with the
        # unfinished comment we're reading. For now I'll leave it
        # unfinished there.
    }

    return bless {
        title  => $title,
        body   => @blocks ? join("\n\n", @blocks) : undef,
        footer => \%footer,
    } => $class;
}

sub title {
    my ($self, $title) = @_;
    if (defined $title) {
        $title =~ /^[^\n]+\n$/s
            or croak "A title must be a single line ending in a newline.\n";
        $self->{title} = $title;
    }
    return $self->{title};
}

sub body {
    my ($self, $body) = @_;
    if (defined $body) {
        $body =~ /\n$/s
            or croak "A body must be end in a newline.\n";
        $self->{body} = $body;
    }
    return $self->{body};
}

sub footer {
    my ($self) = @_;

    # Reconstruct the footer. The keys are ordered lexicographically,
    # except that the 'Signed-off-by' key must be the last one.

    my $footer  = $self->{footer};
    return unless %$footer;
    my $foot    = '';
    my @keys;
    if (my $signoff = delete $footer->{'signed-off-by'}) {
        @keys = sort keys %$footer;
        push @keys, 'signed-off-by';
        $footer->{'signed-off-by'} = $signoff;
    } else {
        @keys = sort keys %$footer;
    }
    foreach my $key (@keys) {
        foreach my $line (@{$footer->{$key}}) {
            if (ref $line) {
                $foot .= join(': ', @$line);
            } else {
                $foot .= $line;
            }
            $foot .= "\n";
        }
    }

    return $foot;
}

sub get_footer_keys {
    my ($self) = @_;
    return keys %{$self->{footer}};
}

sub delete_footer_key {
    my ($self, $key) = @_;
    delete $self->{footer}{lc $key};
    return;
}

sub get_footer_values {
    my ($self, $key) = @_;
    if (my $values = $self->{footer}{lc $key}) {
        return map {$_->[1]} grep {ref $_} @$values;
    } else {
        return ();
    }
}

sub add_footer_values {
    my ($self, $key, @values) = @_;
    croak "Malformed footer key: '$key'\n"
        unless $key =~ /^[\w-]+$/i;

    ## no critic (BuiltinFunctions::ProhibitComplexMappings)
    push @{$self->{footer}{lc $key}},
        map { [$key => $_] }
            map { s/\n+$//r } # strip trailing newlines to keep the footer structure
                @values;
    ## use critic

    return;
}

sub as_string {
    my ($self) = @_;

    return join("\n", grep {defined} ($self->title, $self->body, $self->footer));
}


1; # End of Git::Message

__END__