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 _project_dir {
  42         -f $self->{path}->file('.git', 'HEAD')
  43             ? $self->{path}->subdir('.git')
  44             : $self->{path};
  45     }
  46
  47     method _build__util {
  48         Gitalist::Git::Util->new(
  49             gitdir => $self->_project_dir($self->path),
  50         );
  51     }
  52
  53     method _build_description {
  54         my $description = "";
  55         eval {
  56             $description = $self->path->file('description')->slurp;
  57             chomp $description;
  58         };
  59         return $description;
  60     }
  61
  62     method _build_owner {
  63         my ($gecos, $name) = (getpwuid $self->path->stat->uid)[6,0];
  64         $gecos =~ s/,+$//;
  65         return length($gecos) ? $gecos : $name;
  66     }
  67
  68     method _build_last_change {
  69         my $last_change;
  70         my $output = $self->run_cmd(
  71             qw{ for-each-ref --format=%(committer)
  72                 --sort=-committerdate --count=1 refs/heads
  73           });
  74         if (my ($epoch, $tz) = $output =~ /\s(\d+)\s+([+-]\d+)$/) {
  75             my $dt = DateTime->from_epoch(epoch => $epoch);
  76             $dt->set_time_zone($tz);
  77             $last_change = $dt;
  78         }
  79         return $last_change;
  80     }
  81
  82     method heads {
  83         my $cmdout = $self->run_cmd(qw/for-each-ref --sort=-committerdate /, '--format=%(objectname)%00%(refname)%00%(committer)', 'refs/heads');
  84         my @output = $cmdout ? split(/\n/, $cmdout) : ();
  85         my @ret;
  86         for my $line (@output) {
  87             my ($rev, $head, $commiter) = split /\0/, $line, 3;
  88             $head =~ s!^refs/heads/!!;
  89
  90             push @ret, { sha1 => $rev, name => $head };
  91
  92             #FIXME: That isn't the time I'm looking for..
  93             if (my ($epoch, $tz) = $line =~ /\s(\d+)\s+([+-]\d+)$/) {
  94                 my $dt = DateTime->from_epoch(epoch => $epoch);
  95                 $dt->set_time_zone($tz);
  96                 $ret[-1]->{last_change} = $dt;
  97             }
  98         }
  99
 100         return @ret;
 101     }
 102
 103
 104 =head2 head_hash
 105
 106 Find the hash of a given head (defaults to HEAD).
 107
 108 =cut
 109
 110     method head_hash (Str $head?) {
 111         my $output = $self->run_cmd(qw/rev-parse --verify/, $head || 'HEAD' );
 112         return unless defined $output;
 113
 114         my($sha1) = $output =~ /^($SHA1RE)$/;
 115         return $sha1;
 116     }
 117
 118 =head2 list_tree
 119
 120 Return an array of contents for a given tree.
 121 The tree is specified by sha1, and defaults to HEAD.
 122 The keys for each item will be:
 123
 124         mode
 125         type
 126         object
 127         file
 128
 129 =cut
 130
 131     method list_tree (Str $sha1?) {
 132         $sha1 ||= $self->head_hash;
 133
 134         my $output = $self->run_cmd(qw/ls-tree -z/, $sha1);
 135         return unless defined $output;
 136
 137         my @ret;
 138         for my $line (split /\0/, $output) {
 139             my ($mode, $type, $object, $file) = split /\s+/, $line, 4;
 140             push @ret, Object->new( mode => oct $mode,
 141                                     type => $type,
 142                                     sha1 => $object,
 143                                     file => $file,
 144                                     project => $self,
 145                                   );
 146         }
 147         return @ret;
 148     }
 149
 150     use Gitalist::Git::Object;
 151     method get_object (Str $sha1) {
 152         return Gitalist::Git::Object->new(
 153             project => $self,
 154             sha1 => $sha1,
 155         );
 156     }
 157
 158     # Should be in ::Object
 159     method get_object_mode_string (Gitalist::Git::Object $object) {
 160         return unless $object && $object->{mode};
 161         return $object->{modestr};
 162     }
 163
 164     method get_object_type ($object) {
 165         chomp(my $output = $self->run_cmd(qw/cat-file -t/, $object));
 166         return unless $output;
 167
 168         return $output;
 169     }
 170
 171     method cat_file ($object) {
 172         my $type = $self->get_object_type($object);
 173         die "object `$object' is not a file\n"
 174             if (!defined $type || $type ne 'blob');
 175
 176         my $output = $self->run_cmd(qw/cat-file -p/, $object);
 177         return unless $output;
 178
 179         return $output;
 180     }
 181
 182     method hash_by_path ($base, $path?, $type?) {
 183         $path ||= '';
 184         $path =~ s{/+$}();
 185
 186         my $output = $self->run_cmd('ls-tree', $base, '--', $path)
 187             or return;
 188         my($line) = $output ? split(/\n/, $output) : ();
 189
 190         #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
 191         $line =~ m/^([0-9]+) (.+) ($SHA1RE)\t/;
 192         return defined $type && $type ne $2
 193             ? ()
 194                 : $3;
 195     }
 196
 197
 198
 199     # Compatibility
 200
 201 =head2 info
 202
 203 Returns a hash containing properties of this project. The keys will
 204 be:
 205
 206         name
 207         description (empty if .git/description is empty/unnamed)
 208         owner
 209         last_change
 210
 211 =cut
 212
 213     method info {
 214         return {
 215             name => $self->name,
 216             description => $self->description,
 217             owner => $self->owner,
 218             last_change => $self->last_change,
 219         };
 220     };
 221
 222 } # end class