package Git::PurePerl::Object::Commit;
use Moose;
use MooseX::StrictConstructor;
use Moose::Util::TypeConstraints;
use Encode qw/decode/;
use namespace::autoclean;
extends 'Git::PurePerl::Object';
has 'kind' =>
( is => 'ro', isa => 'ObjectKind', required => 1, default => 'commit' );
has 'tree_sha1' => ( is => 'rw', isa => 'Str', required => 0 );
has 'parent_sha1s' => ( is => 'rw', isa => 'ArrayRef[Str]', required => 0, default => sub { [] });
has 'author' => ( is => 'rw', isa => 'Git::PurePerl::Actor', required => 0 );
has 'authored_time' => ( is => 'rw', isa => 'DateTime', required => 0 );
has 'committer' =>
( is => 'rw', isa => 'Git::PurePerl::Actor', required => 0 );
has 'committed_time' => ( is => 'rw', isa => 'DateTime', required => 0 );
has 'comment' => ( is => 'rw', isa => 'Str', required => 0 );
has 'encoding' => ( is => 'rw', isa => 'Str', required => 0 );
my %method_map = (
'tree' => 'tree_sha1',
'parent' => '_push_parent_sha1',
'author' => 'authored_time',
'committer' => 'committed_time'
);
sub BUILD {
my $self = shift;
return unless $self->content;
my @lines = split "\n", $self->content;
my %header;
while ( my $line = shift @lines ) {
last unless $line;
my ( $key, $value ) = split ' ', $line, 2;
push @{$header{$key}}, $value;
}
$header{encoding}
||= [ $self->git->config->get(key => "i18n.commitEncoding") || "utf-8" ];
my $encoding = $header{encoding}->[-1];
for my $key (keys %header) {
for my $value (@{$header{$key}}) {
$value = decode($encoding, $value);
if ( $key eq 'committer' or $key eq 'author' ) {
my @data = split ' ', $value;
my ( $email, $epoch, $tz ) = splice( @data, -3 );
$email = substr( $email, 1, -1 );
my $name = join ' ', @data;
my $actor
= Git::PurePerl::Actor->new( name => $name, email => $email );
$self->$key($actor);
$key = $method_map{$key};
my $dt
= DateTime->from_epoch( epoch => $epoch, time_zone => $tz );
$self->$key($dt);
} else {
$key = $method_map{$key} || $key;
$self->$key($value);
}
}
}
$self->comment( decode($encoding, join "\n", @lines) );
}
sub tree {
my $self = shift;
return $self->git->get_object( $self->tree_sha1 );
}
sub _push_parent_sha1 {
my ($self, $sha1) = @_;
push(@{$self->parent_sha1s}, $sha1);
}
sub parent_sha1 {
return shift->parent_sha1s->[0];
}
sub parent {
my $self = shift;
return $self->git->get_object( $self->parent_sha1 );
}
sub parents {
my $self = shift;
return map { $self->git->get_object( $_ ) } @{$self->parent_sha1s};
}
__PACKAGE__->meta->make_immutable;