2 use Lingua::EN::Inflect::Number qw(to_PL);
7 use Storable qw(freeze); use MIME::Base64;
9 use Text::Balanced qw(extract_multiple extract_quotelike);
14 my %cache_options = ( 'namespace' => $whence.'TagTools',
15 'default_expires_in' => 600 );
17 new Cache::FileCache( \%cache_options ) or
18 croak( "Couldn't instantiate FileCache" );
19 *{$whence."::zap_cache"} = sub { $cache->Clear };
20 *{$whence."::do_cached"} = sub {
21 my ($self, $codeblock,$arg) = @_;
22 my $key = 0+$codeblock; if ($arg) { $key .=":".encode_base64(freeze(\$arg)); }
23 my $c = $cache->get($key); return @$c if $c;
24 my @stuff = $codeblock->($arg);
25 $cache->set($key, [ @stuff ]);
28 *{$whence."::_tagcloud"} = sub {
29 my $cloud = HTML::TagCloud->new();
30 my $base = $whence->config->uri_base."tag/view/";
31 for my $tagging (($whence."::Tagging")->search_summary) {
32 my $name = $tagging->tag->name;
33 $cloud->add($name, $base.uri_escape($name), $tagging->{count})
37 *{$whence."::_calendar"} = sub {
39 my ($y, $m) = split /-/, ($arg || Time::Piece->new->ymd);
40 my @m = Calendar::Simple::calendar($m, $y);
42 foreach my $week (@m) {
44 foreach my $day (@$week) {
45 my $d = { day => $day };
47 my $tag = "date:$y-$m-".sprintf("%02d", $day);
48 my ($x) = ($whence."::SystemTag")->search(name => $tag);
49 if ($x) { $d->{tag} = "/system_tag/view/$tag" }
53 push(@month, \@weekdays);
57 for my $thing (qw(tagcloud calendar)) {
58 *{$whence."::$thing"} = sub { shift->do_cached(\&{$whence."::_".$thing}, @_) }
60 *{$whence."::setup_tagging"} = \&Tagtools::_setup_tagging;
64 my ($maypole_class, $target_table, $tag_table_name) = @_;
66 $maypole_class->config->model->class_of($maypole_class, shift)
68 $tag_table_name ||= "tag";
69 my $target = $class_for->($target_table)
70 || die "Couldn't find a class representing $target_table";
71 my $via_table = $tag_table_name . "ging";
73 # Does the tag table exist?
74 # If not create it or at least moan
75 # If so configure it as a new class
77 # At this point, the $via_table should now be able to be named as...
78 my $tag_class = $class_for->($tag_table_name);
79 my $via_table = $tag_table_name."ging";
80 my $via = $tag_class."ging";
83 @{$via."::ISA"} = @{$tag_class."::ISA"};
84 $via->columns(TEMP => qw/count/);
85 $via->columns(Essential => "id", $tag_table_name, $target_table);
86 # Set up the auxilliary methods
87 $via->set_sql(summary => qq/
88 SELECT id, $tag_table_name, count(*) AS count
90 GROUP BY $tag_table_name
94 $via->set_sql(all => qq/
95 SELECT id, $tag_table_name, count(*) AS count
97 GROUP BY $tag_table_name
100 # Set up the has_many relations
101 $via->has_a($target_table => $target);
102 $via->has_a($tag_table_name => $tag_class);
103 $target->has_many(to_PL($tag_table_name) => [ $via => $tag_table_name ]);
104 $target->has_many(to_PL($via) => $via);
105 $tag_class->has_many(to_PL($target_table) => [ $via => $target_table ]);
106 $tag_class->has_many(to_PL($via_table) => $via);
110 map { s/^"|"$//g; $_}
121 sub Time::Piece::next_month {
123 my $month = $tp + ONE_MONTH;
124 return if $month > Time::Piece->new;
127 sub Time::Piece::prev_month {
129 my $month = $tp - ONE_MONTH;