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