Initial cut at /blame action.
[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 __PACKAGE__->config->{namespace} = '';
8
9 use Sys::Hostname ();
10 use XML::Atom::Feed;
11 use XML::Atom::Entry;
12 use XML::RSS;
13
14 =head1 NAME
15
16 Gitalist::Controller::Root - Root Controller for Gitalist
17
18 =head1 DESCRIPTION
19
20 [enter your description here]
21
22 =head1 METHODS
23
24 =cut
25
26 sub _get_object {
27   my($self, $c, $haveh) = @_;
28
29   my $h = $haveh || $c->req->param('h') || '';
30   my $f = $c->req->param('f');
31
32   my $m = $c->stash->{Project};
33   my $pd = $m->path;
34
35   # Either use the provided h(ash) parameter, the f(ile) parameter or just use HEAD.
36   my $hash = ($h =~ /[^a-f0-9]/ ? $m->head_hash($h) : $h)
37           || ($f && $m->hash_by_path($f))
38           || $m->head_hash
39           # XXX This could definitely use more context.
40           || Carp::croak("Couldn't find a hash for the commit object!");
41
42   my $commit = $m->get_object($hash)
43     or Carp::croak("Couldn't find a commit object for '$hash' in '$pd'!");
44
45   return $commit;
46 }
47
48 =head2 index
49
50 Provides the project listing.
51
52 =cut
53
54 sub index :Path :Args(0) {
55   my ( $self, $c ) = @_;
56
57   $c->detach($c->req->param('a'))
58     if $c->req->param('a');
59
60   my @list = @{ $c->model()->projects };
61   die 'No projects found in '. $c->model->repo_dir
62     unless @list;
63
64   my $search = $c->req->param('s') || '';
65   if($search) {
66     @list = grep {
67          index($_->name, $search) > -1
68       or ( $_->description !~ /^Unnamed repository/ and index($_->description, $search) > -1 )
69     } @list
70   }
71
72   $c->stash(
73     search_text => $search,
74     projects    => \@list,
75     action      => 'index',
76   );
77 }
78
79 =head2 summary
80
81 A summary of what's happening in the repo.
82
83 =cut
84
85 sub summary : Local {
86   my ( $self, $c ) = @_;
87   my $project = $c->stash->{Project};
88   $c->detach('error_404') unless $project;
89   my $commit = $self->_get_object($c);
90   my @heads  = @{$project->heads};
91   my $maxitems = Gitalist->config->{paging}{summary} || 10;
92   $c->stash(
93     commit    => $commit,
94     log_lines => [$project->list_revs(
95         sha1 => $commit->sha1,
96         count => $maxitems,
97     )],
98     refs      => $project->references,
99     heads     => [ @heads[0 .. ($#heads < $maxitems ? $#heads : $maxitems)] ],
100     action    => 'summary',
101   );
102 }
103
104 =head2 heads
105
106 The current list of heads (aka branches) in the repo.
107
108 =cut
109
110 sub heads : Local {
111   my ( $self, $c ) = @_;
112   my $project = $c->stash->{Project};
113   $c->stash(
114     commit => $self->_get_object($c),
115     heads  => $project->heads,
116     action => 'heads',
117   );
118 }
119
120 =head2 tags
121
122 The current list of tags in the repo.
123
124 =cut
125
126 sub tags : Local {
127   my ( $self, $c ) = @_;
128   my $project = $c->stash->{Project};
129   $c->stash(
130     commit => $self->_get_object($c),
131     tags   => $project->tags,
132     action => 'tags',
133   );
134 }
135
136 sub blame : Local {
137   my($self, $c) = @_;
138
139   my $project = $c->stash->{Project};
140   my $h  = $c->req->param('h')
141        || $project->hash_by_path($c->req->param('hb'), $c->req->param('f'))
142        || die "No file or sha1 provided.";
143   my $hb = $c->req->param('hb')
144        || $project->head_hash
145        || die "Couldn't discern the corresponding head.";
146   my $filename = $c->req->param('f') || '';
147
148   my($metadata, $filedata) = $project->get_object($hb)->blame($filename);
149   $c->stash(
150     metadata => $metadata,
151     filedata => $filedata,
152     head     => $project->get_object($hb),
153     filename => $filename,
154   );
155   
156 }
157
158 =head2 blob
159
160 The blob action i.e the contents of a file.
161
162 =cut
163
164 sub blob : Local {
165   my ( $self, $c ) = @_;
166   my $project = $c->stash->{Project};
167   my $h  = $c->req->param('h')
168        || $project->hash_by_path($c->req->param('hb'), $c->req->param('f'))
169        || die "No file or sha1 provided.";
170   my $hb = $c->req->param('hb')
171        || $project->head_hash
172        || die "Couldn't discern the corresponding head.";
173
174   my $filename = $c->req->param('f') || '';
175
176   $c->stash(
177     blob     => $project->get_object($h)->content,
178     head     => $project->get_object($hb),
179     filename => $filename,
180     # XXX Hack hack hack, see View::SyntaxHighlight
181     language => ($filename =~ /\.p[lm]$/ ? 'Perl' : ''),
182     action   => 'blob',
183   );
184
185   $c->forward('View::SyntaxHighlight')
186     unless $c->stash->{no_wrapper};
187 }
188
189 sub blob_plain : Local {
190   my($self, $c) = @_;
191
192   $c->stash(no_wrapper => 1);
193   $c->response->content_type('text/plain; charset=utf-8');
194
195   $c->forward('blob');
196 }
197
198 sub blobdiff_plain : Local {
199   my($self, $c) = @_;
200
201   $c->stash(no_wrapper => 1);
202   $c->response->content_type('text/plain; charset=utf-8');
203
204   $c->forward('blobdiff');
205
206 }
207
208 =head2 blobdiff
209
210 Exposes a given diff of a blob.
211
212 =cut
213
214 sub blobdiff : Local {
215   my ( $self, $c ) = @_;
216   my $commit = $self->_get_object($c, $c->req->param('hb'));
217   my $filename = $c->req->param('f')
218               || croak("No file specified!");
219   my($tree, $patch) = $c->stash->{Project}->diff(
220     commit => $commit,
221     patch  => 1,
222     parent => $c->req->param('hpb') || undef,
223     file   => $filename,
224   );
225   $c->stash(
226     commit    => $commit,
227     diff      => $patch,
228     # XXX Hack hack hack, see View::SyntaxHighlight
229     blobs     => [$patch->[0]->{diff}],
230     language  => 'Diff',
231     action    => 'blobdiff',
232   );
233
234   $c->forward('View::SyntaxHighlight')
235     unless $c->stash->{no_wrapper};
236 }
237
238 =head2 commit
239
240 Exposes a given commit.
241
242 =cut
243
244 sub commit : Local {
245   my ( $self, $c ) = @_;
246   my $project = $c->stash->{Project};
247   my $commit = $self->_get_object($c);
248   $c->stash(
249       commit      => $commit,
250       diff_tree   => ($project->diff(commit => $commit))[0],
251       refs      => $project->references,
252       action      => 'commit',
253   );
254 }
255
256 =head2 commitdiff
257
258 Exposes a given diff of a commit.
259
260 =cut
261
262 sub commitdiff : Local {
263   my ( $self, $c ) = @_;
264   my $commit = $self->_get_object($c);
265   my($tree, $patch) = $c->stash->{Project}->diff(
266       commit => $commit,
267       parent => $c->req->param('hp') || undef,
268       patch  => 1,
269   );
270   $c->stash(
271     commit    => $commit,
272     diff_tree => $tree,
273     diff      => $patch,
274     # XXX Hack hack hack, see View::SyntaxHighlight
275     blobs     => [map $_->{diff}, @$patch],
276     language  => 'Diff',
277     action    => 'commitdiff',
278   );
279
280   $c->forward('View::SyntaxHighlight')
281     unless $c->stash->{no_wrapper};
282 }
283
284 sub commitdiff_plain : Local {
285   my($self, $c) = @_;
286
287   $c->stash(no_wrapper => 1);
288   $c->response->content_type('text/plain; charset=utf-8');
289
290   $c->forward('commitdiff');
291 }
292
293 =head2 shortlog
294
295 Expose an abbreviated log of a given sha1.
296
297 =cut
298
299 sub shortlog : Local {
300   my ( $self, $c ) = @_;
301   my $project = $c->stash->{Project};
302   my $commit  = $self->_get_object($c);
303   my %logargs = (
304       sha1   => $commit->sha1,
305       count  => Gitalist->config->{paging}{log} || 25,
306       ($c->req->param('f') ? (file => $c->req->param('f')) : ())
307   );
308
309   my $page = $c->req->param('pg') || 0;
310   $logargs{skip} = $c->req->param('pg') * $logargs{count}
311     if $c->req->param('pg');
312
313   $c->stash(
314       commit    => $commit,
315       log_lines => [$project->list_revs(%logargs)],
316       refs      => $project->references,
317       action    => 'shortlog',
318       page      => $page,
319   );
320 }
321
322 =head2 log
323
324 Calls shortlog internally. Perhaps that should be reversed ...
325
326 =cut
327 sub log : Local {
328     $_[0]->shortlog($_[1]);
329     $_[1]->stash->{action} = 'log';
330 }
331
332 # For legacy support.
333 sub history : Local {
334   $_[0]->shortlog(@_[1 .. $#_]);
335 }
336
337 =head2 tree
338
339 The tree of a given commit.
340
341 =cut
342
343 sub tree : Local {
344   my ( $self, $c ) = @_;
345   my $project = $c->stash->{Project};
346   my $commit  = $self->_get_object($c, $c->req->param('hb'));
347   my $tree    = $self->_get_object($c, $c->req->param('h') || $commit->tree_sha1);
348   $c->stash(
349       commit    => $commit,
350       tree      => $tree,
351       tree_list => [$project->list_tree($tree->sha1)],
352       path      => $c->req->param('f') || '',
353       action    => 'tree',
354   );
355 }
356
357 =head2 reflog
358
359 Expose the local reflog. This may go away.
360
361 =cut
362
363 sub reflog : Local {
364   my ( $self, $c ) = @_;
365   my @log = $c->stash->{Project}->reflog(
366       '--since=yesterday'
367   );
368
369   $c->stash(
370       log    => \@log,
371       action => 'reflog',
372   );
373 }
374
375 =head2 search
376
377 The action for the search form.
378
379 =cut
380
381 sub search : Local {
382   my($self, $c) = @_;
383   $c->stash(current_action => 'GitRepos');
384   my $project = $c->stash->{Project};
385   my $commit  = $self->_get_object($c);
386   # Lifted from /shortlog.
387   my %logargs = (
388     sha1   => $commit->sha1,
389     count  => Gitalist->config->{paging}{log},
390     ($c->req->param('f') ? (file => $c->req->param('f')) : ()),
391     search => {
392       type   => $c->req->param('type'),
393       text   => $c->req->param('text'),
394       regexp => $c->req->param('regexp') || 0,
395     },
396   );
397
398   $c->stash(
399       commit  => $commit,
400       results => [$project->list_revs(%logargs)],
401       action  => 'search',
402           # This could be added - page      => $page,
403   );
404 }
405
406 =head2 search_help
407
408 Provides some help for the search form.
409
410 =cut
411
412 sub search_help : Local {
413     my ($self, $c) = @_;
414     $c->stash(template => 'search_help.tt2');
415 }
416
417 =head2 atom
418
419 Provides an atom feed for a given project.
420
421 =cut
422
423 sub atom : Local {
424   my($self, $c) = @_;
425
426   my $feed = XML::Atom::Feed->new;
427
428   my $host = lc Sys::Hostname::hostname();
429   $feed->title($host . ' - ' . Gitalist->config->{name});
430   $feed->updated(~~DateTime->now);
431
432   my $project = $c->stash->{Project};
433   my %logargs = (
434       sha1   => $project->head_hash,
435       count  => Gitalist->config->{paging}{log} || 25,
436       ($c->req->param('f') ? (file => $c->req->param('f')) : ())
437   );
438
439   my $mk_title = $c->stash->{short_cmt};
440   for my $commit ($project->list_revs(%logargs)) {
441     my $entry = XML::Atom::Entry->new;
442     $entry->title( $mk_title->($commit->comment) );
443     $entry->id($c->uri_for('commit', {h=>$commit->sha1}));
444     # XXX Needs work ...
445     $entry->content($commit->comment);
446     $feed->add_entry($entry);
447   }
448
449   $c->response->body($feed->as_xml);
450   $c->response->content_type('application/atom+xml');
451   $c->response->status(200);
452 }
453
454 =head2 rss
455
456 Provides an RSS feed for a given project.
457
458 =cut
459
460 sub rss : Local {
461   my ($self, $c) = @_;
462
463   my $project = $c->stash->{Project};
464
465   my $rss = XML::RSS->new(version => '2.0');
466   $rss->channel(
467     title          => lc(Sys::Hostname::hostname()) . ' - ' . Gitalist->config->{name},
468     link           => $c->uri_for('summary', {p=>$project->name}),
469     language       => 'en',
470     description    => $project->description,
471     pubDate        => DateTime->now,
472     lastBuildDate  => DateTime->now,
473   );
474
475   my %logargs = (
476       sha1   => $project->head_hash,
477       count  => Gitalist->config->{paging}{log} || 25,
478       ($c->req->param('f') ? (file => $c->req->param('f')) : ())
479   );
480   my $mk_title = $c->stash->{short_cmt};
481   for my $commit ($project->list_revs(%logargs)) {
482     # XXX Needs work ....
483     $rss->add_item(
484         title       => $mk_title->($commit->comment),
485         permaLink   => $c->uri_for(commit => {h=>$commit->sha1}),
486         description => $commit->comment,
487     );
488   }
489
490   $c->response->body($rss->as_string);
491   $c->response->content_type('application/rss+xml');
492   $c->response->status(200);
493 }
494
495 =head2 patch
496
497 A raw patch for a given commit.
498
499 =cut
500
501 sub patch : Local {
502     my ($self, $c) = @_;
503     $c->detach('patches', [1]);
504 }
505
506 =head2 patches
507
508 The patcheset for a given commit ???
509
510 =cut
511
512 sub patches : Local {
513     my ($self, $c, $count) = @_;
514     $count ||= Gitalist->config->{patches}{max};
515     my $commit = $self->_get_object($c);
516     my $parent = $c->req->param('hp') || undef;
517     my $patch = $commit->get_patch( $parent, $count );
518     $c->response->body($patch);
519     $c->response->content_type('text/plain');
520     $c->response->status(200);
521 }
522
523 =head2 snapshot
524
525 Provides a snapshot of a given commit.
526
527 =cut
528
529 sub snapshot : Local {
530     my ($self, $c) = @_;
531     my $format = $c->req->param('sf') || 'tgz';
532     die unless $format;
533     my $sha1 = $c->req->param('h') || $self->_get_object($c)->sha1;
534     my @snap = $c->stash->{Project}->snapshot(
535         sha1 => $sha1,
536         format => $format
537     );
538     $c->response->status(200);
539     $c->response->headers->header( 'Content-Disposition' =>
540                                        "attachment; filename=$snap[0]");
541     $c->response->body($snap[1]);
542 }
543
544 =head2 auto
545
546 Populate the header and footer. Perhaps not the best location.
547
548 =cut
549
550 sub auto : Private {
551   my($self, $c) = @_;
552
553   my $project = $c->req->param('p');
554   if (defined $project) {
555     eval {
556       $c->stash(Project => $c->model('GitRepos')->project($project));
557     };
558     if ($@) {
559       $c->detach('error_404');
560     }
561   }
562
563   my $a_project = $c->stash->{Project} || $c->model()->projects->[0];
564   $c->stash(
565     git_version => $a_project->run_cmd('--version'),
566     version     => $Gitalist::VERSION,
567
568     # XXX Move these to a plugin!
569     time_since => sub {
570       return 'never' unless $_[0];
571       return age_string(time - $_[0]->epoch);
572     },
573     short_cmt => sub {
574       my $cmt = shift;
575       my($line) = split /\n/, $cmt;
576       $line =~ s/^(.{70,80}\b).*/$1 …/;
577       return $line;
578     },
579     abridged_description => sub {
580         join(' ', grep { defined } (split / /, shift)[0..10]);
581     },
582   );
583 }
584
585 sub project_index : Local {
586     # FIXME - implement snapshot
587     Carp::croak "Not implemented.";
588 }
589 sub opml : Local {
590     # FIXME - implement snapshot
591     Carp::croak "Not implemented.";
592 }
593
594 =head2 end
595
596 Attempt to render a view, if needed.
597
598 =cut
599
600 sub end : ActionClass('RenderView') {
601     my ($self, $c) = @_;
602     # Give project views the current HEAD.
603     if ($c->stash->{Project}) {
604         $c->stash->{HEAD} = $c->stash->{Project}->head_hash;
605     }
606 }
607
608 sub error_404 :Private {
609     my ($self, $c) = @_;
610     $c->response->status(404);
611     $c->stash(
612         title => 'Page not found',
613         content => 'Page not found',
614     );
615 }
616
617 sub age_string {
618   my $age = shift;
619   my $age_str;
620
621   if ( $age > 60 * 60 * 24 * 365 * 2 ) {
622     $age_str  = ( int $age / 60 / 60 / 24 / 365 );
623     $age_str .= " years ago";
624   }
625   elsif ( $age > 60 * 60 * 24 * ( 365 / 12 ) * 2 ) {
626     $age_str  = int $age / 60 / 60 / 24 / ( 365 / 12 );
627     $age_str .= " months ago";
628   }
629   elsif ( $age > 60 * 60 * 24 * 7 * 2 ) {
630     $age_str  = int $age / 60 / 60 / 24 / 7;
631     $age_str .= " weeks ago";
632   }
633   elsif ( $age > 60 * 60 * 24 * 2 ) {
634     $age_str  = int $age / 60 / 60 / 24;
635     $age_str .= " days ago";
636   }
637   elsif ( $age > 60 * 60 * 2 ) {
638     $age_str  = int $age / 60 / 60;
639     $age_str .= " hours ago";
640   }
641   elsif ( $age > 60 * 2 ) {
642     $age_str  = int $age / 60;
643     $age_str .= " min ago";
644   }
645   elsif ( $age > 2 ) {
646     $age_str  = int $age;
647     $age_str .= " sec ago";
648   }
649   else {
650     $age_str .= " right now";
651   }
652   return $age_str;
653 }
654
655
656 =head1 AUTHOR
657
658 Dan Brook
659
660 =head1 LICENSE
661
662 This library is free software. You can redistribute it and/or modify
663 it under the same terms as Perl itself.
664
665 =cut
666
667 __PACKAGE__->meta->make_immutable;