Memories.pm

   1 package Memories;
   2 use strict;
   3 our $VERSION = "1.2";
   4 use Maypole::Application qw(Upload Authentication::UserSessionCookie -Debug);
   5 use HTML::TagCloud;
   6 use URI;
   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 use XML::RSS;
  18
  19 Memories->config->auth->{ user_field } = "name";
  20 Memories->config->model("Maypole::Model::CDBI::Plain");
  21 Memories->setup([qw/ Memories::Photo Memories::User Memories::Tag
  22 Memories::Album Memories::SystemTag/]);
  23
  24 sub message {
  25     my ($self, $message) = @_;
  26     push @{$self->{template_args}{messages}}, $message;
  27 }
  28
  29 sub check_credentials {
  30     my $r = shift;
  31     my ($uid, $user) = $r->SUPER::check_credentials;
  32     #if (!$uid) { return (-1, undef) }
  33     return ($uid, $user);
  34 }
  35
  36 sub do_rss {
  37     my $r = shift;
  38     $r->model_class->process($r);
  39     my $photos = $r->get_photos;
  40     my $rss = XML::RSS->new(version => "2.0");
  41     $rss->channel(
  42         title => ($r->config->{application_name}. " : ".ucfirst($r->action)." ".ucfirst($r->table)." ".($r->objects||[])->[0]) ,
  43         link  => $r->config->{uri_base}."/".$r->path
  44     );
  45     for my $item (@$photos) {
  46         my $link = $r->config->{uri_base}."photo/view/".$item->id;
  47         $rss->add_item( title => $item->title, link => $link,
  48             description =>
  49     "<a href=\"$link\">
  50     <img src=\"". $item->thumb_url."\" alt=\"".$item->title."\"></a>",
  51             dc => { subject => join " ", $item->tags },
  52             pubDate => $item->uploaded->strftime("%a, %d %b %Y %H:%M:%S %z")
  53         )
  54     }
  55     $r->output($rss->as_string);
  56     $r->content_type("application/rss+xml");
  57     return
  58 }
  59
  60 sub get_photos {
  61     my $r = shift;
  62     my $maybe_photos = $r->{objects}||[];
  63     return (@$maybe_photos && $maybe_photos->[0]->isa("Memories::Photo"))
  64             ? $maybe_photos :
  65             ($r->{template_args}->{photos} || []);
  66 }
  67
  68 sub last_search {
  69     my $r = shift;
  70     my $photos = $r->get_photos;
  71     $r->{session}{last_search} = join ",", map { $_->id } @$photos
  72         if @$photos > 1;
  73 }
  74
  75 sub additional_data {
  76     my $r = shift;
  77     if ($r->params->{view_cal}) {
  78     $r->{template_args}{view_cal} = eval {
  79             Time::Piece->strptime($r->{params}{view_cal}, "%Y-%m-%d") };
  80     }
  81     $r->{template_args}{now} = Time::Piece->new;
  82     if ($r->session) {
  83         (tied %{$r->session})->{lock_manager}->clean('/var/lib/memories/sessionlock', 3600) #remove files older than 1 hour
  84     }
  85     return $r->do_rss if ($r->params->{format} =~ /rss/)
  86 }
  87
  88 use Maypole::Constants;
  89 sub authenticate {
  90    my ($self, $r) = @_;
  91    return DECLINED if $self->path =~/static|store/; # XXX
  92    $r->get_user;
  93    return OK;
  94 }
  95
  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
 115 for my $how (qw(random recent interesting popular)) {
 116     no strict;
 117     my $method = "search_$how";
 118     *{"_$how"} = sub { Memories::Photo->$method };
 119     *{$how} = sub { shift->do_cached(\&{"_$how"})};
 120 }
 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
 176
 177 sub tag_select {
 178     my ($r, $tags) = @_;
 179     my %counter;
 180     my @photos = Memories::Photo->sth_to_objects(Memories::Tag->multi_search(@$tags));
 181     for (map {$_->tags} @photos) {
 182         $counter{$_->name}++;
 183     }
 184     delete $counter{$_->name} for @$tags;
 185     my @super;
 186
 187     my $cloud = HTML::TagCloud->new();
 188     my $base = $r->config->uri_base.$r->path."/";
 189     my $tags;
 190     for my $name (sort {$a cmp $b} keys %counter) {
 191         if ($counter{$name} == @photos) {
 192             push @super, $name;
 193         } else {
 194             $cloud->add($name, $base.uri_escape($name), $counter{$name});
 195             $tags++;
 196         }
 197     }
 198     my %res;
 199     if (@super) { $res{super} = \@super }
 200     if ($tags) { $res{cloud} = $cloud }
 201     \%res;
 202 }
 203 1;