X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FGitalist%2FModel%2FGit.pm;h=16dd15206fe6ef33ee23af31fcb4d6e0c877d6a9;hb=2db6f4ebd4c34bc3f2bf1ba25879895ad331e955;hp=814321a97914b73da21051c802c155f902f5fbbe;hpb=b4b4d0fd18a6a83a75b4d71408b8acbfedd90fb6;p=catagits%2FGitalist.git diff --git a/lib/Gitalist/Model/Git.pm b/lib/Gitalist/Model/Git.pm index 814321a..16dd152 100644 --- a/lib/Gitalist/Model/Git.pm +++ b/lib/Gitalist/Model/Git.pm @@ -2,22 +2,13 @@ package Gitalist::Model::Git; 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 @@ -31,33 +22,75 @@ Gitalist::Model::Git - the model for git interactions =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 ) =~ m{((.+?)(:?/\/\.git)?$)}; + $gd .= '/.git' if ($gd !~ /\.git$/ and -d "$gd/.git"); + $model->gpp( Git::PurePerl->new(gitdir => $gd, directory => $pd) ); + + return $model; +} + +__PACKAGE__->meta->make_immutable; + +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::Moose qw/Bool/; +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 ) = @_; - - $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 +{ # Show us the deprecated methods. + my $meta = __PACKAGE__->meta; + my @methods =map { $_->name } + grep { $_->package_name eq __PACKAGE__ } + $meta->get_all_methods; + foreach my $name (@methods) { + $meta->add_before_method_modifier($name, sub { + my ($package, $file, $line) = caller(2); + warn("Method " . $name . " called from $package line $line\n") + if $package ne __PACKAGE__; + }); + } +} + sub BUILD { my ($self) = @_; + my $meta = $self->meta; $self->git; # Cause lazy value build. $self->repo_dir; } @@ -74,10 +107,6 @@ EOR return $git; } - -sub _build_repo_dir { - return Gitalist->config->{repo_dir}; -} =head2 get_object @@ -114,7 +143,7 @@ Call out to the C binary and return a string consisting of the output. sub run_cmd { my ($self, @args) = @_; - print STDERR 'RUNNING: ', $self->git, qq[ @args], $/; +# print STDERR 'RUNNING: ', $self->git, qq[ @args], $/; open my $fh, '-|', $self->git, @args or die "failed to run git command"; @@ -238,29 +267,28 @@ each item will contain the contents of L. =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]; @@ -367,7 +395,7 @@ Return the contents of a given file. sub cat_file { my ($self, $object, $project) = @_; - my $type = $self->get_object_type($object); + my $type = $self->get_object_type($object, $project || $self->project); die "object `$object' is not a file\n" if (!defined $type || $type ne 'blob'); @@ -468,10 +496,10 @@ sub diff { # So either a parent is specifed, or we use the commit's parent if there's # only one, otherwise it was a merge commit. my $parent = $args{parent} - ? $args{parent} - : @{$args{commit}->parents} <= 1 - ? $args{commit}->parent_sha1 - : '-c'; + ? $args{parent} + : $args{commit}->parents <= 1 + ? $args{commit}->parent_sha1 + : '-c'; my @etc = ( ( $args{file} ? ('--', $args{file}) : () ), ); @@ -499,25 +527,25 @@ sub parse_diff { my @ret; for (@diff) { - # This regex is a little pathological. - if(m{^diff --git (a/(.*?)) (b/\2)}) { + # This regex is a little pathological. + if(m{^diff --git (a/(.*?)) (b/\2)}) { push @ret, { - head => $_, - a => $1, - b => $3, - file => $2, - diff => '', + head => $_, + a => $1, + b => $3, + file => $2, + diff => '', }; - next; - } - - if(/^index (\w+)\.\.(\w+) (\d+)$/) { - @{$ret[-1]}{qw(index src dst mode)} = ($_, $1, $2, $3); - next + next; } - - # XXX Somewhat hacky. Ahem. - $ret[-1]{diff} .= "$_\n"; + + if(/^index (\w+)\.\.(\w+) (\d+)$/) { + @{$ret[-1]}{qw(index src dst mode)} = ($_, $1, $2, $3); + next + } + + # XXX Somewhat hacky. Ahem. + $ret[@ret ? -1 : 0]{diff} .= "$_\n"; } return @ret; @@ -565,22 +593,11 @@ Given the output of the C command return a list of hashes. 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 @@ -593,12 +610,27 @@ array of hashes. 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} : ()), @@ -753,4 +785,5 @@ sub references { 1; -__PACKAGE__->meta->make_immutable; +# Yes, yes, I am a bad man. So sue me. +#__PACKAGE__->meta->make_immutable;