requires 'Config::General'; # This should reflect the config file format you've chosen
# See Catalyst::Plugin::ConfigLoader for supported formats
requires 'MooseX::Types::Common';
+requires 'MooseX::Types::Path::Class';
+requires 'MooseX::Types';
requires 'File::Find::Rule';
requires 'File::Stat::ModeString';
-requires 'File::Slurp';
requires 'DateTime::Format::Mail';
requires 'IO::Capture::Stdout';
requires 'File::Which';
+requires 'aliased';
requires 'CGI';
requires 'DateTime';
requires 'Git::PurePerl'; # Note - need the git version in broquaint's fork
use MooseX::Declare;
+use Moose::Autobox;
class Gitalist::Git::Object {
use MooseX::Types::Moose qw/Str Int/;
+ use MooseX::Types::Common::String qw/NonEmptySimpleStr/;
use File::Stat::ModeString qw/mode_to_string/;
# project and sha1 are required initargs
has project => ( isa => 'Gitalist::Git::Project',
required => 1,
is => 'ro',
+ weak_ref => 1,
handles => [ 'run_cmd' ],
);
- has sha1 => ( isa => Str,
+ has sha1 => ( isa => NonEmptySimpleStr,
required => 1,
is => 'ro' );
- has $_ => ( isa => Str,
+ has $_ => ( isa => NonEmptySimpleStr,
required => 1,
is => 'ro',
lazy_build => 1 )
for qw/type modestr size/;
# objects can't determine their mode or filename
- has file => ( isa => Str,
+ has file => ( isa => NonEmptySimpleStr,
required => 0,
is => 'ro' );
has mode => ( isa => Int,
default => 0,
is => 'ro' );
- method BUILD {
- $self->$_() for qw/type modestr size/; # Ensure to build early.
- }
+ method BUILD { $self->$_() for qw/type size modestr/ }
- method _build_type {
- my $output = $self->run_cmd(qw/cat-file -t/, $self->sha1);
- chomp($output);
- return $output;
+ foreach my $key (qw/ type size /) {
+ method "_build_$key" {
+ $self->_cat_file_with_flag(substr($key, 0, 1))->chomp;
+ }
}
method _build_modestr {
return $modestr;
}
- method _build_size {
- my $output = $self->run_cmd(qw/cat-file -s/, $self->sha1);
- chomp($output);
- return $output;
+ method _cat_file_with_flag ($flag) {
+ $self->run_cmd('cat-file', '-' . $flag, $self->{sha1})
}
=head2 contents
=cut
+ # FIXME - Should be an attribute so it gets cached?
method contents {
if ( $self->type ne 'blob' ) {
die "object $self->sha1 is not a file\n"
}
- my $output = $self->run_cmd(qw/cat-file -p/, $self->sha1);
- return unless $output;
-
- return $output;
+ $self->_cat_file_with_flag('p');
}
} # end class
class Gitalist::Git::Project {
# FIXME, use Types::Path::Class and coerce
use MooseX::Types::Common::String qw/NonEmptySimpleStr/;
- use MooseX::Types::Moose qw/Str Maybe/;
+ use MooseX::Types::Moose qw/Str Maybe Bool/;
use DateTime;
- use Path::Class;
+ use MooseX::Types::Path::Class qw/Dir/;
use Gitalist::Git::Util;
use aliased 'Gitalist::Git::Object';
has name => ( isa => NonEmptySimpleStr,
is => 'ro', required => 1 );
- has path => ( isa => "Path::Class::Dir",
+ has path => ( isa => Dir,
is => 'ro', required => 1);
has description => ( isa => Str,
handles => [ 'run_cmd' ],
);
+ 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");
+ },
+ );
+
method BUILD {
$self->$_() for qw/_util last_change owner description/; # Ensure to build early.
}
method _build__util {
Gitalist::Git::Util->new(
- gitdir => $self->_project_dir($self->path),
+ project => $self,
);
}
method _build_description {
my $description = "";
eval {
- $description = $self->path->file('description')->slurp;
+ $description = $self->project_dir->file('description')->slurp;
chomp $description;
};
return $description;
}
method _build_owner {
- my ($gecos, $name) = (getpwuid $self->path->stat->uid)[6,0];
+ my ($gecos, $name) = (getpwuid $self->project_dir->stat->uid)[6,0];
$gecos =~ s/,+$//;
return length($gecos) ? $gecos : $name;
}
class Gitalist::Git::Repo {
use MooseX::Types::Common::String qw/NonEmptySimpleStr/;
- use Path::Class;
+ use MooseX::Types::Path::Class qw/Dir/;
+ use MooseX::Types::Moose qw/ArrayRef/;
use Gitalist::Git::Project;
- has repo_dir => ( isa => NonEmptySimpleStr,
- is => 'ro',
- required => 1 );
+ has repo_dir => (
+ isa => Dir,
+ is => 'ro',
+ required => 1,
+ coerce => 1,
+ );
method project (NonEmptySimpleStr $project) {
my $pd = $self->dir_from_project_name($project);
return -f $dir->file('HEAD') || -f $dir->file('.git', 'HEAD');
}
-=head2 project_dir
-
-The directory under which the given project will reside i.e C<.git/..>
-
-=cut
-
- method project_dir ($project) {
- -f $project->file('.git', 'HEAD')
- ? $project->subdir('.git')
- : $project;
- }
-
=head2 list_projects
For the C<repo_dir> specified in the config return an array of projects where
=cut
- method list_projects {
- my $base = dir($self->repo_dir);
- my @ret;
+ has projects => (
+ isa => ArrayRef['Gitalist::Git::Project'],
+ reader => 'list_projects',
+ lazy_build => 1,
+ );
+
+ method _build_projects {
+ my $base = $self->repo_dir;
my $dh = $base->open || die "Could not open $base";
+ my @ret;
while (my $file = $dh->read) {
next if $file =~ /^.{1,2}$/;
next unless -d $obj;
next unless $self->_is_git_repo($obj);
- # FIXME - Is resolving project_dir here sane?
- # I think not, just pass $obj down, and
- # resolve $project->path and $project->is_bare
- # in BUILDARGS
- push @ret, Gitalist::Git::Project->new( name => $file,
- path => $self->project_dir($obj),
- );
+ push @ret, Gitalist::Git::Project->new(
+ name => $file,
+ path => $obj,
+ );
}
- return [sort { $a->{name} cmp $b->{name} } @ret];
+ return [sort { $a->name cmp $b->name } @ret];
}
-
-=head2 dir_from_project_name
-
-Get the corresponding directory of a given project.
-
-=cut
-
- method dir_from_project_name (Str $project) {
- return dir($self->repo_dir)->subdir($project);
- }
-
-
-
} # end class
use File::Which;
use Git::PurePerl;
use MooseX::Types::Common::String qw/NonEmptySimpleStr/;
- has gitdir => ( isa => 'Path::Class::Dir', is => 'ro', required => 1 );
+ has project => (
+ isa => 'Gitalist::Git::Project',
+ handles => { gitdir => 'project_dir' },
+ is => 'bare', # No accessor
+ weak_ref => 1, # Weak, you have to hold onto me.
+ );
has _git => ( isa => NonEmptySimpleStr, is => 'ro', lazy_build => 1 );
sub _build__git {
my $git = File::Which::which('git');
return $git;
}
- has _gpp => ( isa => 'Git::PurePerl', is => 'rw', lazy_build => 1 );
- method _build__gpp {
- my $gpp = Git::PurePerl->new(gitdir => $self->gitdir);
- return $gpp;
- }
+ has _gpp => (
+ isa => 'Git::PurePerl', is => 'ro', lazy => 1,
+ default => sub { Git::PurePerl->new(gitdir => shift->gitdir) },
+ );
method run_cmd (@args) {
unshift @args, ( '--git-dir' => $self->gitdir );
print STDERR 'RUNNING: ', $self->_git, qq[ @args], $/;
-
+
open my $fh, '-|', $self->_git, @args
or die "failed to run git command";
binmode $fh, ':encoding(UTF-8)';
return $output;
}
-
-
-
-
-
-#
} # end class
projects / catagits/Gitalist.git / commitdiff