| 96 | | |
|---|
| 97 | | use Cache::SharedMemoryCache; |
|---|
| 98 | | my %cache_options = ( 'namespace' => 'MemoriesStuff', |
|---|
| 99 | | 'default_expires_in' => 600 ); |
|---|
| 100 | | my $cache = |
|---|
| 101 | | new Cache::SharedMemoryCache( \%cache_options ) or |
|---|
| 102 | | croak( "Couldn't instantiate SharedMemoryCache" ); |
|---|
| 103 | | |
|---|
| 104 | | sub zap_cache { $cache->Clear } |
|---|
| 105 | | use Storable qw(freeze); use MIME::Base64; |
|---|
| 106 | | sub do_cached { |
|---|
| 107 | | my ($self, $codeblock,$arg) = @_; |
|---|
| 108 | | my $key = 0+$codeblock; if ($arg) { $key .=":".encode_base64(freeze(\$arg)); } |
|---|
| 109 | | my $c = $cache->get(0+$codeblock); return @$c if $c; |
|---|
| 110 | | my @stuff = $codeblock->($arg); |
|---|
| 111 | | $cache->set(0+$codeblock, [ @stuff ]); |
|---|
| 112 | | return @stuff; |
|---|
| 113 | | } |
|---|
| 114 | | |
|---|
| 121 | | |
|---|
| 122 | | sub tagcloud { shift->do_cached(\&_tagcloud) } |
|---|
| 123 | | |
|---|
| 124 | | sub _tagcloud { |
|---|
| 125 | | my $cloud = HTML::TagCloud->new(); |
|---|
| 126 | | my $base = Memories->config->uri_base."tag/view/"; |
|---|
| 127 | | for my $tagging (Memories::Tagging->search_summary) { |
|---|
| 128 | | my $name = $tagging->tag->name; |
|---|
| 129 | | $cloud->add($name, |
|---|
| 130 | | $base.uri_escape($name), |
|---|
| 131 | | $tagging->{count} |
|---|
| 132 | | ) |
|---|
| 133 | | } |
|---|
| 134 | | $cloud |
|---|
| 135 | | } |
|---|
| 136 | | |
|---|
| 137 | | sub calendar { |
|---|
| 138 | | # shift->do_cached(\&_calendar, shift ) } |
|---|
| 139 | | #sub _calendar { |
|---|
| 140 | | my $self = shift; |
|---|
| 141 | | my $arg = shift; |
|---|
| 142 | | my ($y, $m) = split /-/, ($arg || Time::Piece->new->ymd); |
|---|
| 143 | | my @m = Calendar::Simple::calendar($m, $y); |
|---|
| 144 | | my @month; |
|---|
| 145 | | foreach my $week (@m) { |
|---|
| 146 | | my @weekdays; |
|---|
| 147 | | foreach my $day (@$week) { |
|---|
| 148 | | my $d = { day => $day }; |
|---|
| 149 | | if ($day) { |
|---|
| 150 | | my $tag = "date:$y-$m-".sprintf("%02d", $day); |
|---|
| 151 | | my ($x) = Memories::SystemTag->search(name => $tag); |
|---|
| 152 | | if ($x) { $d->{tag} = "/system_tag/view/$tag" } |
|---|
| 153 | | } |
|---|
| 154 | | push(@weekdays, $d); |
|---|
| 155 | | } |
|---|
| 156 | | push(@month, \@weekdays); |
|---|
| 157 | | } |
|---|
| 158 | | return \@month; |
|---|
| 159 | | } |
|---|
| 160 | | |
|---|
| 161 | | # THIS IS A HACK |
|---|
| 162 | | |
|---|
| 163 | | use Time::Seconds; |
|---|
| 164 | | sub Time::Piece::next_month { |
|---|
| 165 | | my $tp = shift; |
|---|
| 166 | | my $month = $tp + ONE_MONTH; |
|---|
| 167 | | return if $month > Time::Piece->new; |
|---|
| 168 | | return $month |
|---|
| 169 | | } |
|---|
| 170 | | sub Time::Piece::prev_month { |
|---|
| 171 | | my $tp = shift; |
|---|
| 172 | | my $month = $tp - ONE_MONTH; |
|---|
| 173 | | return $month |
|---|
| 174 | | } |
|---|
| 175 | | |
|---|
