3 class Gitalist::Git::Project {
4 # FIXME, use Types::Path::Class and coerce
5 use MooseX::Types::Common::String qw/NonEmptySimpleStr/;
6 use MooseX::Types::Moose qw/Str Maybe Bool HashRef/;
8 use MooseX::Types::Path::Class qw/Dir/;
9 use Gitalist::Git::Util;
10 use aliased 'Gitalist::Git::Object';
12 our $SHA1RE = qr/[0-9a-fA-F]{40}/;
14 has name => ( isa => NonEmptySimpleStr,
15 is => 'ro', required => 1 );
16 has path => ( isa => Dir,
17 is => 'ro', required => 1);
19 has description => ( isa => Str,
23 has owner => ( isa => NonEmptySimpleStr,
27 has last_change => ( isa => Maybe['DateTime'],
31 has _util => ( isa => 'Gitalist::Git::Util',
34 handles => [ 'run_cmd', 'get_gpp_object' ],
37 has project_dir => ( isa => Dir,
44 : $self->path->subdir('.git')
53 -f $self->path->file('.git', 'HEAD')
55 : -f $self->path->file('HEAD')
57 : confess("Cannot find " . $self->path . "/.git/HEAD or "
58 . $self->path . "/HEAD");
63 $self->$_() for qw/_util last_change owner description/; # Ensure to build early.
67 -f $self->{path}->file('.git', 'HEAD')
68 ? $self->{path}->subdir('.git')
73 Gitalist::Git::Util->new(
78 method _build_description {
81 $description = $self->project_dir->file('description')->slurp;
88 my ($gecos, $name) = (getpwuid $self->project_dir->stat->uid)[6,0];
90 return length($gecos) ? $gecos : $name;
93 method _build_last_change {
95 my $output = $self->run_cmd(
96 qw{ for-each-ref --format=%(committer)
97 --sort=-committerdate --count=1 refs/heads
99 if (my ($epoch, $tz) = $output =~ /\s(\d+)\s+([+-]\d+)$/) {
100 my $dt = DateTime->from_epoch(epoch => $epoch);
101 $dt->set_time_zone($tz);
108 my $cmdout = $self->run_cmd(qw/for-each-ref --sort=-committerdate /, '--format=%(objectname)%00%(refname)%00%(committer)', 'refs/heads');
109 my @output = $cmdout ? split(/\n/, $cmdout) : ();
111 for my $line (@output) {
112 my ($rev, $head, $commiter) = split /\0/, $line, 3;
113 $head =~ s!^refs/heads/!!;
115 push @ret, { sha1 => $rev, name => $head };
117 #FIXME: That isn't the time I'm looking for..
118 if (my ($epoch, $tz) = $line =~ /\s(\d+)\s+([+-]\d+)$/) {
119 my $dt = DateTime->from_epoch(epoch => $epoch);
120 $dt->set_time_zone($tz);
121 $ret[-1]->{last_change} = $dt;
129 return $self->{references}
130 if $self->{references};
132 # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
133 # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
134 my $cmdout = $self->run_cmd(qw(show-ref --dereference))
136 my @reflist = $cmdout ? split(/\n/, $cmdout) : ();
139 push @{$refs{$1}}, $2
140 if m!^($SHA1RE)\srefs/(.*)$!;
143 return $self->{references} = \%refs;
146 method valid_rev (Str $rev) {
147 return ($rev =~ /^($SHA1RE)$/);
153 Find the hash of a given head (defaults to HEAD).
157 method head_hash (Str $head?) {
158 my $output = $self->run_cmd(qw/rev-parse --verify/, $head || 'HEAD' );
159 return unless defined $output;
161 my($sha1) = $output =~ /^($SHA1RE)$/;
167 Return an array of contents for a given tree.
168 The tree is specified by sha1, and defaults to HEAD.
169 The keys for each item will be:
178 method list_tree (Str $sha1?) {
179 $sha1 ||= $self->head_hash;
181 my $output = $self->run_cmd(qw/ls-tree -z/, $sha1);
182 return unless defined $output;
185 for my $line (split /\0/, $output) {
186 my ($mode, $type, $object, $file) = split /\s+/, $line, 4;
187 push @ret, Object->new( mode => oct $mode,
197 use Gitalist::Git::Object;
198 method get_object (Str $sha1) {
199 return Gitalist::Git::Object->new(
205 # Should be in ::Object
206 method get_object_mode_string (Gitalist::Git::Object $object) {
207 return unless $object && $object->{mode};
208 return $object->{modestr};
211 method get_object_type ($object) {
212 chomp(my $output = $self->run_cmd(qw/cat-file -t/, $object));
213 return unless $output;
218 method cat_file ($object) {
219 my $type = $self->get_object_type($object);
220 die "object `$object' is not a file\n"
221 if (!defined $type || $type ne 'blob');
223 my $output = $self->run_cmd(qw/cat-file -p/, $object);
224 return unless $output;
229 method hash_by_path ($base, $path?, $type?) {
233 my $output = $self->run_cmd('ls-tree', $base, '--', $path)
235 my($line) = $output ? split(/\n/, $output) : ();
237 #'100644 blob 0fa3f3a66fb6a137f6ec2c19351ed4d807070ffa panic.c'
238 $line =~ m/^([0-9]+) (.+) ($SHA1RE)\t/;
239 return defined $type && $type ne $2
244 method list_revs ( NonEmptySimpleStr :$sha1!,
248 NonEmptySimpleStr :$file?
250 $sha1 = $self->head_hash($sha1)
251 if !$sha1 || $sha1 !~ $SHA1RE;
255 $search->{type} = 'grep'
256 if $search->{type} eq 'commit';
258 # This seems a little fragile ...
259 qq[--$search->{type}=$search->{text}],
260 '--regexp-ignore-case',
261 $search->{regexp} ? '--extended-regexp' : '--fixed-strings'
265 my $output = $self->run_cmd(
268 (defined $count ? "--max-count=$count" : ()),
269 (defined $skip ? "--skip=$skip" : ()),
273 ($file ? $file : ()),
275 return unless $output;
277 my @revs = $self->parse_rev_list($output);
282 method parse_rev_list ($output) {
284 map $self->get_gpp_object($_),
285 grep $self->valid_rev($_),
286 map split(/\n/, $_, 6), split /\0/, $output;
294 Returns a hash containing properties of this project. The keys will
298 description (empty if .git/description is empty/unnamed)
307 description => $self->description,
308 owner => $self->owner,
309 last_change => $self->last_change,