lib/Gitalist/Model/Git.pm

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