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     use Gitalist::Git::Object;
 123     method get_object (Str $sha1) {
 124         return Gitalist::Git::Object->new(
 125             project => $self,
 126             sha1 => $sha1,
 127         );
 128     }
 129
 130     # Should be in ::Object
 131     method get_object_mode_string (Gitalist::Git::Object $object) {
 132         return unless $object && $object->{mode};
 133         return $object->{modestr};
 134     }
 135
 136     method get_object_type ($object) {
 137         chomp(my $output = $self->run_cmd(qw/cat-file -t/, $object));
 138         return unless $output;
 139
 140         return $output;
 141     }
 142
 143     method cat_file ($object) {
 144         my $type = $self->get_object_type($object);
 145         die "object `$object' is not a file\n"
 146             if (!defined $type || $type ne 'blob');
 147
 148         my $output = $self->run_cmd(qw/cat-file -p/, $object);
 149         return unless $output;
 150
 151         return $output;
 152     }
 153
 154     method hash_by_path ($base, $path?, $type?) {
 155         $path ||= '';
 156         $path =~ s{/+$}();
 157
 158         my $output = $self->run_cmd('ls-tree', $base, '--', $path)
 159             or return;
 160         my($line) = $output ? split(/\n/, $output) : ();
 161
 162         #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
 163         $line =~ m/^([0-9]+) (.+) ($SHA1RE)\t/;
 164         return defined $type && $type ne $2
 165             ? ()
 166                 : $3;
 167     }
 168
 169
 170
 171     # Compatibility
 172
 173 =head2 info
 174
 175 Returns a hash containing properties of this project. The keys will
 176 be:
 177
 178         name
 179         description (empty if .git/description is empty/unnamed)
 180         owner
 181         last_change
 182
 183 =cut
 184
 185     method info {
 186         return {
 187             name => $self->name,
 188             description => $self->description,
 189             owner => $self->owner,
 190             last_change => $self->last_change,
 191         };
 192     };
 193
 194 } # end class