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