Fix Pod and coverage
[catagits/Gitalist.git] / lib / Gitalist / Controller / Root.pm
index d6e6092..c479ee3 100644 (file)
@@ -10,6 +10,7 @@ use Sys::Hostname ();
 use XML::Atom::Feed;
 use XML::Atom::Entry;
 use XML::RSS;
+use XML::OPML::SimpleGen;
 
 =head1 NAME
 
@@ -39,10 +40,10 @@ sub _get_object {
           # XXX This could definitely use more context.
           || Carp::croak("Couldn't find a hash for the commit object!");
 
-  my $commit = $m->get_object($hash)
-    or Carp::croak("Couldn't find a commit object for '$hash' in '$pd'!");
+  my $obj = $m->get_object($hash)
+    or Carp::croak("Couldn't find a object for '$hash' in '$pd'!");
 
-  return $commit;
+  return $obj;
 }
 
 =head2 index
@@ -76,6 +77,20 @@ sub index :Path :Args(0) {
   );
 }
 
+sub project_index : Local {
+  my ( $self, $c ) = @_;
+
+  my @list = @{ $c->model()->projects };
+  die 'No projects found in '. $c->model->repo_dir
+    unless @list;
+
+  $c->response->content_type('text/plain');
+  $c->response->body(
+    join "\n", map $_->name, @list
+  );
+  $c->response->status(200);
+}
+
 =head2 summary
 
 A summary of what's happening in the repo.
@@ -153,13 +168,7 @@ sub blame : Local {
   
 }
 
-=head2 blob
-
-The blob action i.e the contents of a file.
-
-=cut
-
-sub blob : Local {
+sub _blob_objs {
   my ( $self, $c ) = @_;
   my $project = $c->stash->{Project};
   my $h  = $c->req->param('h')
@@ -171,9 +180,27 @@ sub blob : Local {
 
   my $filename = $c->req->param('f') || '';
 
+  my $blob = $project->get_object($h);
+  $blob = $project->get_object(
+    $project->hash_by_path($h || $hb, $filename)
+  ) if $blob->type ne 'blob';
+
+  return $blob, $project->get_object($hb), $filename;
+}
+
+=head2 blob
+
+The blob action i.e the contents of a file.
+
+=cut
+
+sub blob : Local {
+  my ( $self, $c ) = @_;
+
+  my($blob, $head, $filename) = $self->_blob_objs($c);
   $c->stash(
-    blob     => $project->get_object($h)->content,
-    head     => $project->get_object($hb),
+    blob     => $blob->content,
+    head     => $head,
     filename => $filename,
     # XXX Hack hack hack, see View::SyntaxHighlight
     language => ($filename =~ /\.p[lm]$/ ? 'Perl' : ''),
@@ -184,15 +211,27 @@ sub blob : Local {
     unless $c->stash->{no_wrapper};
 }
 
+=head2 blob_plain
+
+The plain text version of blob, where file is rendered as is.
+
+=cut
+
 sub blob_plain : Local {
   my($self, $c) = @_;
 
-  $c->stash(no_wrapper => 1);
+  my($blob) = $self->_blob_objs($c);
   $c->response->content_type('text/plain; charset=utf-8');
-
-  $c->forward('blob');
+  $c->response->body($blob->content);
+  $c->response->status(200);
 }
 
+=head2 blobdiff_plain
+
+The plain text version of blobdiff.
+
+=cut
+
 sub blobdiff_plain : Local {
   my($self, $c) = @_;
 
@@ -200,7 +239,6 @@ sub blobdiff_plain : Local {
   $c->response->content_type('text/plain; charset=utf-8');
 
   $c->forward('blobdiff');
-
 }
 
 =head2 blobdiff
@@ -299,7 +337,7 @@ sub shortlog : Local {
   my ( $self, $c ) = @_;
 
   my $project  = $c->stash->{Project};
-  my $commit   = $self->_get_object($c);
+  my $commit   = $self->_get_object($c, $c->req->param('hb'));
   my $filename = $c->req->param('f') || '';
 
   my %logargs = (
@@ -334,7 +372,7 @@ sub log : Local {
 
 # For legacy support.
 sub history : Local {
-  $_[0]->shortlog(@_[1 .. $#_]);
+  $_[1]->forward('shortlog');
 }
 
 =head2 tree
@@ -347,7 +385,11 @@ sub tree : Local {
   my ( $self, $c ) = @_;
   my $project = $c->stash->{Project};
   my $commit  = $self->_get_object($c, $c->req->param('hb'));
-  my $tree    = $self->_get_object($c, $c->req->param('h') || $commit->tree_sha1);
+  my $filename = $c->req->param('f') || '';
+  my $tree    = $filename
+    ? $project->get_object($project->hash_by_path($commit->sha1, $filename))
+    : $project->get_object($commit->tree_sha1)
+  ;
   $c->stash(
       commit    => $commit,
       tree      => $tree,
@@ -495,6 +537,29 @@ sub rss : Local {
   $c->response->status(200);
 }
 
+sub opml : Local {
+  my($self, $c) = @_;
+
+  my $opml = XML::OPML::SimpleGen->new();
+
+  $opml->head(title => lc(Sys::Hostname::hostname()) . ' - ' . Gitalist->config->{name});
+
+  my @list = @{ $c->model()->projects };
+  die 'No projects found in '. $c->model->repo_dir
+    unless @list;
+
+  for my $proj ( @list ) {
+    $opml->insert_outline(
+      text   => $proj->name. ' - '. $proj->description,
+      xmlUrl => $c->uri_for(rss => {p => $proj->name}),
+    );
+  }
+
+  $c->response->body($opml->as_string);
+  $c->response->content_type('application/rss');
+  $c->response->status(200);
+}
+
 =head2 patch
 
 A raw patch for a given commit.
@@ -585,15 +650,6 @@ sub auto : Private {
   );
 }
 
-sub project_index : Local {
-    # FIXME - implement snapshot
-    Carp::croak "Not implemented.";
-}
-sub opml : Local {
-    # FIXME - implement snapshot
-    Carp::croak "Not implemented.";
-}
-
 =head2 end
 
 Attempt to render a view, if needed.
@@ -655,16 +711,40 @@ sub age_string {
   return $age_str;
 }
 
+__PACKAGE__->meta->make_immutable;
+
+__END__
+
+=head1 NAME
+
+Gitalist::Controller::Root - Root controller for the application
+
+=head1 DESCRIPTION
+
+This controller handles all of the root level paths for the application
+
+=head1 METHODS
+
+=head2 age_string
+
+=head2 blame
+
+=head2 commitdiff_plain
+
+=head2 error_404
 
-=head1 AUTHOR
+=head2 history
 
-Dan Brook
+=head2 opml
+
+=head2 project_index
+
+=head1 AUTHORS
+
+See L<Gitalist> for authors.
 
 =head1 LICENSE
 
-This library is free software. You can redistribute it and/or modify
-it under the same terms as Perl itself.
+See L<Gitalist> for the license.
 
 =cut
-
-__PACKAGE__->meta->make_immutable;