1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97
|
package MojoMojo::Controller::Tag;
use strict;
use parent 'Catalyst::Controller';
use HTML::TagCloud;
=head1 NAME
MojoMojo::Controller::Tag - Tags controller
=head1 SYNOPSIS
Handles the following URLs
/.tags/
/.list/<tag> (dispatched from Page)
/.recent/<tag> (dispatched from Page)
=head1 DESCRIPTION
This controller generates a tag cloud and retrieves (all or recent) pages
tagged with a given tag.
=head1 ACTIONS
=head2 list
This is a private action, and is dispatched from
L</.list|MojoMojo::Controller::Page/list> when supplied with a tag
argument. It will list all pages tagged with the given tag.
=cut
sub list : Private {
my ( $self, $c, $tag ) = @_;
return unless $tag;
$c->stash->{template} = 'page/list.tt';
$c->stash->{activetag} = $tag;
$c->stash->{pages} = [ $c->stash->{page}->tagged_descendants($tag) ];
$c->stash->{related} = [ $c->model("DBIC::Tag")->related_to($tag) ];
}
=head2 recent
This is a private action, and is dispatched from
L</.recent|MojoMojo::Controller::Page/recent> when supplied with a tag
argument. It will list recent pages tagged with the given tag.
=cut
sub recent : Private {
my ( $self, $c, $tag ) = @_;
$c->stash->{template} = 'page/recent.tt';
return unless $tag;
$c->stash->{activetag} = $tag;
$c->stash->{pages} = [ $c->stash->{page}->tagged_descendants_by_date($tag) ];
}
=head2 tags (/.tags)
Tag cloud for pages.
=cut
sub tags : Global {
my ( $self, $c, $tag ) = @_;
my $tags = [ $c->model("DBIC::Tag")->by_page( $c->stash->{page}->id ) ];
my %tags;
map {
$tags{$_->tag}++;
}@$tags;
my $cloud = HTML::TagCloud->new();
foreach my $tag (keys %tags) {
$cloud->add(
$tag,
$c->req->base . $c->stash->{path} . '.list/' . $tag,
$tags{$tag}
);
}
$c->stash->{cloud} = $cloud;
$c->stash->{template} = 'tag/cloud.tt';
}
=head1 AUTHOR
Marcus Ramberg <mramberg@cpan.org>
=head1 LICENSE
This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
1;
|