Commit | Line | Data |
e1307124 |
1 | package Gitalist::Git::Object::Commit; |
2 | use MooseX::Declare; |
3 | |
0250a92d |
4 | class Gitalist::Git::Object::Commit |
5 | extends Gitalist::Git::Object |
6 | with Gitalist::Git::Object::HasTree { |
9cd610f4 |
7 | use MooseX::Types::Moose qw/Str Int Bool Maybe ArrayRef/; |
8 | use MooseX::Types::Common::String qw/NonEmptySimpleStr/; |
61ba8635 |
9 | use Moose::Autobox; |
0250a92d |
10 | use List::MoreUtils qw/any zip/; |
30db8f5b |
11 | use Gitalist::Util qw(to_utf8); |
0250a92d |
12 | our $SHA1RE = qr/[0-9a-fA-F]{40}/; |
13 | |
98390bf6 |
14 | has '+type' => ( default => 'commit' ); |
0250a92d |
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 | ], |
e1307124 |
25 | ); |
26 | |
35eaa65a |
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; |
61ba8635 |
41 | } else { |
35eaa65a |
42 | # if not, but a merge commit: --cc h |
43 | # otherwise: --root h |
44 | push @cmd, $self->parents->length > 1 |
61ba8635 |
45 | ? '--cc' : '--root'; |
35eaa65a |
46 | push @cmd, $self->sha1; |
377bf360 |
47 | } |
aa7f1f92 |
48 | return $self->_run_cmd_fh( @cmd ); |
377bf360 |
49 | } |
50 | |
51 | method diff ( Maybe[Bool] :$patch?, |
0250a92d |
52 | Maybe[NonEmptySimpleStr] :$parent?, |
53 | Maybe[NonEmptySimpleStr] :$file? |
54 | ) { |
0250a92d |
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 | |
30db8f5b |
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 | |
0250a92d |
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 | } |