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