lib/Gitalist/Model/Git.pm

   1 package Gitalist::Model::Git;
   2
   3 use Moose;
   4 use MooseX::Types::Common::String qw/NonEmptySimpleStr/; # FIXME, use Types::Path::Class and coerce
   5 use namespace::autoclean;
   6
   7 BEGIN { extends 'Catalyst::Model' }
   8
   9 use DateTime;
  10 use Path::Class;
  11 use Carp qw/croak/;
  12 use File::Find::Rule;
  13 use DateTime::Format::Mail;
  14 use File::Stat::ModeString;
  15 use List::MoreUtils qw/any/;
  16 use File::Which;
  17
  18 sub BUILD {
  19     my ($self) = @_;
  20     $self->git; # Cause lazy value build.
  21 }
  22
  23 has git => ( isa => NonEmptySimpleStr, is => 'ro', lazy_build => 1 );
  24
  25 sub _build_git {
  26         my $git = File::Which::which('git');
  27
  28         if (!$git) {
  29                 die <<EOR
  30 Could not find a git executable.
  31 Please specify the which git executable to use in gitweb.yml
  32 EOR
  33         }
  34
  35         return $git;
  36 }
  37
  38 sub is_git_repo {
  39     my ($self, $dir) = @_;
  40
  41     return -f $dir->file('HEAD') || -f $dir->file('.git/HEAD');
  42 }
  43
  44 sub project_info {
  45     my ($self, $project) = @_;
  46
  47     return {
  48         name => $project,
  49         $self->get_project_properties(
  50                 $self->git_dir_from_project_name($project),
  51         ),
  52     };
  53 }
  54
  55 sub get_project_properties {
  56     my ($self, $dir) = @_;
  57     my %props;
  58
  59     eval {
  60         $props{description} = $dir->file('description')->slurp;
  61         chomp $props{description};
  62     };
  63
  64     if ($props{description} && $props{description} =~ /^Unnamed repository;/) {
  65         delete $props{description};
  66     }
  67
  68     $props{owner} = (getpwuid $dir->stat->uid)[6];
  69
  70     my $output = $self->run_cmd_in($dir, qw{
  71             for-each-ref --format=%(committer)
  72             --sort=-committerdate --count=1 refs/heads
  73     });
  74
  75     if (my ($epoch, $tz) = $output =~ /\s(\d+)\s+([+-]\d+)$/) {
  76         my $dt = DateTime->from_epoch(epoch => $epoch);
  77         $dt->set_time_zone($tz);
  78         $props{last_change} = $dt;
  79     }
  80
  81     return %props;
  82 }
  83
  84 has repo_dir => ( isa => NonEmptySimpleStr, required => 1, is => 'ro' ); # Fixme - path::class
  85
  86 sub list_projects {
  87     my ($self) = @_;
  88
  89     my $base = dir($self->repo_dir);
  90
  91     my @ret;
  92     my $dh = $base->open;
  93     while (my $file = $dh->read) {
  94         next if $file =~ /^.{1,2}$/;
  95
  96         my $obj = $base->subdir($file);
  97         next unless -d $obj;
  98         next unless $self->is_git_repo($obj);
  99                 # XXX Leaky abstraction alert!
 100                 my $is_bare = !-d $obj->subdir('.git');
 101
 102                 my $name = (File::Spec->splitdir($obj))[-1];
 103         push @ret, {
 104             name => ($name . ( $is_bare ? '' : '/.git' )),
 105             $self->get_project_properties(
 106                                 $is_bare ? $obj : $obj->subdir('.git')
 107                         ),
 108         };
 109     }
 110
 111     return [sort { $a->{name} cmp $b->{name} } @ret];
 112 }
 113
 114 sub run_cmd {
 115     my ($self, @args) = @_;
 116
 117     open my $fh, '-|', $self->git, @args
 118         or die "failed to run git command";
 119     binmode $fh, ':encoding(UTF-8)';
 120
 121     my $output = do { local $/ = undef; <$fh> };
 122     close $fh;
 123
 124     return $output;
 125 }
 126
 127 sub run_cmd_in {
 128     my ($self, $project, @args) = @_;
 129
 130     my $path;
 131     if (blessed($project) && $project->isa('Path::Class::Dir')) {
 132         $path = $project->stringify;
 133     }
 134     else {
 135         $path = $self->git_dir_from_project_name($project);
 136     }
 137     return $self->run_cmd('--git-dir' => $path, @args);
 138 }
 139
 140 sub git_dir_from_project_name {
 141     my ($self, $project) = @_;
 142
 143     return dir($self->repo_dir)->subdir($project);
 144 }
 145
 146 sub get_head_hash {
 147     my ($self, $project) = @_;
 148
 149     my $output = $self->run_cmd_in($project, qw/rev-parse --verify HEAD/ );
 150     return unless defined $output;
 151
 152     my ($head) = $output =~ /^([0-9a-fA-F]{40})$/;
 153     return $head;
 154 }
 155
 156 sub list_tree {
 157     my ($self, $project, $rev) = @_;
 158
 159     $rev ||= $self->get_head_hash($project);
 160
 161     my $output = $self->run_cmd_in($project, qw/ls-tree -z/, $rev);
 162     return unless defined $output;
 163
 164     my @ret;
 165     for my $line (split /\0/, $output) {
 166         my ($mode, $type, $object, $file) = split /\s+/, $line, 4;
 167
 168         push @ret, {
 169             mode   => oct $mode,
 170             type   => $type,
 171             object => $object,
 172             file   => $file,
 173         };
 174     }
 175
 176     return @ret;
 177 }
 178
 179 sub get_object_mode_string {
 180     my ($self, $object) = @_;
 181
 182     return unless $object && $object->{mode};
 183     return mode_to_string($object->{mode});
 184 }
 185
 186 sub get_object_type {
 187     my ($self, $project, $object) = @_;
 188
 189     my $output = $self->run_cmd_in($project, qw/cat-file -t/, $object);
 190     return unless $output;
 191
 192     chomp $output;
 193     return $output;
 194 }
 195
 196 sub cat_file {
 197     my ($self, $project, $object) = @_;
 198
 199     my $type = $self->get_object_type($project, $object);
 200     die "object `$object' is not a file\n"
 201         if (!defined $type || $type ne 'blob');
 202
 203     my $output = $self->run_cmd_in($project, qw/cat-file -p/, $object);
 204     return unless $output;
 205
 206     return $output;
 207 }
 208
 209 sub valid_rev {
 210     my ($self, $rev) = @_;
 211
 212     return unless $rev;
 213     return ($rev =~ /^([0-9a-fA-F]{40})$/);
 214 }
 215
 216 sub diff {
 217     my ($self, $project, @revs) = @_;
 218
 219     croak("Gitalist::Model::Git::diff needs a project and either one or two revisions")
 220         if scalar @revs < 1
 221         || scalar @revs > 2
 222         || any { !$self->valid_rev($_) } @revs;
 223
 224     my $output = $self->run_cmd_in($project, 'diff', @revs);
 225     return unless $output;
 226
 227     return $output;
 228 }
 229
 230 {
 231     my $formatter = DateTime::Format::Mail->new;
 232
 233     sub parse_rev_list {
 234         my ($self, $output) = @_;
 235         my @ret;
 236
 237         my @revs = split /\0/, $output;
 238
 239         for my $rev (split /\0/, $output) {
 240             for my $line (split /\n/, $rev, 6) {
 241                 chomp $line;
 242                 next unless $line;
 243
 244                 if ($self->valid_rev($line)) {
 245                     push @ret, {rev => $line};
 246                     next;
 247                 }
 248
 249                 if (my ($key, $value) = $line =~ /^(tree|parent)\s+(.*)$/) {
 250                     $ret[-1]->{$key} = $value;
 251                     next;
 252                 }
 253
 254                 if (my ($key, $value, $epoch, $tz) = $line =~ /^(author|committer)\s+(.*)\s+(\d+)\s+([+-]\d+)$/) {
 255                     $ret[-1]->{$key} = $value;
 256                     eval {
 257                         $ret[-1]->{ $key . "_datetime" } = DateTime->from_epoch(epoch => $epoch);
 258                         $ret[-1]->{ $key . "_datetime" }->set_time_zone($tz);
 259                         $ret[-1]->{ $key . "_datetime" }->set_formatter($formatter);
 260                     };
 261
 262                     if ($@) {
 263                         $ret[-1]->{ $key . "_datetime" } = "$epoch $tz";
 264                     }
 265
 266                     if (my ($name, $email) = $value =~ /^([^<]+)\s+<([^>]+)>$/) {
 267                         $ret[-1]->{ $key . "_name"  } = $name;
 268                         $ret[-1]->{ $key . "_email" } = $email;
 269                     }
 270                 }
 271
 272                 $line =~ s/^\n?\s{4}//;
 273                 $ret[-1]->{longmessage} = $line;
 274                 $ret[-1]->{message} = (split /\n/, $line, 2)[0];
 275             }
 276         }
 277
 278         return @ret;
 279     }
 280 }
 281
 282 sub list_revs {
 283     my ($self, $project, %args) = @_;
 284
 285     $args{rev} ||= $self->get_head_hash($project);
 286
 287     my $output = $self->run_cmd_in($project, 'rev-list',
 288             '--header',
 289             (defined $args{ count } ? "--max-count=$args{count}" : ()),
 290             (defined $args{ skip  } ? "--skip=$args{skip}"     : ()),
 291             $args{rev},
 292             '--',
 293             ($args{file} || ()),
 294     );
 295     return unless $output;
 296
 297     my @revs = $self->parse_rev_list($output);
 298
 299     return \@revs;
 300 }
 301
 302 sub rev_info {
 303     my ($self, $project, $rev) = @_;
 304
 305     return unless $self->valid_rev($rev);
 306
 307     return $self->list_revs($project, rev => $rev, count => 1);
 308 }
 309
 310 sub get_heads {
 311     my ($self, $project) = @_;
 312
 313     my $output = $self->run_cmd_in($project, qw/for-each-ref --sort=-committerdate /, '--format=%(objectname)%00%(refname)%00%(committer)', 'refs/heads');
 314     return unless $output;
 315
 316     my @ret;
 317     for my $line (split /\n/, $output) {
 318         my ($rev, $head, $commiter) = split /\0/, $line, 3;
 319         $head =~ s!^refs/heads/!!;
 320
 321         push @ret, { rev => $rev, name => $head };
 322
 323         #FIXME: That isn't the time I'm looking for..
 324         if (my ($epoch, $tz) = $output =~ /\s(\d+)\s+([+-]\d+)$/) {
 325             my $dt = DateTime->from_epoch(epoch => $epoch);
 326             $dt->set_time_zone($tz);
 327             $ret[-1]->{last_change} = $dt;
 328         }
 329     }
 330
 331     return \@ret;
 332 }
 333
 334 sub archive {
 335     my ($self, $project, $rev) = @_;
 336
 337     #FIXME: huge memory consuption
 338     #TODO: compression
 339     return $self->run_cmd_in($project, qw/archive --format=tar/, "--prefix=${project}/", $rev);
 340 }
 341
 342 1;
 343
 344 __PACKAGE__->meta->make_immutable;