use Moose;
use namespace::autoclean;
+use MooseX::Types::Common::String qw/NonEmptySimpleStr/;
+use Moose::Autobox;
extends 'Catalyst::Model';
with 'Catalyst::Component::InstancePerContext';
-use DateTime;
-use Path::Class;
-use File::Which;
-use Carp qw/croak/;
-use File::Find::Rule;
-use DateTime::Format::Mail;
-use File::Stat::ModeString;
-use List::MoreUtils qw/any zip/;
-use Scalar::Util qw/blessed/;
-use MooseX::Types::Common::String qw/NonEmptySimpleStr/; # FIXME, use Types::Path::Class and coerce
-
-use Git::PurePerl;
+has repo_dir => ( is => 'ro', required => 1, isa => NonEmptySimpleStr );
=head1 NAME
=cut
+use Git::PurePerl;
+use Path::Class qw/dir/;
+sub build_per_context_instance {
+ my ( $self, $c ) = @_;
+
+ my $app = blessed($c) || $c;
+ my $model = Git::Repos->new(
+ project => ([$c->req->parameters->{p} || '/']->flatten)[0],
+ repo_dir => $self->repo_dir,
+ );
+
+ # This is fugly as fuck. Move Git::PurePerl construction into attribute builders..
+ my ($pd, $gd) = $model->project_dir( $model->project )->resolve =~ m{((.+?)(:?/\/\.git)?$)};
+ $gd .= '/.git' if ($gd !~ /\.git$/ and -d "$gd/.git");
+ $model->gpp( Git::PurePerl->new(gitdir => $gd, directory => $pd) );
+
+ return $model;
+}
+
+package Git::Repos; # Better name? Split out into own file once we have a sane name.
+use Moose;
+use namespace::autoclean;
+use DateTime;
+use Path::Class;
+use File::Which;
+use Carp qw/croak/;
+use File::Find::Rule;
+use DateTime::Format::Mail;
+use File::Stat::ModeString;
+use List::MoreUtils qw/any zip/;
+use MooseX::Types::Common::String qw/NonEmptySimpleStr/; # FIXME, use Types::Path::Class and coerce
+
+use Git::PurePerl;
+
# Should these live in a separate module? Or perhaps extended Regexp::Common?
+# No, should be a MooseX::Types module!!
our $SHA1RE = qr/[0-9a-fA-F]{40}/;
# These are static and only need to be setup on app start.
-has repo_dir => ( isa => NonEmptySimpleStr, is => 'ro', lazy_build => 1 ); # Fixme - path::class
+has repo_dir => ( isa => NonEmptySimpleStr, is => 'ro', required => 1 ); # Fixme - path::class
has git => ( isa => NonEmptySimpleStr, is => 'ro', lazy_build => 1 );
# These are dynamic and can be different from one request to the next.
has project => ( isa => NonEmptySimpleStr, is => 'rw');
has gpp => ( isa => 'Git::PurePerl', is => 'rw', lazy_build => 1 );
-sub build_per_context_instance {
- my ( $self, $c ) = @_;
-
- # If we don't have a project param it probably means we're at /
- return $self
- unless $c->req->param('p');
-
- $self->project( $c->req->param('p') );
- (my $pd = $self->project_dir( $self->project )) =~ s{/\.git$}();
- $self->gpp( Git::PurePerl->new(directory => $pd) );
- return $self;
-}
-
=head2 BUILD
=cut
return $git;
}
-
-sub _build_repo_dir {
- return Gitalist->config->{repo_dir};
-}
=head2 get_object
=cut
sub list_projects {
- my ($self, $dir) = @_;
-
- my $base = dir($dir || $self->repo_dir);
-
- my @ret;
- my $dh = $base->open;
- while (my $file = $dh->read) {
- next if $file =~ /^.{1,2}$/;
-
- my $obj = $base->subdir($file);
- next unless -d $obj;
- next unless $self->is_git_repo($obj);
-
- # XXX Leaky abstraction alert!
- my $is_bare = !-d $obj->subdir('.git');
-
- my $name = (File::Spec->splitdir($obj))[-1];
- push @ret, {
- name => ($name . ( $is_bare ? '' : '/.git' )),
- $self->get_project_properties(
- $is_bare ? $obj : $obj->subdir('.git')
- ),
- };
+ my ($self, $dir) = @_;
+
+ my $base = dir($dir || $self->repo_dir);
+
+ my @ret;
+ my $dh = $base->open or die("Cannot open dir $base");
+ while (my $file = $dh->read) {
+ next if $file =~ /^.{1,2}$/;
+
+ my $obj = $base->subdir($file);
+ next unless -d $obj;
+ next unless $self->is_git_repo($obj);
+ # XXX Leaky abstraction alert!
+ my $is_bare = !-d $obj->subdir('.git');
+
+ my $name = (File::Spec->splitdir($obj))[-1];
+ push @ret, {
+ name => ($name . ( $is_bare ? '' : '/.git' )),
+ $self->get_project_properties(
+ $is_bare ? $obj : $obj->subdir('.git')
+ ),
+ };
}
return [sort { $a->{name} cmp $b->{name} } @ret];
sub cat_file {
my ($self, $object, $project) = @_;
- my $type = $self->get_object_type($object);
+ my $type = $self->get_object_type($object, $project);
die "object `$object' is not a file\n"
if (!defined $type || $type ne 'blob');
sub parse_rev_list {
my ($self, $output) = @_;
- my @ret;
- my @revs = split /\0/, $output;
-
- for my $rev (split /\0/, $output) {
- for my $line (split /\n/, $rev, 6) {
- chomp $line;
- next unless $line;
-
- if ($self->valid_rev($line)) {
- push @ret, $self->get_object($line);
- }
- }
- }
-
- return @ret;
+ return
+ map $self->get_object($_),
+ grep $self->valid_rev($_),
+ map split(/\n/, $_, 6), split /\0/, $output;
}
=head2 list_revs
sub list_revs {
my ($self, %args) = @_;
- $args{sha1} ||= $self->head_hash($args{project});
+ $args{sha1} = $self->head_hash($args{sha1})
+ if !$args{sha1} || $args{sha1} !~ $SHA1RE;
+
+ my @search_opts;
+ if($args{search}) {
+ my $sargs = $args{search};
+ $sargs->{type} = 'grep'
+ if $sargs->{type} eq 'commit';
+ @search_opts = (
+ # This seems a little fragile ...
+ qq[--$sargs->{type}=$sargs->{text}],
+ '--regexp-ignore-case',
+ $sargs->{regexp} ? '--extended-regexp' : '--fixed-strings'
+ );
+ }
my $output = $self->run_cmd_in($args{project} || $self->project, 'rev-list',
'--header',
- (defined $args{ count } ? "--max-count=$args{count}" : ()),
- (defined $args{ skip } ? "--skip=$args{skip}" : ()),
+ (defined $args{ count } ? "--max-count=$args{count}" : ()),
+ (defined $args{ skip } ? "--skip=$args{skip}" : ()),
+ @search_opts,
$args{sha1},
'--',
($args{file} ? $args{file} : ()),
projects / catagits/Gitalist.git / blobdiff