Minimally working snapshot action.
[catagits/Gitalist.git] / lib / Gitalist / Git / Object / Commit.pm
1 package Gitalist::Git::Object::Commit;
2 use MooseX::Declare;
3
4 class Gitalist::Git::Object::Commit
5     extends Gitalist::Git::Object
6     with Gitalist::Git::Object::HasTree {
7         use MooseX::Types::Moose qw/Str Int Bool Maybe ArrayRef/;
8         use MooseX::Types::Common::String qw/NonEmptySimpleStr/;
9         use Moose::Autobox;
10         use List::MoreUtils qw/any zip/;
11         use Gitalist::Util qw(to_utf8);
12         our $SHA1RE = qr/[0-9a-fA-F]{40}/;
13
14         has '+type' => ( default => 'commit' );
15         has '+_gpp_obj' => ( handles => [ 'comment',
16                                           'tree_sha1',
17                                           'committer',
18                                           'committed_time',
19                                           'author',
20                                           'authored_time',
21                                           'parents',
22                                           'parent_sha1',
23                                           'parent_sha1s',
24                                       ],
25                          );
26
27         method get_patch ( Maybe[NonEmptySimpleStr] $parent_hash?,
28                            Int $patch_count?) {
29             # assembling the git command to execute...
30             my @cmd = qw/format-patch --encoding=utf8 --stdout/;
31
32             # patch, or patch set?
33             push @cmd,
34                 defined $patch_count
35                 ? "-$patch_count -n" : "-1";
36
37             # refspec
38             if (defined $parent_hash) {
39                 #  if a parent is specified: hp..h
40                 push @cmd, "$parent_hash.." . $self->sha1;
41             } else {
42                 #  if not, but a merge commit: --cc h
43                 #  otherwise: --root h
44                 push @cmd, $self->parents->length > 1
45                     ? '--cc' : '--root';
46                 push @cmd, $self->sha1;
47             }
48             return $self->_run_cmd_fh( @cmd );
49         }
50
51         method diff ( Maybe[Bool] :$patch?,
52                        Maybe[NonEmptySimpleStr] :$parent?,
53                        Maybe[NonEmptySimpleStr] :$file?
54                    ) {
55             $parent = $parent
56                 ? $parent
57                     : $self->parents <= 1
58                         ? $self->parent_sha1
59                             : '-c';
60             my @etc = (
61                 ( $file  ? ('--', $file) : () ),
62             );
63
64             my @out = $self->_raw_diff(
65                 ( $patch ? '--patch-with-raw' : () ),
66                 ( $parent ? $parent : () ),
67                 $self->sha1, @etc,
68             );
69
70             # XXX Yes, there is much wrongness having _parse_diff_tree be destructive.
71             my @difftree = $self->_parse_diff_tree(\@out);
72
73             return \@difftree
74                 unless $patch;
75
76             # The blank line between the tree and the patch.
77             shift @out;
78
79             # XXX And no I'm not happy about having diff return tree + patch.
80             return \@difftree, [$self->_parse_diff(@out)];
81         }
82
83 method snapshot ( NonEmptySimpleStr $format ) {
84 #    return unless (qw/tar zip/->any($format));
85     my $name = $self->project->name;
86     $name =~ s,([^/])/*\.git$,$1,;
87     my $filename = to_utf8($name);
88     $filename .= "-$self->sha1.$format";
89     $name =~ s/\047/\047\\\047\047/g;
90
91     my @cmd = ('archive', "--format=$format", "--prefix=$name", $self->sha1);
92     return $self->_run_cmd_fh(@cmd);
93 }
94
95         ## Private methods
96         # gitweb uses the following sort of command for diffing merges:
97         # /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 --
98         # and for regular diffs
99         # /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 --
100         method _raw_diff (@args) {
101             return $self->_run_cmd_list(
102                 qw(diff-tree -r -M --no-commit-id --full-index),
103                 @args
104             );
105         }
106
107         method _parse_diff_tree ($diff) {
108             my @keys = qw(modesrc modedst sha1src sha1dst status src dst);
109             my @ret;
110             while (@$diff and $diff->[0] =~ /^:\d+/) {
111                 my $line = shift @$diff;
112                 # see. man git-diff-tree for more info
113                 # mode src, mode dst, sha1 src, sha1 dst, status, src[, dst]
114                 my @vals = $line =~ /^:(\d+) (\d+) ($SHA1RE) ($SHA1RE) ([ACDMRTUX]\d*)\t([^\t]+)(?:\t([^\n]+))?$/;
115                 my %line = zip @keys, @vals;
116                 # Some convenience keys
117                 $line{file}   = $line{src};
118                 $line{sha1}   = $line{sha1dst};
119                 $line{is_new} = $line{sha1src} =~ /^0+$/
120                     if $line{sha1src};
121                 @line{qw/status sim/} = $line{status} =~ /(R)(\d+)/
122                     if $line{status} =~ /^R/;
123                 push @ret, \%line;
124             }
125
126             return @ret;
127         }
128
129         method _parse_diff (@diff) {
130             my @ret;
131             for (@diff) {
132                 # This regex is a little pathological.
133                 if (m{^diff --git (a/(.*?)) (b/\2)}) {
134                     push @ret, {
135                         head => $_,
136                         a    => $1,
137                         b    => $3,
138                         file => $2,
139                         diff => '',
140                     };
141                     next;
142                 }
143
144                 if (/^index (\w+)\.\.(\w+) (\d+)$/) {
145                     @{$ret[-1]}{qw(index src dst mode)} = ($_, $1, $2, $3);
146                     next
147                 }
148
149                 # XXX Somewhat hacky. Ahem.
150                 $ret[@ret ? -1 : 0]{diff} .= "$_\n";
151             }
152
153             return @ret;
154         }
155
156     }