use MooseX::Declare;
-class Gitalist::Git::Project {
+=head1 NAME
+
+Gitalist::Git::Project - Model of a git repository
+
+=head1 SYNOPSIS
+
+ my $gitrepo = dir('/repo/base/Gitalist');
+ my $project = Gitalist::Git::Project->new($gitrepo);
+ $project->name; # 'Gitalist'
+ $project->path; # '/repo/base/Gitalist/.git'
+ $project->description; # 'Unnamed repository.'
+
+=head1 DESCRIPTION
+
+This class models a git repository, referred to in Gitalist
+as a "Project".
+
+=cut
+
+class Gitalist::Git::Project with Gitalist::Git::HasUtils {
# FIXME, use Types::Path::Class and coerce
use MooseX::Types::Common::String qw/NonEmptySimpleStr/;
- use MooseX::Types::Moose qw/Str Maybe Bool HashRef/;
- use DateTime;
use MooseX::Types::Path::Class qw/Dir/;
+ use MooseX::Types::Moose qw/Str Maybe Bool HashRef ArrayRef/;
use List::MoreUtils qw/any zip/;
- use Gitalist::Git::Util;
+ use DateTime;
use aliased 'Gitalist::Git::Object';
- our $SHA1RE = qr/[0-9a-fA-F]{40}/;
+=head1 ATTRIBUTES
+
+=head2 name
+
+=cut
has name => ( isa => NonEmptySimpleStr,
is => 'ro', required => 1 );
+
+=head2 path
+
+L<Path::Class:Dir> for the location of the git repository.
+
+=cut
+
has path => ( isa => Dir,
is => 'ro', required => 1);
+=head2 description
+
+String containing .git/description
+
+=cut
+
has description => ( isa => Str,
is => 'ro',
lazy_build => 1,
);
+
+=head2 owner
+
+Owner of the files on disk.
+
+=cut
+
has owner => ( isa => NonEmptySimpleStr,
is => 'ro',
lazy_build => 1,
);
+
+=head2 last_change
+
+L<DateTime> for the time of the last update.
+undef if the repository has never been used.
+
+=cut
+
has last_change => ( isa => Maybe['DateTime'],
is => 'ro',
lazy_build => 1,
);
- has _util => ( isa => 'Gitalist::Git::Util',
- is => 'ro',
- lazy_build => 1,
- handles => [ 'run_cmd', 'get_gpp_object' ],
- );
- has project_dir => ( isa => Dir,
- is => 'ro',
- lazy => 1,
- default => sub {
- my $self = shift;
- $self->is_bare
- ? $self->path
- : $self->path->subdir('.git')
- },
- );
- has is_bare => (
- isa => Bool,
- is => 'ro',
- lazy => 1,
- default => sub {
- my $self = shift;
- -f $self->path->file('.git', 'HEAD')
- ? 0
- : -f $self->path->file('HEAD')
- ? 1
- : confess("Cannot find " . $self->path . "/.git/HEAD or "
- . $self->path . "/HEAD");
- },
- );
+=head2 is_bare
+
+Bool indicating whether this Project is bare.
+
+=cut
+
+ has is_bare => ( isa => Bool,
+ is => 'ro',
+ lazy => 1,
+ default => sub {
+ -d $_[0]->path->parent->subdir->($_[0]->name)
+ ? 1 : 0
+ },
+ );
method BUILD {
- $self->$_() for qw/_util last_change owner description/; # Ensure to build early.
+ $self->$_() for qw/last_change owner description/; # Ensure to build early.
}
- method _project_dir {
- -f $self->{path}->file('.git', 'HEAD')
- ? $self->{path}->subdir('.git')
- : $self->{path};
+ around BUILDARGS (ClassName $class: Dir $dir) {
+ my $name = $dir->dir_list(-1);
+ $dir = $dir->subdir('.git') if (-f $dir->file('.git', 'HEAD'));
+ confess("Can't find a git repository at " . $dir)
+ unless ( -f $dir->file('HEAD') );
+ return $class->$orig(name => $name,
+ path => $dir);
}
method _build__util {
);
}
+ our $SHA1RE = qr/[0-9a-fA-F]{40}/;
+
method _build_description {
my $description = "";
eval {
- $description = $self->project_dir->file('description')->slurp;
+ $description = $self->path->file('description')->slurp;
chomp $description;
};
return $description;
}
method _build_owner {
- my ($gecos, $name) = (getpwuid $self->project_dir->stat->uid)[6,0];
+ my ($gecos, $name) = (getpwuid $self->path->stat->uid)[6,0];
$gecos =~ s/,+$//;
return length($gecos) ? $gecos : $name;
}
return $last_change;
}
+=head2 heads
+
+Return an array containing the list of heads.
+
+=cut
+
method heads {
my $cmdout = $self->run_cmd(qw/for-each-ref --sort=-committerdate /, '--format=%(objectname)%00%(refname)%00%(committer)', 'refs/heads');
my @output = $cmdout ? split(/\n/, $cmdout) : ();
return @ret;
}
- method references {
- return $self->{references}
- if $self->{references};
-
- # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
- # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
- my $cmdout = $self->run_cmd(qw(show-ref --dereference))
- or return;
- my @reflist = $cmdout ? split(/\n/, $cmdout) : ();
- my %refs;
- for(@reflist) {
- push @{$refs{$1}}, $2
- if m!^($SHA1RE)\srefs/(.*)$!;
- }
-
- return $self->{references} = \%refs;
-}
-
- method valid_rev (Str $rev) {
- return ($rev =~ /^($SHA1RE)$/);
- }
+=head2 references
+Return a hash of references.
+
+=cut
+
+ has references => ( isa => HashRef[ArrayRef[Str]], is => 'ro', lazy_build => 1 );
+
+ method _build_references {
+
+ # 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c refs/tags/v2.6.11
+ # c39ae07f393806ccf406ef966e9a15afc43cc36a refs/tags/v2.6.11^{}
+ my $cmdout = $self->run_cmd(qw(show-ref --dereference))
+ or return;
+ my @reflist = $cmdout ? split(/\n/, $cmdout) : ();
+ my %refs;
+ for(@reflist) {
+ push @{$refs{$1}}, $2
+ if m!^($SHA1RE)\srefs/(.*)$!;
+ }
+
+ return \%refs;
+ }
=head2 head_hash
}
method get_object (NonEmptySimpleStr $sha1) {
- unless ( $self->valid_rev($sha1) ) {
+ unless ( $self->_is_valid_rev($sha1) ) {
$sha1 = $self->head_hash($sha1);
}
return Object->new(
);
}
+ method _is_valid_rev (Str $rev) {
+ return ($rev =~ /^($SHA1RE)$/);
+ }
+
# Should be in ::Object
method get_object_mode_string (Gitalist::Git::Object $object) {
- return unless $object && $object->{mode};
- return $object->{modestr};
+ return $object->modestr;
}
- method get_object_type ($object) {
- chomp(my $output = $self->run_cmd(qw/cat-file -t/, $object));
- return unless $output;
-
- return $output;
+ method get_object_type (NonEmptySimpleStr $sha1) {
+ return $self->get_object($sha1)->type;
}
- method cat_file ($object) {
- my $type = $self->get_object_type($object);
- die "object `$object' is not a file\n"
- if (!defined $type || $type ne 'blob');
-
- my $output = $self->run_cmd(qw/cat-file -p/, $object);
- return unless $output;
-
- return $output;
+ method cat_file (NonEmptySimpleStr $sha1) {
+ return $self->get_object($sha1)->contents;
}
method hash_by_path ($base, $path?, $type?) {
method parse_rev_list ($output) {
return
map $self->get_gpp_object($_),
- grep $self->valid_rev($_),
+ grep $self->_is_valid_rev($_),
map split(/\n/, $_, 6), split /\0/, $output;
}
);
my @out = $self->raw_diff(
- \(( $patch ? '--patch-with-raw' : () ),
- $parent, $commit->sha1, @etc )
+ ( $patch ? '--patch-with-raw' : () ),
+ ( $parent ? $parent : () ),
+ $commit->sha1, @etc,
);
# XXX Yes, there is much wrongness having parse_diff_tree be destructive.
= $self->run_cmd(qw(log -g), @logargs)
=~ /(^commit.+?(?:(?=^commit)|(?=\z)))/msg;
-=pod
- commit 02526fc15beddf2c64798a947fecdd8d11bf993d
- Reflog: HEAD@{14} (The Git Server <git@git.dev.venda.com>)
- Reflog message: push
- Author: Foo Barsby <fbarsby@example.com>
- Date: Thu Sep 17 12:26:05 2009 +0100
-
- Merge branch 'abc123'
-
-=cut
+# commit 02526fc15beddf2c64798a947fecdd8d11bf993d
+# Reflog: HEAD@{14} (The Git Server <git@git.dev.venda.com>)
+# Reflog message: push
+# Author: Foo Barsby <fbarsby@example.com>
+# Date: Thu Sep 17 12:26:05 2009 +0100
+#
+# Merge branch 'abc123'
return map {
# XXX Stuff like this makes me want to switch to Git::PurePerl
};
};
+=head1 SEE ALSO
+
+L<Gitalist::Git::Util> L<Gitalist::Git::Object>
+
+=head1 AUTHORS AND COPYRIGHT
+
+ Catalyst application:
+ (C) 2009 Venda Ltd and Dan Brook <dbrook@venda.com>
+
+ Original gitweb.cgi from which this was derived:
+ (C) 2005-2006, Kay Sievers <kay.sievers@vrfy.org>
+ (C) 2005, Christian Gierke
+
+=head1 LICENSE
+
+FIXME - Is this going to be GPLv2 as per gitweb? If so this is broken..
+
+This library is free software. You can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
} # end class
projects / catagits/Gitalist.git / blobdiff