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 HashRef/;
   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', 'get_gpp_object' ],
  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     method references {
 129         return $self->{references}
 130                 if $self->{references};
 131
 132         # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
 133         # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
 134         my $cmdout = $self->run_cmd(qw(show-ref --dereference))
 135                 or return;
 136         my @reflist = $cmdout ? split(/\n/, $cmdout) : ();
 137         my %refs;
 138         for(@reflist) {
 139                 push @{$refs{$1}}, $2
 140                         if m!^($SHA1RE)\srefs/(.*)$!;
 141         }
 142
 143         return $self->{references} = \%refs;
 144 }
 145
 146     method valid_rev (Str $rev) {
 147         return ($rev =~ /^($SHA1RE)$/);
 148     }
 149
 150
 151 =head2 head_hash
 152
 153 Find the hash of a given head (defaults to HEAD).
 154
 155 =cut
 156
 157     method head_hash (Str $head?) {
 158         my $output = $self->run_cmd(qw/rev-parse --verify/, $head || 'HEAD' );
 159         return unless defined $output;
 160
 161         my($sha1) = $output =~ /^($SHA1RE)$/;
 162         return $sha1;
 163     }
 164
 165 =head2 list_tree
 166
 167 Return an array of contents for a given tree.
 168 The tree is specified by sha1, and defaults to HEAD.
 169 The keys for each item will be:
 170
 171         mode
 172         type
 173         object
 174         file
 175
 176 =cut
 177
 178     method list_tree (Str $sha1?) {
 179         $sha1 ||= $self->head_hash;
 180
 181         my $output = $self->run_cmd(qw/ls-tree -z/, $sha1);
 182         return unless defined $output;
 183
 184         my @ret;
 185         for my $line (split /\0/, $output) {
 186             my ($mode, $type, $object, $file) = split /\s+/, $line, 4;
 187             push @ret, Object->new( mode => oct $mode,
 188                                     type => $type,
 189                                     sha1 => $object,
 190                                     file => $file,
 191                                     project => $self,
 192                                   );
 193         }
 194         return @ret;
 195     }
 196
 197     use Gitalist::Git::Object;
 198     method get_object (Str $sha1) {
 199         return Gitalist::Git::Object->new(
 200             project => $self,
 201             sha1 => $sha1,
 202         );
 203     }
 204
 205     # Should be in ::Object
 206     method get_object_mode_string (Gitalist::Git::Object $object) {
 207         return unless $object && $object->{mode};
 208         return $object->{modestr};
 209     }
 210
 211     method get_object_type ($object) {
 212         chomp(my $output = $self->run_cmd(qw/cat-file -t/, $object));
 213         return unless $output;
 214
 215         return $output;
 216     }
 217
 218     method cat_file ($object) {
 219         my $type = $self->get_object_type($object);
 220         die "object `$object' is not a file\n"
 221             if (!defined $type || $type ne 'blob');
 222
 223         my $output = $self->run_cmd(qw/cat-file -p/, $object);
 224         return unless $output;
 225
 226         return $output;
 227     }
 228
 229     method hash_by_path ($base, $path?, $type?) {
 230         $path ||= '';
 231         $path =~ s{/+$}();
 232
 233         my $output = $self->run_cmd('ls-tree', $base, '--', $path)
 234             or return;
 235         my($line) = $output ? split(/\n/, $output) : ();
 236
 237         #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa  panic.c'
 238         $line =~ m/^([0-9]+) (.+) ($SHA1RE)\t/;
 239         return defined $type && $type ne $2
 240             ? ()
 241                 : $3;
 242     }
 243
 244     method list_revs ( NonEmptySimpleStr :$sha1!,
 245                        Int :$count?,
 246                        Int :$skip?,
 247                        HashRef :$search?,
 248                        NonEmptySimpleStr :$file?
 249                    ) {
 250         $sha1 = $self->head_hash($sha1)
 251             if !$sha1 || $sha1 !~ $SHA1RE;
 252
 253         my @search_opts;
 254         if($search) {
 255             $search->{type} = 'grep'
 256                 if $search->{type} eq 'commit';
 257             @search_opts = (
 258                 # This seems a little fragile ...
 259                 qq[--$search->{type}=$search->{text}],
 260                 '--regexp-ignore-case',
 261                 $search->{regexp} ? '--extended-regexp' : '--fixed-strings'
 262             );
 263         }
 264
 265         my $output = $self->run_cmd(
 266             'rev-list',
 267             '--header',
 268             (defined $count ? "--max-count=$count" : ()),
 269             (defined $skip ? "--skip=$skip"       : ()),
 270             @search_opts,
 271             $sha1,
 272             '--',
 273             ($file ? $file : ()),
 274         );
 275         return unless $output;
 276
 277         my @revs = $self->parse_rev_list($output);
 278
 279         return @revs;
 280     }
 281
 282     method parse_rev_list ($output) {
 283         return
 284             map  $self->get_gpp_object($_),
 285                 grep $self->valid_rev($_),
 286                     map  split(/\n/, $_, 6), split /\0/, $output;
 287     }
 288
 289
 290     # Compatibility
 291
 292 =head2 info
 293
 294 Returns a hash containing properties of this project. The keys will
 295 be:
 296
 297         name
 298         description (empty if .git/description is empty/unnamed)
 299         owner
 300         last_change
 301
 302 =cut
 303
 304     method info {
 305         return {
 306             name => $self->name,
 307             description => $self->description,
 308             owner => $self->owner,
 309             last_change => $self->last_change,
 310         };
 311     };
 312
 313 } # end class