Template fixes - some links only make sense for commit objects.
[catagits/Gitalist.git] / lib / Gitalist / Git / Project.pm
CommitLineData
56b6dbe6 1use MooseX::Declare;
2
b5b638f7 3=head1 NAME
4
894bff59 5Gitalist::Git::Project - Model of a git repository
b5b638f7 6
7=head1 SYNOPSIS
8
561a3f14 9 my $gitrepo = dir('/repo/base/Gitalist');
10 my $project = Gitalist::Git::Project->new($gitrepo);
11 $project->name; # 'Gitalist'
12 $project->path; # '/repo/base/Gitalist/.git'
13 $project->description; # 'Unnamed repository.'
b5b638f7 14
15=head1 DESCRIPTION
16
17This class models a git repository, referred to in Gitalist
18as a "Project".
19
20=cut
21
38b9e5c8 22class Gitalist::Git::Project with Gitalist::Git::HasUtils {
56b6dbe6 23 # FIXME, use Types::Path::Class and coerce
24 use MooseX::Types::Common::String qw/NonEmptySimpleStr/;
84f31a44 25 use MooseX::Types::Path::Class qw/Dir/;
829d41ed 26 use MooseX::Types::Moose qw/Str Maybe Bool HashRef ArrayRef/;
77edf882 27 use List::MoreUtils qw/any zip/;
b5b638f7 28 use DateTime;
a8a8f8f9 29 use aliased 'Gitalist::Git::Object';
56b6dbe6 30
32a371cc 31 our $SHA1RE = qr/[0-9a-fA-F]{40}/;
32
33 around BUILDARGS (ClassName $class: Dir $dir) {
4b6bcf44 34 # Allows us to be called as Project->new($dir)
35 # Last path component becomes $self->name
36 # Full path to git objects becomes $self->path
32a371cc 37 my $name = $dir->dir_list(-1);
38 $dir = $dir->subdir('.git') if (-f $dir->file('.git', 'HEAD'));
39 confess("Can't find a git repository at " . $dir)
40 unless ( -f $dir->file('HEAD') );
41 return $class->$orig(name => $name,
42 path => $dir);
43 }
44
b5b638f7 45=head1 ATTRIBUTES
46
47=head2 name
48
cc88eca5 49The name of the Project. By default, this is derived from the path to the git repository.
29debefd 50
cc88eca5 51=cut
56b6dbe6 52 has name => ( isa => NonEmptySimpleStr,
01ced85b 53 is => 'ro', required => 1 );
b5b638f7 54
55=head2 path
56
57L<Path::Class:Dir> for the location of the git repository.
58
59=cut
84f31a44 60 has path => ( isa => Dir,
01ced85b 61 is => 'ro', required => 1);
56b6dbe6 62
b5b638f7 63=head2 description
64
65String containing .git/description
66
67=cut
0617cbd0 68 has description => ( isa => Str,
56b6dbe6 69 is => 'ro',
70 lazy_build => 1,
71 );
b5b638f7 72
73=head2 owner
74
75Owner of the files on disk.
76
77=cut
56b6dbe6 78 has owner => ( isa => NonEmptySimpleStr,
79 is => 'ro',
80 lazy_build => 1,
81 );
b5b638f7 82
83=head2 last_change
84
85L<DateTime> for the time of the last update.
86undef if the repository has never been used.
87
88=cut
0617cbd0 89 has last_change => ( isa => Maybe['DateTime'],
56b6dbe6 90 is => 'ro',
91 lazy_build => 1,
92 );
93
b5b638f7 94=head2 is_bare
95
96Bool indicating whether this Project is bare.
97
98=cut
b5b638f7 99 has is_bare => ( isa => Bool,
100 is => 'ro',
101 lazy => 1,
102 default => sub {
103 -d $_[0]->path->parent->subdir->($_[0]->name)
104 ? 1 : 0
105 },
106 );
84f31a44 107
cc88eca5 108=head2 heads
109
110ArrayRef of hashes containing the name and sha1 of all heads.
111
112=cut
113 has heads => ( isa => ArrayRef[HashRef],
114 is => 'ro',
115 lazy_build => 1);
116
117=head2 references
118
119Hashref of ArrayRefs for each reference.
120
121=cut
122 has references => ( isa => HashRef[ArrayRef[Str]],
123 is => 'ro',
124 lazy_build => 1 );
125
01ced85b 126 method BUILD {
38b9e5c8 127 $self->$_() for qw/last_change owner description/; # Ensure to build early.
01ced85b 128 }
129
32a371cc 130=head1 METHODS
8dbe8024 131
cc88eca5 132=head2 head_hash ($head?)
894bff59 133
32a371cc 134Return the sha1 for HEAD, or any specified head.
894bff59 135
32a371cc 136=cut
32a371cc 137 method head_hash (Str $head?) {
138 my $output = $self->run_cmd(qw/rev-parse --verify/, $head || 'HEAD' );
139 confess("No such head: " . $head) unless defined $output;
29debefd 140
32a371cc 141 my($sha1) = $output =~ /^($SHA1RE)$/;
142 return $sha1;
56b6dbe6 143 }
144
cc88eca5 145=head2 list_tree ($sha1?)
a8a8f8f9 146
147Return an array of contents for a given tree.
148The tree is specified by sha1, and defaults to HEAD.
cc88eca5 149Each item is a L<Gitalist::Git::Object>.
a8a8f8f9 150
151=cut
a8a8f8f9 152 method list_tree (Str $sha1?) {
153 $sha1 ||= $self->head_hash;
154
155 my $output = $self->run_cmd(qw/ls-tree -z/, $sha1);
156 return unless defined $output;
157
158 my @ret;
159 for my $line (split /\0/, $output) {
160 my ($mode, $type, $object, $file) = split /\s+/, $line, 4;
161 push @ret, Object->new( mode => oct $mode,
162 type => $type,
163 sha1 => $object,
164 file => $file,
50394a3e 165 project => $self,
a8a8f8f9 166 );
167 }
168 return @ret;
169 }
170
cc88eca5 171=head2 get_object ($sha1)
172
173Return a L<Gitalist::Git::Object> for the given sha1.
174
175=cut
8bb7649b 176 method get_object (NonEmptySimpleStr $sha1) {
894bff59 177 unless ( $self->_is_valid_rev($sha1) ) {
8bb7649b 178 $sha1 = $self->head_hash($sha1);
179 }
77edf882 180 return Object->new(
54368e9d 181 project => $self,
182 sha1 => $sha1,
183 );
184 }
8bb7649b 185
cc88eca5 186=head2 hash_by_path($sha1, $path, $type?)
894bff59 187
cc88eca5 188Returns the sha1 for a given path, optionally limited by type.
189
190=cut
fc11c7f1 191 method hash_by_path ($base, $path = '', $type?) {
54368e9d 192 $path =~ s{/+$}();
32a371cc 193 # FIXME should this really just take the first result?
194 my @paths = $self->run_cmd('ls-tree', $base, '--', $path)
54368e9d 195 or return;
32a371cc 196 my $line = $paths[0];
54368e9d 197
198 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa panic.c'
199 $line =~ m/^([0-9]+) (.+) ($SHA1RE)\t/;
200 return defined $type && $type ne $2
201 ? ()
202 : $3;
203 }
204
cc88eca5 205=head2 list_revs($sha1, $count?, $skip?, \%search?, $file?)
206
207Returns a list of revs for the given head ($sha1).
208
209=cut
4111e151 210 method list_revs ( NonEmptySimpleStr :$sha1!,
211 Int :$count?,
212 Int :$skip?,
213 HashRef :$search?,
05e8b4d0 214 NonEmptySimpleStr :$file? ) {
4111e151 215 $sha1 = $self->head_hash($sha1)
216 if !$sha1 || $sha1 !~ $SHA1RE;
217
218 my @search_opts;
05e8b4d0 219 if ($search) {
4111e151 220 $search->{type} = 'grep'
221 if $search->{type} eq 'commit';
222 @search_opts = (
223 # This seems a little fragile ...
224 qq[--$search->{type}=$search->{text}],
225 '--regexp-ignore-case',
226 $search->{regexp} ? '--extended-regexp' : '--fixed-strings'
227 );
228 }
229
230 my $output = $self->run_cmd(
231 'rev-list',
232 '--header',
233 (defined $count ? "--max-count=$count" : ()),
234 (defined $skip ? "--skip=$skip" : ()),
235 @search_opts,
236 $sha1,
237 '--',
238 ($file ? $file : ()),
239 );
240 return unless $output;
241
cc88eca5 242 my @revs = $self->_parse_rev_list($output);
4111e151 243
244 return @revs;
245 }
246
cc88eca5 247=head2 diff($commit, $patch?, $parent?, $file?)
248
1501cb4e 249Generate a diff from a given L<Gitalist::Git::Object>.
cc88eca5 250
251=cut
54368e9d 252
cc88eca5 253 method diff ( Gitalist::Git::Object :$commit!,
77edf882 254 Bool :$patch?,
fc948aee 255 Maybe[NonEmptySimpleStr] :$parent?,
1501cb4e 256 NonEmptySimpleStr :$file?
257 ) {
258 return $commit->diff( patch => $patch,
259 parent => $parent,
260 file => $file);
77edf882 261 }
262
cc88eca5 263=head2 reflog(@lorgargs)
77edf882 264
cc88eca5 265Return a list of hashes representing each reflog entry.
77edf882 266
cc88eca5 267FIXME Should this return objects?
54368e9d 268
cc88eca5 269=cut
d8abdf1c 270 method reflog (@logargs) {
271 my @entries
272 = $self->run_cmd(qw(log -g), @logargs)
273 =~ /(^commit.+?(?:(?=^commit)|(?=\z)))/msg;
274
05e8b4d0 275 # commit 02526fc15beddf2c64798a947fecdd8d11bf993d
276 # Reflog: HEAD@{14} (The Git Server <git@git.dev.venda.com>)
277 # Reflog message: push
278 # Author: Foo Barsby <fbarsby@example.com>
279 # Date: Thu Sep 17 12:26:05 2009 +0100
280 #
281 # Merge branch 'abc123'
d8abdf1c 282
283 return map {
284 # XXX Stuff like this makes me want to switch to Git::PurePerl
285 my($sha1, $type, $author, $date)
286 = m{
287 ^ commit \s+ ($SHA1RE)$
288 .*?
289 Reflog[ ]message: \s+ (.+?)$ \s+
290 Author: \s+ ([^<]+) <.*?$ \s+
291 Date: \s+ (.+?)$
292 }xms;
293
294 pos($_) = index($_, $date) + length $date;
295
296 # Yeah, I just did that.
297 my($msg) = /\G\s+(\S.*)/sg;
298 {
299 hash => $sha1,
300 type => $type,
301 author => $author,
302
303 # XXX Add DateTime goodness.
304 date => $date,
305 message => $msg,
306 }
307 ;
308 } @entries;
309 }
310
cc88eca5 311 ## BUILDERS
32a371cc 312 method _build__util {
313 Gitalist::Git::Util->new(
314 project => $self,
315 );
316 }
317
318 method _build_description {
76c97bf6 319 my $description = "";
5d8568c6 320 eval {
76c97bf6 321 $description = $self->path->file('description')->slurp;
322 chomp $description;
5d8568c6 323 };
76c97bf6 324 return $description;
32a371cc 325 }
326
327 method _build_owner {
328 my ($gecos, $name) = (getpwuid $self->path->stat->uid)[6,0];
329 $gecos =~ s/,+$//;
330 return length($gecos) ? $gecos : $name;
331 }
332
333 method _build_last_change {
334 my $last_change;
335 my $output = $self->run_cmd(
336 qw{ for-each-ref --format=%(committer)
337 --sort=-committerdate --count=1 refs/heads
338 });
339 if (my ($epoch, $tz) = $output =~ /\s(\d+)\s+([+-]\d+)$/) {
340 my $dt = DateTime->from_epoch(epoch => $epoch);
341 $dt->set_time_zone($tz);
342 $last_change = $dt;
343 }
344 return $last_change;
345 }
346
cc88eca5 347 method _build_heads {
348 my @revlines = $self->run_cmd_list(qw/for-each-ref --sort=-committerdate /, '--format=%(objectname)%00%(refname)%00%(committer)', 'refs/heads');
349 my @ret;
350 for my $line (@revlines) {
351 my ($rev, $head, $commiter) = split /\0/, $line, 3;
352 $head =~ s!^refs/heads/!!;
353
354 push @ret, { sha1 => $rev, name => $head };
355
356 #FIXME: That isn't the time I'm looking for..
357 if (my ($epoch, $tz) = $line =~ /\s(\d+)\s+([+-]\d+)$/) {
358 my $dt = DateTime->from_epoch(epoch => $epoch);
359 $dt->set_time_zone($tz);
360 $ret[-1]->{last_change} = $dt;
361 }
362 }
363
364 return \@ret;
365 }
366
367 method _build_references {
368 # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
369 # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
370 my @reflist = $self->run_cmd_list(qw(show-ref --dereference))
05e8b4d0 371 or return;
cc88eca5 372 my %refs;
05e8b4d0 373 for (@reflist) {
374 push @{$refs{$1}}, $2
375 if m!^($SHA1RE)\srefs/(.*)$!;
376 }
cc88eca5 377
05e8b4d0 378 return \%refs;
cc88eca5 379 }
380
381 ## Private methods
382 method _is_valid_rev (Str $rev) {
383 return ($rev =~ /^($SHA1RE)$/);
384 }
385
386 method _parse_rev_list ($output) {
387 return
388 map $self->get_gpp_object($_),
389 grep $self->_is_valid_rev($_),
390 map split(/\n/, $_, 6), split /\0/, $output;
391 }
392
b5b638f7 393=head1 SEE ALSO
394
395L<Gitalist::Git::Util> L<Gitalist::Git::Object>
396
397=head1 AUTHORS AND COPYRIGHT
398
399 Catalyst application:
400 (C) 2009 Venda Ltd and Dan Brook <dbrook@venda.com>
401
402 Original gitweb.cgi from which this was derived:
403 (C) 2005-2006, Kay Sievers <kay.sievers@vrfy.org>
404 (C) 2005, Christian Gierke
405
406=head1 LICENSE
407
408FIXME - Is this going to be GPLv2 as per gitweb? If so this is broken..
409
410This library is free software. You can redistribute it and/or modify
411it under the same terms as Perl itself.
412
413=cut
414
56b6dbe6 415} # end class