3 class Gitalist::Git::Project with Gitalist::Git::HasUtils {
4 # FIXME, use Types::Path::Class and coerce
5 use MooseX::Types::Common::String qw/NonEmptySimpleStr/;
6 use MooseX::Types::Path::Class qw/Dir/;
7 use MooseX::Types::Moose qw/Str Maybe Bool HashRef ArrayRef/;
9 use List::MoreUtils qw/any zip/;
11 use Gitalist::Git::Object::Blob;
12 use Gitalist::Git::Object::Tree;
13 use Gitalist::Git::Object::Commit;
14 use Gitalist::Git::Object::Tag;
16 our $SHA1RE = qr/[0-9a-fA-F]{40}/;
18 around BUILDARGS (ClassName $class: Dir $dir) {
19 # Allows us to be called as Project->new($dir)
20 # Last path component becomes $self->name
21 # Full path to git objects becomes $self->path
22 my $name = $dir->dir_list(-1);
23 $dir = $dir->subdir('.git') if (-f $dir->file('.git', 'HEAD'));
24 confess("Can't find a git repository at " . $dir)
25 unless ( -f $dir->file('HEAD') );
26 return $class->$orig(name => $name,
30 has name => ( isa => NonEmptySimpleStr,
31 is => 'ro', required => 1 );
33 has path => ( isa => Dir,
34 is => 'ro', required => 1);
36 has description => ( isa => Str,
41 has owner => ( isa => NonEmptySimpleStr,
46 has last_change => ( isa => Maybe['DateTime'],
51 has is_bare => ( isa => Bool,
55 -d $_[0]->path->parent->subdir->($_[0]->name)
59 has heads => ( isa => ArrayRef[HashRef],
62 has tags => ( isa => ArrayRef[HashRef],
65 has references => ( isa => HashRef[ArrayRef[Str]],
70 $self->$_() for qw/last_change owner description/; # Ensure to build early.
74 method head_hash (Str $head?) {
75 my $output = $self->run_cmd(qw/rev-parse --verify/, $head || 'HEAD' );
76 confess("No such head: " . $head) unless defined $output;
78 my($sha1) = $output =~ /^($SHA1RE)$/;
82 method list_tree (Str $sha1?) {
83 $sha1 ||= $self->head_hash;
84 my $object = $self->get_object($sha1);
85 return @{$object->tree};
88 method get_object (NonEmptySimpleStr $sha1) {
89 unless ( $self->_is_valid_rev($sha1) ) {
90 $sha1 = $self->head_hash($sha1);
92 my $type = $self->run_cmd('cat-file', '-t', $sha1);
94 my $class = 'Gitalist::Git::Object::' . ucfirst($type);
102 method hash_by_path ($base, $path = '', $type?) {
104 # FIXME should this really just take the first result?
105 my @paths = $self->run_cmd('ls-tree', $base, '--', $path)
107 my $line = $paths[0];
109 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa panic.c'
110 $line =~ m/^([0-9]+) (.+) ($SHA1RE)\t/;
111 return defined $type && $type ne $2
116 method list_revs ( NonEmptySimpleStr :$sha1!,
120 NonEmptySimpleStr :$file? ) {
121 $sha1 = $self->head_hash($sha1)
122 if !$sha1 || $sha1 !~ $SHA1RE;
126 $search->{type} = 'grep'
127 if $search->{type} eq 'commit';
129 # This seems a little fragile ...
130 qq[--$search->{type}=$search->{text}],
131 '--regexp-ignore-case',
132 $search->{regexp} ? '--extended-regexp' : '--fixed-strings'
136 my $output = $self->run_cmd(
139 (defined $count ? "--max-count=$count" : ()),
140 (defined $skip ? "--skip=$skip" : ()),
144 ($file ? $file : ()),
146 return unless $output;
148 my @revs = $self->_parse_rev_list($output);
153 method snapshot (NonEmptySimpleStr :$sha1,
154 NonEmptySimpleStr :$format
156 # TODO - only valid formats are 'tar' and 'zip'
157 my $formats = { tgz => 'tar', zip => 'zip' };
158 unless ($formats->exists($format)) {
159 die("No such format: $format");
161 $format = $formats->{$format};
162 my $name = $self->name;
163 $name =~ s,([^/])/*\.git$,$1,;
164 my $filename = $name;
165 $filename .= "-$sha1.$format";
166 $name =~ s/\047/\047\\\047\047/g;
168 my @cmd = ('archive', "--format=$format", "--prefix=$name/", $sha1);
169 return ($filename, $self->run_cmd_fh(@cmd));
170 # TODO - support compressed archives
173 method diff ( Gitalist::Git::Object :$commit!,
175 Maybe[NonEmptySimpleStr] :$parent?,
176 NonEmptySimpleStr :$file?
178 return $commit->diff( patch => $patch,
183 method reflog (@logargs) {
185 = $self->run_cmd(qw(log -g), @logargs)
186 =~ /(^commit.+?(?:(?=^commit)|(?=\z)))/msg;
188 # commit 02526fc15beddf2c64798a947fecdd8d11bf993d
189 # Reflog: HEAD@{14} (The Git Server <git@git.dev.venda.com>)
190 # Reflog message: push
191 # Author: Foo Barsby <fbarsby@example.com>
192 # Date: Thu Sep 17 12:26:05 2009 +0100
194 # Merge branch 'abc123'
197 # XXX Stuff like this makes me want to switch to Git::PurePerl
198 my($sha1, $type, $author, $date)
200 ^ commit \s+ ($SHA1RE)$
202 Reflog[ ]message: \s+ (.+?)$ \s+
203 Author: \s+ ([^<]+) <.*?$ \s+
207 pos($_) = index($_, $date) + length $date;
209 # Yeah, I just did that.
210 my($msg) = /\G\s+(\S.*)/sg;
216 # XXX Add DateTime goodness.
226 Gitalist::Git::Util->new(
231 method _build_description {
232 my $description = "";
234 $description = $self->path->file('description')->slurp;
240 method _build_owner {
241 my ($gecos, $name) = (getpwuid $self->path->stat->uid)[6,0];
243 return length($gecos) ? $gecos : $name;
246 method _build_last_change {
248 my $output = $self->run_cmd(
249 qw{ for-each-ref --format=%(committer)
250 --sort=-committerdate --count=1 refs/heads
252 if (my ($epoch, $tz) = $output =~ /\s(\d+)\s+([+-]\d+)$/) {
253 my $dt = DateTime->from_epoch(epoch => $epoch);
254 $dt->set_time_zone($tz);
260 method _build_heads {
261 my @revlines = $self->run_cmd_list(qw/for-each-ref --sort=-committerdate /, '--format=%(objectname)%00%(refname)%00%(committer)', 'refs/heads');
263 for my $line (@revlines) {
264 my ($rev, $head, $commiter) = split /\0/, $line, 3;
265 $head =~ s!^refs/heads/!!;
267 push @ret, { sha1 => $rev, name => $head };
269 #FIXME: That isn't the time I'm looking for..
270 if (my ($epoch, $tz) = $line =~ /\s(\d+)\s+([+-]\d+)$/) {
271 my $dt = DateTime->from_epoch(epoch => $epoch);
272 $dt->set_time_zone($tz);
273 $ret[-1]->{last_change} = $dt;
281 my @revlines = $self->run_cmd_list('for-each-ref',
282 '--sort=-creatordate',
283 '--format=%(objectname) %(objecttype) %(refname) %(*objectname) %(*objecttype) %(subject)%00%(creator)',
287 for my $line (@revlines) {
288 my($refinfo, $creatorinfo) = split /\0/, $line;
289 my($rev, $type, $name, $refid, $reftype, $title) = split(' ', $refinfo, 6);
290 my($creator, $epoch, $tz) = ($creatorinfo =~ /^(.*) ([0-9]+) (.*)$/);
291 $name =~ s!^refs/tags/!!;
293 push @ret, { sha1 => $rev, name => $name };
295 #FIXME: That isn't the time I'm looking for..
297 my $dt = DateTime->from_epoch(epoch => $epoch);
298 $dt->set_time_zone($tz);
299 $ret[-1]->{last_change} = $dt;
306 method _build_references {
307 # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
308 # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
309 my @reflist = $self->run_cmd_list(qw(show-ref --dereference))
313 push @{$refs{$1}}, $2
314 if m!^($SHA1RE)\srefs/(.*)$!;
321 method _is_valid_rev (Str $rev) {
322 return ($rev =~ /^($SHA1RE)$/);
325 method _parse_rev_list ($output) {
327 map $self->get_gpp_object($_),
328 grep $self->_is_valid_rev($_),
329 map split(/\n/, $_, 6), split /\0/, $output;
338 Gitalist::Git::Project - Model of a git repository
342 my $gitrepo = dir('/repo/base/Gitalist');
343 my $project = Gitalist::Git::Project->new($gitrepo);
344 $project->name; # 'Gitalist'
345 $project->path; # '/repo/base/Gitalist/.git'
346 $project->description; # 'Unnamed repository.'
350 This class models a git repository, referred to in Gitalist
358 The name of the Project. By default, this is derived from the path to the git repository.
363 L<Path::Class:Dir> for the location of the git repository.
368 String containing .git/description
373 Owner of the files on disk.
378 L<DateTime> for the time of the last update.
379 undef if the repository has never been used.
384 Bool indicating whether this Project is bare.
389 ArrayRef of hashes containing the name and sha1 of all heads.
395 ArrayRef of hashes containing the name and sha1 of all tags.
401 Hashref of ArrayRefs for each reference.
406 =head2 head_hash ($head?)
408 Return the sha1 for HEAD, or any specified head.
411 =head2 list_tree ($sha1?)
413 Return an array of contents for a given tree.
414 The tree is specified by sha1, and defaults to HEAD.
415 Each item is a L<Gitalist::Git::Object>.
418 =head2 get_object ($sha1)
420 Return an appropriate subclass of L<Gitalist::Git::Object> for the given sha1.
423 =head2 hash_by_path($sha1, $path, $type?)
425 Returns the sha1 for a given path, optionally limited by type.
428 =head2 list_revs($sha1, $count?, $skip?, \%search?, $file?)
430 Returns a list of revs for the given head ($sha1).
433 =head2 snapshot($sha1, $format)
435 Generate an archived snapshot of the repository.
436 $sha1 should be a commit or tree.
437 Returns a filehandle to read from.
440 =head2 diff($commit, $patch?, $parent?, $file?)
442 Generate a diff from a given L<Gitalist::Git::Object>.
446 =head2 reflog(@lorgargs)
448 Return a list of hashes representing each reflog entry.
450 FIXME Should this return objects?
457 L<Gitalist::Git::Util> L<Gitalist::Git::Object>
461 See L<Gitalist> for authors.
465 See L<Gitalist> for the license.