Memories.pm

   1 package Memories;
   2 use strict;
   3 use HTML::TagCloud;
   4 use URI;
   5 use Maypole::Application qw(Upload Authentication::UserSessionCookie
   6 -Debug);
   7 use Memories::Config;
   8 use Memories::DBI;
   9 use Memories::Photo;
  10 use Memories::Comment;
  11 use Memories::Tag;
  12 use Memories::SystemTag;
  13 use Memories::User;
  14 use Memories::Album;
  15 use URI::Escape;
  16 use Calendar::Simple;
  17
  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/]);
  22
  23 sub message {
  24     my ($self, $message) = @_;
  25     push @{$self->{template_args}{messages}}, $message;
  26 }
  27
  28 sub additional_data {
  29     my $r = shift;
  30     if ($r->params->{view_cal}) {
  31         $r->{template_args}{view_cal} = eval {
  32             Time::Piece->strptime($r->{params}{view_cal}, "%Y-%m-%d") };
  33     }
  34     $r->{template_args}{now} = Time::Piece->new;
  35 }
  36
  37 use Maypole::Constants;
  38 sub authenticate {
  39    my ($self, $r) = @_;
  40    return DECLINED if $self->path =~/static|store/; # XXX
  41    $r->get_user;
  42    return OK;
  43 }
  44
  45
  46 use Cache::SharedMemoryCache;
  47 my %cache_options = ( 'namespace' => 'MemoriesStuff',
  48                    'default_expires_in' => 600 );
  49 my $cache =
  50    new Cache::SharedMemoryCache( \%cache_options ) or
  51      croak( "Couldn't instantiate SharedMemoryCache" );
  52
  53 sub zap_cache { $cache->Clear }
  54 use Storable qw(freeze); use MIME::Base64;
  55 sub do_cached {
  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 ]);
  61     return @stuff;
  62 }
  63
  64 sub _recent_uploads { Memories::Photo->search_recent() }
  65
  66 sub recent_uploads { shift->do_cached(\&_recent_uploads) }
  67 sub tagcloud { shift->do_cached(\&_tagcloud) }
  68
  69 sub _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;
  74         $cloud->add($name,
  75             $base.uri_escape($name),
  76             $tagging->{count}
  77         )
  78     }
  79     $cloud
  80 }
  81
  82 sub calendar {
  83     # shift->do_cached(\&_calendar, shift ) }
  84 #sub _calendar {
  85     my $self = shift;
  86     my $arg = shift;
  87     my ($y, $m) = split /-/, ($arg || Time::Piece->new->ymd);
  88     my @m = Calendar::Simple::calendar($m, $y);
  89     my @month;
  90     foreach my $week (@m) {
  91         my @weekdays;
  92         foreach my $day (@$week) {
  93                 my $d = { day => $day };
  94                 if ($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" }
  98                 }
  99                 push(@weekdays, $d);
 100         }
 101         push(@month, \@weekdays);
 102     }
 103     return \@month;
 104 }
 105
 106 # THIS IS A HACK
 107
 108 use Time::Seconds;
 109 sub Time::Piece::next_month {
 110     my $tp = shift;
 111     my $month = $tp + ONE_MONTH;
 112     return if $month > Time::Piece->new;
 113     return $month
 114 }
 115 sub Time::Piece::prev_month {
 116     my $tp = shift;
 117     my $month = $tp - ONE_MONTH;
 118     return $month
 119 }
 120
 121
 122 sub tag_select {
 123     my ($r, $tags, $photos) = @_;
 124     # XXX only affects current page
 125     my %counter;
 126     for (map {$_->tags} @$photos) {
 127         $counter{$_->name}++;
 128     }
 129     delete $counter{$_->name} for @$tags;
 130     my @super;
 131
 132     my $cloud = HTML::TagCloud->new();
 133     my $base = $r->config->uri_base.$r->path."/";
 134     my $tags;
 135     for my $name (sort {$a cmp $b} keys %counter) {
 136         if ($counter{$name} == @$photos) {
 137             push @super, $name;
 138         } else {
 139             $cloud->add($name, $base.uri_escape($name), $counter{$name});
 140             $tags++;
 141         }
 142     }
 143     my %res;
 144     if (@super) { $res{super} = \@super }
 145     if ($tags) { $res{cloud} = $cloud }
 146     \%res;
 147 }
 148 1;