Fixed syntax error in Root.pm & tidied up tests.
[catagits/Gitalist.git] / lib / Gitalist / Controller / Root.pm
1 package Gitalist::Controller::Root;
2 use Moose;
3 use namespace::autoclean;
4
5 BEGIN { extends 'Catalyst::Controller' }
6
7 #
8 # Sets the actions in this controller to be registered with no prefix
9 # so they function identically to actions created in MyApp.pm
10 #
11 __PACKAGE__->config->{namespace} = '';
12
13 use IO::Capture::Stdout;
14 use Sys::Hostname ();
15 use XML::Atom::Feed;
16 use XML::Atom::Entry;
17 use XML::RSS;
18
19 =head1 NAME
20
21 Gitalist::Controller::Root - Root Controller for Gitalist
22
23 =head1 DESCRIPTION
24
25 [enter your description here]
26
27 =head1 METHODS
28
29 =cut
30
31 =head2 index
32
33 =cut
34
35 =head2 run_gitweb
36
37 The C<gitweb> shim. It should now only be explicitly accessible by
38 modifying the URL.
39
40 =cut
41
42 sub run_gitweb {
43   my ( $self, $c ) = @_;
44
45   # XXX A slippery slope to be sure.
46   if($c->req->param('a')) {
47     my $capture = IO::Capture::Stdout->new();
48     $capture->start();
49     eval {
50       my $action = gitweb::main($c);
51       $action->();
52     };
53     $capture->stop();
54
55     use Data::Dumper;
56     die Dumper($@)
57       if $@;
58
59     my $output = join '', $capture->read;
60     $c->stash->{gitweb_output} = $output;
61     $c->stash->{template} = 'gitweb.tt2';
62   }
63 }
64
65 sub _get_object {
66   my($self, $c, $haveh) = @_;
67
68   my $h = $haveh || $c->req->param('h') || '';
69   my $f = $c->req->param('f');
70
71   my $m = $c->stash->{Project};
72   my $pd = $m->path;
73
74   # Either use the provided h(ash) parameter, the f(ile) parameter or just use HEAD.
75   my $hash = ($h =~ /[^a-f0-9]/ ? $m->head_hash($h) : $h)
76           || ($f && $m->hash_by_path($f))
77           || $m->head_hash
78           # XXX This could definitely use more context.
79           || Carp::croak("Couldn't find a hash for the commit object!");
80
81   my $commit = $m->get_object($hash)
82     or Carp::croak("Couldn't find a commit object for '$hash' in '$pd'!");
83
84   return $commit;
85 }
86
87 =head2 index
88
89 Provides the project listing.
90
91 =cut
92
93 sub index :Path :Args(0) {
94   my ( $self, $c ) = @_;
95
96   $c->detach($c->req->param('a'))
97     if $c->req->param('a');
98
99   my @list = @{ $c->model()->projects };
100   die 'No projects found in '. $c->model->repo_dir
101     unless @list;
102
103   my $search = $c->req->param('s') || '';
104   if($search) {
105     @list = grep {
106          index($_->name, $search) > -1
107       or ( $_->description !~ /^Unnamed repository/ and index($_->description, $search) > -1 )
108     } @list
109   }
110
111   $c->stash(
112     search_text => $search,
113     projects    => \@list,
114     action      => 'index',
115   );
116 }
117
118 =head2 summary
119
120 A summary of what's happening in the repo.
121
122 =cut
123
124 sub summary : Local {
125   my ( $self, $c ) = @_;
126   my $project = $c->stash->{Project};
127   $c->detach('error_404') unless $project;
128   my $commit = $self->_get_object($c);
129   my @heads  = @{$project->heads};
130   my $maxitems = Gitalist->config->{paging}{summary} || 10;
131   $c->stash(
132     commit    => $commit,
133     log_lines => [$project->list_revs(
134         sha1 => $commit->sha1,
135         count => $maxitems,
136     )],
137     refs      => $project->references,
138     heads     => [ @heads[0 .. ($#heads < $maxitems ? $#heads : $maxitems)] ],
139     action    => 'summary',
140   );
141 }
142
143 =head2 heads
144
145 The current list of heads (aka branches) in the repo.
146
147 =cut
148
149 sub heads : Local {
150   my ( $self, $c ) = @_;
151   my $project = $c->stash->{Project};
152   $c->stash(
153     commit => $self->_get_object($c),
154     heads  => $project->heads,
155     action => 'heads',
156   );
157 }
158
159 =head2 blob
160
161 The blob action i.e the contents of a file.
162
163 =cut
164
165 sub blob : Local {
166   my ( $self, $c ) = @_;
167   my $project = $c->stash->{Project};
168   my $h  = $c->req->param('h')
169        || $project->hash_by_path($c->req->param('hb'), $c->req->param('f'))
170        || die "No file or sha1 provided.";
171   my $hb = $c->req->param('hb')
172        || $project->head_hash
173        || die "Couldn't discern the corresponding head.";
174
175   my $filename = $c->req->param('f') || '';
176
177   $c->stash(
178     blob     => $project->get_object($h)->content,
179     head     => $project->get_object($hb),
180     filename => $filename,
181     # XXX Hack hack hack, see View::SyntaxHighlight
182     language => ($filename =~ /\.p[lm]$/ ? 'Perl' : ''),
183     action   => 'blob',
184   );
185
186   $c->forward('View::SyntaxHighlight')
187     unless $c->stash->{no_wrapper};
188 }
189
190 sub blob_plain : Local {
191   my($self, $c) = @_;
192
193   $c->stash(no_wrapper => 1);
194   $c->response->content_type('text/plain; charset=utf-8');
195
196   $c->forward('blob');
197 }
198
199 sub blobdiff_plain : Local {
200   my($self, $c) = @_;
201
202   $c->stash(no_wrapper => 1);
203   $c->response->content_type('text/plain; charset=utf-8');
204
205   $c->forward('blobdiff');
206
207 }
208
209 =head2 blobdiff
210
211 Exposes a given diff of a blob.
212
213 =cut
214
215 sub blobdiff : Local {
216   my ( $self, $c ) = @_;
217   my $commit = $self->_get_object($c, $c->req->param('hb'));
218   my $filename = $c->req->param('f')
219               || croak("No file specified!");
220   my($tree, $patch) = $c->stash->{Project}->diff(
221     commit => $commit,
222     patch  => 1,
223     parent => $c->req->param('hpb') || undef,
224     file   => $filename,
225   );
226   $c->stash(
227     commit    => $commit,
228     diff      => $patch,
229     # XXX Hack hack hack, see View::SyntaxHighlight
230     blobs     => [$patch->[0]->{diff}],
231     language  => 'Diff',
232     action    => 'blobdiff',
233   );
234
235   $c->forward('View::SyntaxHighlight')
236     unless $c->stash->{no_wrapper};
237 }
238
239 =head2 commit
240
241 Exposes a given commit.
242
243 =cut
244
245 sub commit : Local {
246   my ( $self, $c ) = @_;
247   my $project = $c->stash->{Project};
248   my $commit = $self->_get_object($c);
249   $c->stash(
250       commit      => $commit,
251       diff_tree   => ($project->diff(commit => $commit))[0],
252       refs      => $project->references,
253       action      => 'commit',
254   );
255 }
256
257 =head2 commitdiff
258
259 Exposes a given diff of a commit.
260
261 =cut
262
263 sub commitdiff : Local {
264   my ( $self, $c ) = @_;
265   my $commit = $self->_get_object($c);
266   my($tree, $patch) = $c->stash->{Project}->diff(
267       commit => $commit,
268       parent => $c->req->param('hp') || undef,
269       patch  => 1,
270   );
271   $c->stash(
272     commit    => $commit,
273     diff_tree => $tree,
274     diff      => $patch,
275     # XXX Hack hack hack, see View::SyntaxHighlight
276     blobs     => [map $_->{diff}, @$patch],
277     language  => 'Diff',
278     action    => 'commitdiff',
279   );
280
281   $c->forward('View::SyntaxHighlight')
282     unless $c->stash->{no_wrapper};
283 }
284
285 sub commitdiff_plain : Local {
286   my($self, $c) = @_;
287
288   $c->stash(no_wrapper => 1);
289   $c->response->content_type('text/plain; charset=utf-8');
290
291   $c->forward('commitdiff');
292 }
293
294 =head2 shortlog
295
296 Expose an abbreviated log of a given sha1.
297
298 =cut
299
300 sub shortlog : Local {
301   my ( $self, $c ) = @_;
302   my $project = $c->stash->{Project};
303   my $commit  = $self->_get_object($c);
304   my %logargs = (
305       sha1   => $commit->sha1,
306       count  => Gitalist->config->{paging}{log} || 25,
307       ($c->req->param('f') ? (file => $c->req->param('f')) : ())
308   );
309
310   my $page = $c->req->param('pg') || 0;
311   $logargs{skip} = $c->req->param('pg') * $logargs{count}
312     if $c->req->param('pg');
313
314   $c->stash(
315       commit    => $commit,
316       log_lines => [$project->list_revs(%logargs)],
317       refs      => $project->references,
318       action    => 'shortlog',
319       page      => $page,
320   );
321 }
322
323 =head2 log
324
325 Calls shortlog internally. Perhaps that should be reversed ...
326
327 =cut
328 sub log : Local {
329     $_[0]->shortlog($_[1]);
330     $_[1]->stash->{action} = 'log';
331 }
332
333 # For legacy support.
334 sub history : Local {
335   $_[0]->shortlog(@_[1 .. $#_]);
336 }
337
338 =head2 tree
339
340 The tree of a given commit.
341
342 =cut
343
344 sub tree : Local {
345   my ( $self, $c ) = @_;
346   my $project = $c->stash->{Project};
347   my $commit  = $self->_get_object($c, $c->req->param('hb'));
348   my $tree    = $self->_get_object($c, $c->req->param('h') || $commit->tree_sha1);
349   $c->stash(
350       commit    => $commit,
351       tree      => $tree,
352       tree_list => [$project->list_tree($tree->sha1)],
353       path      => $c->req->param('f') || '',
354       action    => 'tree',
355   );
356 }
357
358 =head2 reflog
359
360 Expose the local reflog. This may go away.
361
362 =cut
363
364 sub reflog : Local {
365   my ( $self, $c ) = @_;
366   my @log = $c->stash->{Project}->reflog(
367       '--since=yesterday'
368   );
369
370   $c->stash(
371       log    => \@log,
372       action => 'reflog',
373   );
374 }
375
376 sub search : Local {
377   my($self, $c) = @_;
378   $c->stash(current_action => 'GitRepos');
379   my $project = $c->stash->{Project};
380   my $commit  = $self->_get_object($c);
381   # Lifted from /shortlog.
382   my %logargs = (
383     sha1   => $commit->sha1,
384     count  => Gitalist->config->{paging}{log},
385     ($c->req->param('f') ? (file => $c->req->param('f')) : ()),
386     search => {
387       type   => $c->req->param('type'),
388       text   => $c->req->param('text'),
389       regexp => $c->req->param('regexp') || 0,
390     },
391   );
392
393   $c->stash(
394       commit  => $commit,
395       results => [$project->list_revs(%logargs)],
396       action  => 'search',
397           # This could be added - page      => $page,
398   );
399 }
400
401 sub search_help : Local {
402     my ($self, $c) = @_;
403     $c->stash(template => 'search_help.tt2');
404 }
405
406 sub atom : Local {
407   my($self, $c) = @_;
408
409   my $feed = XML::Atom::Feed->new;
410
411   my $host = lc Sys::Hostname::hostname();
412   $feed->title($host . ' - ' . Gitalist->config->{name});
413   $feed->updated(~~DateTime->now);
414
415   my $project = $c->stash->{Project};
416   my %logargs = (
417       sha1   => $project->head_hash,
418       count  => Gitalist->config->{paging}{log} || 25,
419       ($c->req->param('f') ? (file => $c->req->param('f')) : ())
420   );
421
422   my $mk_title = $c->stash->{short_cmt};
423   for my $commit ($project->list_revs(%logargs)) {
424     my $entry = XML::Atom::Entry->new;
425     $entry->title( $mk_title->($commit->comment) );
426     $entry->id($c->uri_for('commit', {h=>$commit->sha1}));
427     # XXX Needs work ...
428     $entry->content($commit->comment);
429     $feed->add_entry($entry);
430   }
431
432   $c->response->body($feed->as_xml);
433   $c->response->content_type('application/atom+xml');
434   $c->response->status(200);
435 }
436
437 sub rss : Local {
438   my ($self, $c) = @_;
439
440   my $project = $c->stash->{Project};
441
442   my $rss = XML::RSS->new(version => '2.0');
443   $rss->channel(
444     title          => lc(Sys::Hostname::hostname()) . ' - ' . Gitalist->config->{name},
445     link           => $c->uri_for('summary', {p=>$project->name}),
446     language       => 'en',
447     description    => $project->description,
448     pubDate        => DateTime->now,
449     lastBuildDate  => DateTime->now,
450   );
451
452   my %logargs = (
453       sha1   => $project->head_hash,
454       count  => Gitalist->config->{paging}{log} || 25,
455       ($c->req->param('f') ? (file => $c->req->param('f')) : ())
456   );
457   my $mk_title = $c->stash->{short_cmt};
458   for my $commit ($project->list_revs(%logargs)) {
459     # XXX Needs work ....
460     $rss->add_item(
461         title       => $mk_title->($commit->comment),
462         permaLink   => $c->uri_for(commit => {h=>$commit->sha1}),
463         description => $commit->comment,
464     );
465   }
466
467   $c->response->body($rss->as_string);
468   $c->response->content_type('application/rss+xml');
469   $c->response->status(200);
470 }
471
472 sub patch : Local {
473     my ($self, $c) = @_;
474     $c->detach('patches', [1]);
475 }
476
477 sub patches : Local {
478     my ($self, $c, $count) = @_;
479     $count ||= Gitalist->config->{patches}{max};
480     my $commit = $self->_get_object($c);
481     my $parent = $c->req->param('hp') || undef;
482     my $patch = $commit->get_patch( $parent, $count );
483     $c->response->body($patch);
484     $c->response->content_type('text/plain');
485     $c->response->status(200);
486 }
487
488 sub snapshot : Local {
489     # FIXME - implement snapshot
490     Carp::croak "Not implemented.";
491 }
492
493 =head2 auto
494
495 Populate the header and footer. Perhaps not the best location.
496
497 =cut
498
499 sub auto : Private {
500   my($self, $c) = @_;
501
502   # XXX Move these to a plugin!
503   $c->stash(
504     time_since => sub {
505       return 'never' unless $_[0];
506       return age_string(time - $_[0]->epoch);
507     },
508     short_cmt => sub {
509       my $cmt = shift;
510       my($line) = split /\n/, $cmt;
511       $line =~ s/^(.{70,80}\b).*/$1 …/;
512       return $line;
513     },
514     abridged_description => sub {
515         join(' ', grep { defined } (split / /, shift)[0..10]);
516     },
517   );
518
519   # Yes, this is hideous.
520   $self->header($c);
521   $self->footer($c);
522 }
523
524 # XXX This could probably be dropped altogether.
525 use Gitalist::Util qw(to_utf8);
526 # Formally git_header_html
527 sub header {
528   my($self, $c) = @_;
529
530   my $title = $c->config->{sitename};
531
532   my $project   = $c->req->param('project')  || $c->req->param('p');
533   my $action    = $c->req->param('action')   || $c->req->param('a');
534   my $file_name = $c->req->param('filename') || $c->req->param('f');
535   if(defined $project) {
536     $title .= " - " . to_utf8($project);
537     if (defined $action) {
538       $title .= "/$action";
539       if (defined $file_name) {
540         $title .= " - " . $file_name;
541         if ($action eq "tree" && $file_name !~ m|/$|) {
542           $title .= "/";
543         }
544       }
545     }
546   }
547
548   $c->stash->{version}     = $Gitalist::VERSION;
549   # check git's version by running it on the first project in the list.
550   $c->stash->{title}       = $title;
551
552   $c->stash->{stylesheet} = $c->config->{stylesheet} || 'gitweb.css';
553
554   $c->stash->{project} = $project;
555   my @links;
556   if($project) {
557     my %href_params = $self->feed_info($c);
558     $href_params{'-title'} ||= 'log';
559
560     foreach my $format qw(RSS Atom) {
561       my $type = lc($format);
562       push @links, {
563         rel   => 'alternate',
564         title => "$project - $href_params{'-title'} - $format feed",
565
566         # XXX A bit hacky and could do with using gitweb::href() features
567         href  => "?a=$type;p=$project",
568         type  => "application/$type+xml"
569         }, {
570         rel   => 'alternate',
571
572         # XXX This duplication also feels a bit awkward
573         title => "$project - $href_params{'-title'} - $format feed (no merges)",
574         href  => "?a=$type;p=$project;opt=--no-merges",
575         type  => "application/$type+xml"
576         };
577     }
578   } else {
579     push @links, {
580       rel => "alternate",
581       title => $c->config->{sitename}." projects list",
582       href => '?a=project_index',
583       type => "text/plain; charset=utf-8"
584       }, {
585       rel => "alternate",
586       title => $c->config->{sitename}." projects feeds",
587       href => '?a=opml',
588       type => "text/plain; charset=utf-8"
589       };
590   }
591
592   $c->stash->{favicon} = $c->config->{favicon};
593
594   # </head><body>
595
596   $c->stash(
597     logo_url      => $c->config->{logo_url},
598     logo_label    => $c->config->{logo_label},
599     logo_img      => $c->config->{logo},
600     home_link     => $c->config->{home_link},
601     home_link_str => $c->config->{home_link_str},
602     );
603
604   if (defined $project) {
605       eval {
606           $c->stash(Project => $c->model('GitRepos')->project($project));
607       };
608       if ($@) {
609           $c->detach('error_404');
610       }
611       $c->stash(
612           search_text => ( $c->req->param('s') ||
613                                $c->req->param('searchtext') || ''),
614           search_hash => ( $c->req->param('hb') || $c->req->param('hashbase')
615                                || $c->req->param('h')  || $c->req->param('hash')
616                                    || 'HEAD' ),
617       );
618   }
619   my $a_project = $c->stash->{Project} || $c->model()->projects->[0];
620   $c->stash->{git_version} = $a_project->run_cmd('--version');
621 }
622
623 # Formally git_footer_html
624 sub footer {
625   my($self, $c) = @_;
626
627   my $feed_class = 'rss_logo';
628
629   my @feeds;
630   my $project = $c->req->param('project')  || $c->req->param('p');
631   if(defined $project) {
632     (my $pstr = $project) =~ s[/?\.git$][];
633     my $descr = $c->stash->{project_description}
634             = $c->stash->{Project} ? $c->stash->{Project}->description : '';
635
636     my %href_params = $self->feed_info($c);
637     if (!%href_params) {
638       $feed_class .= ' generic';
639     }
640     $href_params{'-title'} ||= 'log';
641
642     @feeds = [
643       map +{
644         class => $feed_class,
645         title => "$href_params{'-title'} $_ feed",
646         href  => "/?p=$project;a=\L$_",
647         name  => lc $_,
648         }, qw(RSS Atom)
649       ];
650   } else {
651     @feeds = [
652       map {
653         class => $feed_class,
654           title => '',
655           href  => "/?a=$_->[0]",
656           name  => $_->[1],
657         }, [opml=>'OPML'],[project_index=>'TXT'],
658       ];
659   }
660 }
661
662 # XXX This feels wrong here, should probably be refactored.
663 # returns hash to be passed to href to generate gitweb URL
664 # in -title key it returns description of link
665 sub feed_info {
666   my($self, $c) = @_;
667
668   my $format = shift || 'Atom';
669   my %res = (action => lc($format));
670
671   # feed links are possible only for project views
672   return unless $c->req->param('project');
673
674   # some views should link to OPML, or to generic project feed,
675   # or don't have specific feed yet (so they should use generic)
676   return if $c->req->param('action') =~ /^(?:tags|heads|forks|tag|search)$/x;
677
678   my $branch;
679   my $hash = $c->req->param('h')  || $c->req->param('hash');
680   my $hash_base = $c->req->param('hb') || $c->req->param('hashbase');
681
682   # branches refs uses 'refs/heads/' prefix (fullname) to differentiate
683   # from tag links; this also makes possible to detect branch links
684   if ((defined $hash_base && $hash_base =~ m!^refs/heads/(.*)$!) ||
685     (defined $hash      && $hash      =~ m!^refs/heads/(.*)$!)) {
686     $branch = $1;
687   }
688
689   # find log type for feed description (title)
690   my $type = 'log';
691   my $file_name = $c->req->param('f') || $c->req->param('filename');
692   if (defined $file_name) {
693     $type  = "history of $file_name";
694     $type .= "/" if $c->req->param('action') eq 'tree';
695     $type .= " on '$branch'" if (defined $branch);
696   } else {
697     $type = "log of $branch" if (defined $branch);
698   }
699
700   $res{-title} = $type;
701   $res{'hash'} = (defined $branch ? "refs/heads/$branch" : undef);
702   $res{'file_name'} = $file_name;
703
704   return %res;
705 }
706
707 =head2 end
708
709 Attempt to render a view, if needed.
710
711 =cut
712
713 sub end : ActionClass('RenderView') {
714     my ($self, $c) = @_;
715     # Give project views the current HEAD.
716     if ($c->stash->{Project}) {
717         $c->stash->{HEAD} = $c->stash->{Project}->head_hash;
718     }
719 }
720
721 sub error_404 :Private {
722     my ($self, $c) = @_;
723     $c->response->status(404);
724     $c->stash(
725         title => 'Page not found',
726         content => 'Page not found',
727     );
728 }
729
730 sub age_string {
731         my $age = shift;
732         my $age_str;
733
734         if ($age > 60*60*24*365*2) {
735                 $age_str = (int $age/60/60/24/365);
736                 $age_str .= " years ago";
737         } elsif ($age > 60*60*24*(365/12)*2) {
738                 $age_str = int $age/60/60/24/(365/12);
739                 $age_str .= " months ago";
740         } elsif ($age > 60*60*24*7*2) {
741                 $age_str = int $age/60/60/24/7;
742                 $age_str .= " weeks ago";
743         } elsif ($age > 60*60*24*2) {
744                 $age_str = int $age/60/60/24;
745                 $age_str .= " days ago";
746         } elsif ($age > 60*60*2) {
747                 $age_str = int $age/60/60;
748                 $age_str .= " hours ago";
749         } elsif ($age > 60*2) {
750                 $age_str = int $age/60;
751                 $age_str .= " min ago";
752         } elsif ($age > 2) {
753                 $age_str = int $age;
754                 $age_str .= " sec ago";
755         } else {
756                 $age_str .= " right now";
757         }
758         return $age_str;
759 }
760
761 =head1 AUTHOR
762
763 Dan Brook
764
765 =head1 LICENSE
766
767 This library is free software. You can redistribute it and/or modify
768 it under the same terms as Perl itself.
769
770 =cut
771
772 __PACKAGE__->meta->make_immutable;