Tagtools.pm

   1 package Tagtools;
   2 use URI::Escape;
   3 use HTML::TagCloud;
   4 use Carp;
   5 use Cache::FileCache;
   6 use Storable qw(freeze); use MIME::Base64;
   7 use Calendar::Simple;
   8 use Text::Balanced qw(extract_multiple extract_quotelike);
   9 sub import {
  10     my $whence = caller;
  11     my ($class) = @_;
  12     my %cache_options = ( 'namespace' => $whence.'TagTools',
  13                        'default_expires_in' => 600 );
  14     my $cache =
  15        new Cache::FileCache( \%cache_options ) or
  16          croak( "Couldn't instantiate FileCache" );
  17     *{$whence."::zap_cache"} = sub { $cache->Clear };
  18     *{$whence."::do_cached"} = sub {
  19         my ($self, $codeblock,$arg) = @_;
  20         my $key = 0+$codeblock; if ($arg) { $key .=":".encode_base64(freeze(\$arg));  }
  21         my $c = $cache->get($key); return @$c if $c;
  22         my @stuff = $codeblock->($arg);
  23         $cache->set($key, [ @stuff ]);
  24         return @stuff;
  25     };
  26     *{$whence."::_tagcloud"} = sub {
  27         my $cloud = HTML::TagCloud->new();
  28         my $base = $whence->config->uri_base."tag/view/";
  29         for my $tagging (($whence."::Tagging")->search_summary) {
  30             my $name = $tagging->tag->name;
  31             $cloud->add($name, $base.uri_escape($name), $tagging->{count})
  32         }
  33         $cloud
  34     };
  35     *{$whence."::_calendar"} = sub {
  36         my $arg = shift;
  37         my ($y, $m) = split /-/, ($arg || Time::Piece->new->ymd);
  38         my @m = Calendar::Simple::calendar($m, $y);
  39         my @month;
  40         foreach my $week (@m) {
  41             my @weekdays;
  42             foreach my $day (@$week) {
  43                     my $d = { day => $day };
  44                     if ($day) {
  45                         my $tag = "date:$y-$m-".sprintf("%02d", $day);
  46                         my ($x) = ($whence."::SystemTag")->search(name => $tag);
  47                         if ($x) { $d->{tag} = "/system_tag/view/$tag" }
  48                     }
  49                     push(@weekdays, $d);
  50             }
  51             push(@month, \@weekdays);
  52         }
  53         return \@month;
  54     };
  55     for my $thing (qw(tagcloud calendar)) {
  56         *{$whence."::$thing"} = sub { shift->do_cached(\&{$whence."::_".$thing}, @_) }
  57     }
  58
  59 }
  60
  61 sub separate_tags {
  62     map { s/^"|"$//g; $_}
  63     extract_multiple(
  64         lc $_[1], [
  65             \&extract_quotelike,
  66             qr/([^\s,]+)/
  67         ], undef,1)
  68 }
  69
  70 # THIS IS A HACK
  71
  72 use Time::Seconds;
  73 sub Time::Piece::next_month {
  74     my $tp = shift;
  75     my $month = $tp + ONE_MONTH;
  76     return if $month > Time::Piece->new;
  77     return $month
  78 }
  79 sub Time::Piece::prev_month {
  80     my $tp = shift;
  81     my $month = $tp - ONE_MONTH;
  82     return $month
  83 }
  84
  85 1;