lib/Gitalist/Git/Project.pm

   1 use MooseX::Declare;
   2
   3 class Gitalist::Git::Project {
   4     # FIXME, use Types::Path::Class and coerce
   5     use MooseX::Types::Common::String qw/NonEmptySimpleStr/;
   6     use MooseX::Types::Moose qw/Str Maybe/;
   7     use DateTime;
   8     use Path::Class;
   9     use Gitalist::Git::Util;
  10     use aliased 'Gitalist::Git::Object';
  11
  12     our $SHA1RE = qr/[0-9a-fA-F]{40}/;
  13
  14     has name => ( isa => NonEmptySimpleStr,
  15                   is => 'ro', required => 1 );
  16     has path => ( isa => "Path::Class::Dir",
  17                   is => 'ro', required => 1);
  18
  19     has description => ( isa => Str,
  20                          is => 'ro',
  21                          lazy_build => 1,
  22                      );
  23     has owner => ( isa => NonEmptySimpleStr,
  24                    is => 'ro',
  25                    lazy_build => 1,
  26                );
  27     has last_change => ( isa => Maybe['DateTime'],
  28                          is => 'ro',
  29                          lazy_build => 1,
  30                      );
  31     has _util => ( isa => 'Gitalist::Git::Util',
  32                    is => 'ro',
  33                    lazy_build => 1,
  34                    handles => [ 'run_cmd' ],
  35                );
  36
  37     method BUILD {
  38         $self->$_() for qw/_util last_change owner description/; # Ensure to build early.
  39     }
  40
  41     method _build__util {
  42         Gitalist::Git::Util->new(
  43             gitdir => $self->path,
  44         );
  45     }
  46
  47     method _build_description {
  48         my $description = "";
  49         eval {
  50             $description = $self->path->file('description')->slurp;
  51             chomp $description;
  52         };
  53         return $description;
  54     }
  55
  56     method _build_owner {
  57         my ($gecos, $name) = (getpwuid $self->path->stat->uid)[6,0];
  58         $gecos =~ s/,+$//;
  59         return length($gecos) ? $gecos : $name;
  60     }
  61
  62     method _build_last_change {
  63         my $last_change;
  64         my $output = $self->run_cmd(
  65             qw{ for-each-ref --format=%(committer)
  66                 --sort=-committerdate --count=1 refs/heads
  67           });
  68         if (my ($epoch, $tz) = $output =~ /\s(\d+)\s+([+-]\d+)$/) {
  69             my $dt = DateTime->from_epoch(epoch => $epoch);
  70             $dt->set_time_zone($tz);
  71             $last_change = $dt;
  72         }
  73         return $last_change;
  74     }
  75
  76 =head2 head_hash
  77
  78 Find the hash of a given head (defaults to HEAD).
  79
  80 =cut
  81
  82     method head_hash (Str $head?) {
  83         my $output = $self->run_cmd(qw/rev-parse --verify/, $head || 'HEAD' );
  84         return unless defined $output;
  85
  86         my($sha1) = $output =~ /^($SHA1RE)$/;
  87         return $sha1;
  88     }
  89
  90 =head2 list_tree
  91
  92 Return an array of contents for a given tree.
  93 The tree is specified by sha1, and defaults to HEAD.
  94 The keys for each item will be:
  95
  96         mode
  97         type
  98         object
  99         file
 100
 101 =cut
 102
 103     method list_tree (Str $sha1?) {
 104         $sha1 ||= $self->head_hash;
 105
 106         my $output = $self->run_cmd(qw/ls-tree -z/, $sha1);
 107         return unless defined $output;
 108
 109         my @ret;
 110         for my $line (split /\0/, $output) {
 111             my ($mode, $type, $object, $file) = split /\s+/, $line, 4;
 112             push @ret, Object->new( mode => oct $mode,
 113                                     type => $type,
 114                                     sha1 => $object,
 115                                     file => $file,
 116                                     project => $self,
 117                                   );
 118         }
 119         return @ret;
 120     }
 121
 122     # Compatibility
 123
 124 =head2 info
 125
 126 Returns a hash containing properties of this project. The keys will
 127 be:
 128
 129         name
 130         description (empty if .git/description is empty/unnamed)
 131         owner
 132         last_change
 133
 134 =cut
 135
 136     method info {
 137         return {
 138             name => $self->name,
 139             description => $self->description,
 140             owner => $self->owner,
 141             last_change => $self->last_change,
 142         };
 143     };
 144
 145 } # end class