5 use Maypole::Application qw(Upload Authentication::UserSessionCookie
10 use Memories::Comment;
12 use Memories::SystemTag;
18 Memories->config->auth->{ user_field } = "name";
19 Memories->config->model("Maypole::Model::CDBI::Plain");
20 Memories->setup([qw/ Memories::Photo Memories::User Memories::Tag
21 Memories::Album Memories::SystemTag/]);
24 my ($self, $message) = @_;
25 push @{$self->{template_args}{messages}}, $message;
30 if ($r->params->{view_cal}) {
31 $r->{template_args}{view_cal} = eval {
32 Time::Piece->strptime($r->{params}{view_cal}, "%Y-%m-%d") };
34 $r->{template_args}{now} = Time::Piece->new;
37 use Maypole::Constants;
40 return DECLINED if $self->path =~/static|store/; # XXX
46 use Cache::SharedMemoryCache;
47 my %cache_options = ( 'namespace' => 'MemoriesStuff',
48 'default_expires_in' => 600 );
50 new Cache::SharedMemoryCache( \%cache_options ) or
51 croak( "Couldn't instantiate SharedMemoryCache" );
53 sub zap_cache { $cache->Clear }
54 use Storable qw(freeze); use MIME::Base64;
56 my ($self, $codeblock,$arg) = @_;
57 my $key = 0+$codeblock; if ($arg) { $key .=":".encode_base64(freeze(\$arg)); }
58 my $c = $cache->get(0+$codeblock); return @$c if $c;
59 my @stuff = $codeblock->($arg);
60 $cache->set(0+$codeblock, [ @stuff ]);
64 sub _recent_uploads { Memories::Photo->search_recent() }
66 sub recent_uploads { shift->do_cached(\&_recent_uploads) }
67 sub tagcloud { shift->do_cached(\&_tagcloud) }
70 my $cloud = HTML::TagCloud->new();
71 my $base = Memories->config->uri_base."tag/view/";
72 for my $tagging (Memories::Tagging->search_summary) {
73 my $name = $tagging->tag->name;
75 $base.uri_escape($name),
83 # shift->do_cached(\&_calendar, shift ) }
87 my ($y, $m) = split /-/, ($arg || Time::Piece->new->ymd);
88 my @m = Calendar::Simple::calendar($m, $y);
90 foreach my $week (@m) {
92 foreach my $day (@$week) {
93 my $d = { day => $day };
95 my $tag = "date:$y-$m-".sprintf("%02d", $day);
96 my ($x) = Memories::SystemTag->search(name => $tag);
97 if ($x) { $d->{tag} = "/system_tag/view/$tag" }
101 push(@month, \@weekdays);
109 sub Time::Piece::next_month {
111 my $month = $tp + ONE_MONTH;
112 return if $month > Time::Piece->new;
115 sub Time::Piece::prev_month {
117 my $month = $tp - ONE_MONTH;
123 my ($r, $tags, $photos) = @_;
124 # XXX only affects current page
126 for (map {$_->tags} @$photos) {
127 $counter{$_->name}++;
129 delete $counter{$_->name} for @$tags;
132 my $cloud = HTML::TagCloud->new();
133 my $base = $r->config->uri_base.$r->path."/";
135 for my $name (sort {$a cmp $b} keys %counter) {
136 if ($counter{$name} == @$photos) {
139 $cloud->add($name, $base.uri_escape($name), $counter{$name});
144 if (@super) { $res{super} = \@super }
145 if ($tags) { $res{cloud} = $cloud }