Fix cat_file. (trivial)
[catagits/Gitalist.git] / lib / Gitalist / Model / Git.pm
index 5c8d69c..0a1f518 100644 (file)
@@ -2,11 +2,14 @@ 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';
 
+has repo_dir => ( is => 'ro', required => 1, isa => NonEmptySimpleStr );
+
 =head1 NAME
 
 Gitalist::Model::Git - the model for git interactions
@@ -20,23 +23,26 @@ 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 => $app->config->{repo_dir}, # FIXME - Move to model config
+    repo_dir => $self->repo_dir,
   );
 
   # This is fugly as fuck. Move Git::PurePerl construction into attribute builders..
-  (my $pd = $self->project_dir( $self->project )) =~ s{/\.git$}();
-  $model->gpp( Git::PurePerl->new(directory => $pd) );
+  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__->meta->make_immutable;
+
 package Git::Repos; # Better name? Split out into own file once we have a sane name.
 use Moose;
 use namespace::autoclean;
@@ -247,29 +253,28 @@ each item will contain the contents of L</project_info>.
 =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];
@@ -376,7 +381,7 @@ Return the contents of a given file.
 sub cat_file {
   my ($self, $object, $project) = @_;
 
-  my $type = $self->get_object_type($object, $project);
+  my $type = $self->get_object_type($object, $project || $self->project);
   die "object `$object' is not a file\n"
     if (!defined $type || $type ne 'blob');
 
@@ -477,10 +482,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}) : () ),
   );
@@ -574,22 +579,11 @@ Given the output of the C<rev-list> 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
@@ -602,12 +596,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} : ()),