Migrated blob to new model, + fixes for some legacy URI fails.
[catagits/Gitalist.git] / lib / Gitalist / Git / Project.pm
index cf3ac4c..69eaf84 100644 (file)
@@ -3,9 +3,10 @@ use MooseX::Declare;
 class Gitalist::Git::Project {
     # FIXME, use Types::Path::Class and coerce
     use MooseX::Types::Common::String qw/NonEmptySimpleStr/;
-    use MooseX::Types::Moose qw/Str Maybe Bool/;
+    use MooseX::Types::Moose qw/Str Maybe Bool HashRef/;
     use DateTime;
     use MooseX::Types::Path::Class qw/Dir/;
+    use List::MoreUtils qw/any zip/;
     use Gitalist::Git::Util;
     use aliased 'Gitalist::Git::Object';
 
@@ -31,7 +32,7 @@ class Gitalist::Git::Project {
     has _util => ( isa => 'Gitalist::Git::Util',
                    is => 'ro',
                    lazy_build => 1,
-                   handles => [ 'run_cmd' ],
+                   handles => [ 'run_cmd', 'get_gpp_object' ],
                );
 
     has project_dir => ( isa => Dir,
@@ -125,6 +126,28 @@ class Gitalist::Git::Project {
         return @ret;
     }
 
+    method references {
+       return $self->{references}
+               if $self->{references};
+
+       # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
+       # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
+       my $cmdout = $self->run_cmd(qw(show-ref --dereference))
+               or return;
+        my @reflist = $cmdout ? split(/\n/, $cmdout) : ();
+       my %refs;
+       for(@reflist) {
+               push @{$refs{$1}}, $2
+                       if m!^($SHA1RE)\srefs/(.*)$!;
+       }
+
+       return $self->{references} = \%refs;
+}
+
+    method valid_rev (Str $rev) {
+        return ($rev =~ /^($SHA1RE)$/);
+    }
+
 
 =head2 head_hash
 
@@ -172,14 +195,16 @@ The keys for each item will be:
         return @ret;
     }
 
-    use Gitalist::Git::Object;
-    method get_object (Str $sha1) {
-        return Gitalist::Git::Object->new(
+    method get_object (NonEmptySimpleStr $sha1) {
+        unless ( $self->valid_rev($sha1) ) {
+            $sha1 = $self->head_hash($sha1);
+        }
+        return Object->new(
             project => $self,
             sha1 => $sha1,
         );
     }
-    
+
     # Should be in ::Object
     method get_object_mode_string (Gitalist::Git::Object $object) {
         return unless $object && $object->{mode};
@@ -219,7 +244,190 @@ The keys for each item will be:
                 : $3;
     }
 
+    method list_revs ( NonEmptySimpleStr :$sha1!,
+                       Int :$count?,
+                       Int :$skip?,
+                       HashRef :$search?,
+                       NonEmptySimpleStr :$file?
+                   ) {
+        $sha1 = $self->head_hash($sha1)
+            if !$sha1 || $sha1 !~ $SHA1RE;
+
+       my @search_opts;
+        if($search) {
+            $search->{type} = 'grep'
+                if $search->{type} eq 'commit';
+            @search_opts = (
+                # This seems a little fragile ...
+                qq[--$search->{type}=$search->{text}],
+                '--regexp-ignore-case',
+                $search->{regexp} ? '--extended-regexp' : '--fixed-strings'
+            );
+        }
+
+        my $output = $self->run_cmd(
+            'rev-list',
+            '--header',
+            (defined $count ? "--max-count=$count" : ()),
+            (defined $skip ? "--skip=$skip"       : ()),
+            @search_opts,
+            $sha1,
+            '--',
+            ($file ? $file : ()),
+        );
+        return unless $output;
+
+        my @revs = $self->parse_rev_list($output);
+
+        return @revs;
+    }
+
+    method parse_rev_list ($output) {
+        return
+            map  $self->get_gpp_object($_),
+                grep $self->valid_rev($_),
+                    map  split(/\n/, $_, 6), split /\0/, $output;
+    }
+
+    # XXX Ideally this would return a wee object instead of ad hoc structures.
+    method diff ( Gitalist::Git::Object :$commit,
+                  Bool :$patch?,
+                  Maybe[NonEmptySimpleStr] :$parent?,
+                  NonEmptySimpleStr :$file? ) {
+        # Use parent if specifed, else take the parent from the commit
+        # if there is only one, otherwise it was a merge commit.
+        $parent = $parent
+            ? $parent
+            : $commit->parents <= 1
+            ? $commit->parent_sha1
+            : '-c';
+        my @etc = (
+            ( $file  ? ('--', $file) : () ),
+        );
+
+        my @out = $self->raw_diff(
+            \(( $patch ? '--patch-with-raw' : () ),
+            $parent, $commit->sha1, @etc )
+        );
+
+        # XXX Yes, there is much wrongness having parse_diff_tree be destructive.
+        my @difftree = $self->parse_diff_tree(\@out);
+
+        return \@difftree
+            unless $patch;
+
+        # The blank line between the tree and the patch.
+        shift @out;
+
+        # XXX And no I'm not happy about having diff return tree + patch.
+        return \@difftree, [$self->parse_diff(@out)];
+    }
+
+    method parse_diff (@diff) {
+        my @ret;
+        for (@diff) {
+            # This regex is a little pathological.
+            if(m{^diff --git (a/(.*?)) (b/\2)}) {
+                push @ret, {
+                    head => $_,
+                    a    => $1,
+                    b    => $3,
+                    file => $2,
+                    diff => '',
+                };
+                next;
+            }
+
+            if(/^index (\w+)\.\.(\w+) (\d+)$/) {
+                @{$ret[-1]}{qw(index src dst mode)} = ($_, $1, $2, $3);
+                next
+            }
+
+            # XXX Somewhat hacky. Ahem.
+            $ret[@ret ? -1 : 0]{diff} .= "$_\n";
+        }
+
+        return @ret;
+    }
+
+    # gitweb uses the following sort of command for diffing merges:
+# /home/dbrook/apps/bin/git --git-dir=/home/dbrook/dev/app/.git diff-tree -r -M --no-commit-id --patch-with-raw --full-index --cc 316cf158df3f6207afbae7270bcc5ba0 --
+# and for regular diffs
+# /home/dbrook/apps/bin/git --git-dir=/home/dbrook/dev/app/.git diff-tree -r -M --no-commit-id --patch-with-raw --full-index 2e3454ca0749641b42f063730b0090e1 316cf158df3f6207afbae7270bcc5ba0 --
+
+    method raw_diff (@args) {
+        my $cmdout = $self->run_cmd(
+            qw(diff-tree -r -M --no-commit-id --full-index),
+            @args
+        );
+        return $cmdout ? split(/\n/, $cmdout) : ();
+    }
 
+    method parse_diff_tree ($diff) {
+        my @keys = qw(modesrc modedst sha1src sha1dst status src dst);
+        my @ret;
+        while (@$diff and $diff->[0] =~ /^:\d+/) {
+            my $line = shift @$diff;
+            # see. man git-diff-tree for more info
+            # mode src, mode dst, sha1 src, sha1 dst, status, src[, dst]
+            my @vals = $line =~ /^:(\d+) (\d+) ($SHA1RE) ($SHA1RE) ([ACDMRTUX]\d*)\t([^\t]+)(?:\t([^\n]+))?$/;
+            my %line = zip @keys, @vals;
+            # Some convenience keys
+            $line{file}   = $line{src};
+            $line{sha1}   = $line{sha1dst};
+            $line{is_new} = $line{sha1src} =~ /^0+$/
+               if $line{sha1src};
+            @line{qw/status sim/} = $line{status} =~ /(R)(\d+)/
+                if $line{status} =~ /^R/;
+            push @ret, \%line;
+        }
+
+        return @ret;
+    }
+
+    method reflog (@logargs) {
+        my @entries
+            =  $self->run_cmd(qw(log -g), @logargs)
+                =~ /(^commit.+?(?:(?=^commit)|(?=\z)))/msg;
+
+=pod
+  commit 02526fc15beddf2c64798a947fecdd8d11bf993d
+  Reflog: HEAD@{14} (The Git Server <git@git.dev.venda.com>)
+  Reflog message: push
+  Author: Foo Barsby <fbarsby@example.com>
+  Date:   Thu Sep 17 12:26:05 2009 +0100
+
+      Merge branch 'abc123'
+
+=cut
+
+        return map {
+            # XXX Stuff like this makes me want to switch to Git::PurePerl
+            my($sha1, $type, $author, $date)
+                = m{
+                       ^ commit \s+ ($SHA1RE)$
+                       .*?
+                       Reflog[ ]message: \s+ (.+?)$ \s+
+                     Author: \s+ ([^<]+) <.*?$ \s+
+                   Date: \s+ (.+?)$
+               }xms;
+
+            pos($_) = index($_, $date) + length $date;
+
+            # Yeah, I just did that.
+            my($msg) = /\G\s+(\S.*)/sg;
+            {
+                hash    => $sha1,
+                type    => $type,
+                author  => $author,
+
+                # XXX Add DateTime goodness.
+                date    => $date,
+                message => $msg,
+            }
+            ;
+        } @entries;
+    }
 
     # Compatibility