local-lib5/lib/perl5/Git/PurePerl/Object/Commit.pm

   1 package Git::PurePerl::Object::Commit;
   2 use Moose;
   3 use MooseX::StrictConstructor;
   4 use Moose::Util::TypeConstraints;
   5 use Encode qw/decode/;
   6 use namespace::autoclean;
   7
   8 extends 'Git::PurePerl::Object';
   9
  10 has 'kind' =>
  11     ( is => 'ro', isa => 'ObjectKind', required => 1, default => 'commit' );
  12 has 'tree_sha1'   => ( is => 'rw', isa => 'Str', required => 0 );
  13 has 'parent_sha1s' => ( is => 'rw', isa => 'ArrayRef[Str]', required => 0, default => sub { [] });
  14 has 'author' => ( is => 'rw', isa => 'Git::PurePerl::Actor', required => 0 );
  15 has 'authored_time' => ( is => 'rw', isa => 'DateTime', required => 0 );
  16 has 'committer' =>
  17     ( is => 'rw', isa => 'Git::PurePerl::Actor', required => 0 );
  18 has 'committed_time' => ( is => 'rw', isa => 'DateTime', required => 0 );
  19 has 'comment'        => ( is => 'rw', isa => 'Str',      required => 0 );
  20 has 'encoding'       => ( is => 'rw', isa => 'Str',      required => 0 );
  21
  22 my %method_map = (
  23     'tree'      => 'tree_sha1',
  24     'parent'    => '_push_parent_sha1',
  25     'author'    => 'authored_time',
  26     'committer' => 'committed_time'
  27 );
  28
  29 sub BUILD {
  30     my $self = shift;
  31     return unless $self->content;
  32     my @lines = split "\n", $self->content;
  33     my %header;
  34     while ( my $line = shift @lines ) {
  35         last unless $line;
  36         my ( $key, $value ) = split ' ', $line, 2;
  37         push @{$header{$key}}, $value;
  38     }
  39     $header{encoding}
  40         ||= [ $self->git->config->get(key => "i18n.commitEncoding") || "utf-8" ];
  41     my $encoding = $header{encoding}->[-1];
  42     for my $key (keys %header) {
  43         for my $value (@{$header{$key}}) {
  44             $value = decode($encoding, $value);
  45             if ( $key eq 'committer' or $key eq 'author' ) {
  46                 my @data = split ' ', $value;
  47                 my ( $email, $epoch, $tz ) = splice( @data, -3 );
  48                 $email = substr( $email, 1, -1 );
  49                 my $name = join ' ', @data;
  50                 my $actor
  51                     = Git::PurePerl::Actor->new( name => $name, email => $email );
  52                 $self->$key($actor);
  53                 $key = $method_map{$key};
  54                 my $dt
  55                     = DateTime->from_epoch( epoch => $epoch, time_zone => $tz );
  56                 $self->$key($dt);
  57             } else {
  58                 $key = $method_map{$key} || $key;
  59                 $self->$key($value);
  60             }
  61         }
  62     }
  63     $self->comment( decode($encoding, join "\n", @lines) );
  64 }
  65
  66
  67 sub tree {
  68     my $self = shift;
  69     return $self->git->get_object( $self->tree_sha1 );
  70 }
  71
  72
  73 sub _push_parent_sha1 {
  74     my ($self, $sha1) = @_;
  75
  76     push(@{$self->parent_sha1s}, $sha1);
  77 }
  78
  79 sub parent_sha1 {
  80     return shift->parent_sha1s->[0];
  81 }
  82
  83 sub parent {
  84     my $self = shift;
  85     return $self->git->get_object( $self->parent_sha1 );
  86 }
  87
  88 sub parents {
  89     my $self = shift;
  90
  91     return map { $self->git->get_object( $_ ) } @{$self->parent_sha1s};
  92 }
  93
  94 __PACKAGE__->meta->make_immutable;
  95