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