Commit | Line | Data |
fbf3eb7e |
1 | package Gitalist::Model::Git; |
2 | |
3 | use Moose; |
6dca83ef |
4 | use MooseX::Types::Common::String qw/NonEmptySimpleStr/; # FIXME, use Types::Path::Class and coerce |
fbf3eb7e |
5 | use namespace::autoclean; |
6 | |
86382b95 |
7 | BEGIN { extends 'Catalyst::Model' } |
8 | |
fbf3eb7e |
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/; |
6dca83ef |
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 |
fbf3eb7e |
30 | Could not find a git executable. |
31 | Please specify the which git executable to use in gitweb.yml |
32 | EOR |
04d1d917 |
33 | } |
6dca83ef |
34 | |
35 | return $git; |
04d1d917 |
36 | } |
fbf3eb7e |
37 | |
38 | sub is_git_repo { |
39 | my ($self, $dir) = @_; |
40 | |
d5cc37a4 |
41 | return -f $dir->file('HEAD') || -f $dir->file('.git/HEAD'); |
fbf3eb7e |
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 | |
04d1d917 |
64 | if ($props{description} && $props{description} =~ /^Unnamed repository;/) { |
fbf3eb7e |
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 | |
6dca83ef |
84 | has repo_dir => ( isa => NonEmptySimpleStr, required => 1, is => 'ro' ); # Fixme - path::class |
85 | |
fbf3eb7e |
86 | sub list_projects { |
87 | my ($self) = @_; |
88 | |
6dca83ef |
89 | my $base = dir($self->repo_dir); |
fbf3eb7e |
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); |
d5cc37a4 |
99 | # XXX Leaky abstraction alert! |
e66db0fb |
100 | my $is_bare = !-d $obj->subdir('.git'); |
fbf3eb7e |
101 | |
e66db0fb |
102 | my $name = (File::Spec->splitdir($obj))[-1]; |
fbf3eb7e |
103 | push @ret, { |
c1087225 |
104 | name => ($name . ( $is_bare ? '' : '/.git' )), |
e66db0fb |
105 | $self->get_project_properties( |
106 | $is_bare ? $obj : $obj->subdir('.git') |
107 | ), |
fbf3eb7e |
108 | }; |
109 | } |
110 | |
e99c6ee1 |
111 | return [sort { $a->{name} cmp $b->{name} } @ret]; |
fbf3eb7e |
112 | } |
113 | |
114 | sub run_cmd { |
115 | my ($self, @args) = @_; |
116 | |
6dca83ef |
117 | open my $fh, '-|', $self->git, @args |
fbf3eb7e |
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 | |
6dca83ef |
143 | return dir($self->repo_dir)->subdir($project); |
fbf3eb7e |
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; |