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         my $util = Gitalist::Git::Util->new(
  43             gitdir => $self->project_dir($self->path),
  44         );
  45         return $util;
  46     }
  47
  48     method _build_description {
  49         my $description = "";
  50         eval {
  51             $description = $self->path->file('description')->slurp;
  52             chomp $description;
  53         };
  54         return $description;
  55     }
  56
  57     method _build_owner {
  58         my ($gecos, $name) = (getpwuid $self->path->stat->uid)[6,0];
  59         $gecos =~ s/,+$//;
  60         return length($gecos) ? $gecos : $name;
  61     }
  62
  63     method _build_last_change {
  64         my $last_change;
  65         my $output = $self->run_cmd(
  66             qw{ for-each-ref --format=%(committer)
  67                 --sort=-committerdate --count=1 refs/heads
  68           });
  69         if (my ($epoch, $tz) = $output =~ /\s(\d+)\s+([+-]\d+)$/) {
  70             my $dt = DateTime->from_epoch(epoch => $epoch);
  71             $dt->set_time_zone($tz);
  72             $last_change = $dt;
  73         }
  74         return $last_change;
  75     }
  76
  77 =head2 head_hash
  78
  79 Find the hash of a given head (defaults to HEAD).
  80
  81 =cut
  82
  83     method head_hash (Str $head?) {
  84         my $output = $self->run_cmd(qw/rev-parse --verify/, $head || 'HEAD' );
  85         return unless defined $output;
  86
  87         my($sha1) = $output =~ /^($SHA1RE)$/;
  88         return $sha1;
  89     }
  90
  91 =head2 list_tree
  92
  93 Return an array of contents for a given tree.
  94 The tree is specified by sha1, and defaults to HEAD.
  95 The keys for each item will be:
  96
  97         mode
  98         type
  99         object
 100         file
 101
 102 =cut
 103
 104     method list_tree (Str $sha1?) {
 105         $sha1 ||= $self->head_hash;
 106
 107         my $output = $self->run_cmd(qw/ls-tree -z/, $sha1);
 108         return unless defined $output;
 109
 110         my @ret;
 111         for my $line (split /\0/, $output) {
 112             my ($mode, $type, $object, $file) = split /\s+/, $line, 4;
 113             push @ret, Object->new( mode => oct $mode,
 114                                     type => $type,
 115                                     sha1 => $object,
 116                                     file => $file,
 117                                     project => $self,
 118                                   );
 119         }
 120         return @ret;
 121     }
 122
 123     # FIXME - Why not just stay in Path::Class land and return a P::C::D here?
 124     method project_dir {
 125         my $dir = $self->path->stringify;
 126         $dir .= '/.git'
 127             if -f dir($dir)->file('.git/HEAD');
 128         return $dir;
 129     }
 130
 131     # Compatibility
 132
 133 =head2 info
 134
 135 Returns a hash containing properties of this project. The keys will
 136 be:
 137
 138         name
 139         description (empty if .git/description is empty/unnamed)
 140         owner
 141         last_change
 142
 143 =cut
 144
 145     method info {
 146         return {
 147             name => $self->name,
 148             description => $self->description,
 149             owner => $self->owner,
 150             last_change => $self->last_change,
 151         };
 152     };
 153
 154 } # end class