From: Simon Cozens <simon@simon-cozens.org>
Date: Tue, 6 Feb 2007 19:23:42 +0000 (+0000)
Subject: Don't want to forget that one.
X-Git-Tag: 1.2+svn20070808~65
X-Git-Url: https://git.decadent.org.uk/gitweb/?p=memories.git;a=commitdiff_plain;h=a8aa82f95702eaf4595205989f7333babc8fcd3c

Don't want to forget that one.


git-svn-id: http://svn.simon-cozens.org/memories/trunk@3 041978f6-d955-411f-a9d7-1d8545c9c3c7
---

diff --git a/Memories.pm b/Memories.pm
new file mode 100644
index 0000000..e399e76
--- /dev/null
+++ b/Memories.pm
@@ -0,0 +1,199 @@
+package Memories;
+use strict;
+our $VERSION = "1.2";
+use Maypole::Application qw(Upload Authentication::UserSessionCookie -Debug);
+use HTML::TagCloud;
+use URI;
+use Memories::Config;
+use Memories::DBI;
+use Memories::Photo;
+use Memories::Comment;
+use Memories::Tag;
+use Memories::SystemTag;
+use Memories::User;
+use Memories::Album;
+use URI::Escape;
+use Calendar::Simple;
+use XML::RSS;
+
+Memories->config->auth->{ user_field } = "name";
+Memories->config->model("Maypole::Model::CDBI::Plain");
+Memories->setup([qw/ Memories::Photo Memories::User Memories::Tag
+Memories::Album Memories::SystemTag/]);
+
+sub message {
+    my ($self, $message) = @_;
+    push @{$self->{template_args}{messages}}, $message;
+}
+
+sub check_credentials {
+    my $r = shift;
+    my ($uid, $user) = $r->SUPER::check_credentials;
+    #if (!$uid) { return (-1, undef) }
+    return ($uid, $user);
+}
+
+sub do_rss {
+    my $r = shift;
+    $r->model_class->process($r);
+    my $photos = $r->get_photos;
+    my $rss = XML::RSS->new(version => "2.0");
+    $rss->channel(
+        title => ($r->config->{application_name}. " : ".ucfirst($r->action)." ".ucfirst($r->table)." ".($r->objects||[])->[0]) ,
+        link  => $r->config->{uri_base}."/".$r->path
+    );
+    for my $item (@$photos) { 
+        my $link = $r->config->{uri_base}."photo/view/".$item->id;
+        $rss->add_item( title => $item->title, link => $link,
+            description => 
+    "<a href=\"$link\">
+    <img src=\"". $item->thumb_url."\" alt=\"".$item->title."\"></a>",
+            dc => { subject => join " ", $item->tags },
+            pubDate => $item->uploaded->strftime("%a, %d %b %Y %H:%M:%S %z")
+        )
+    }
+    $r->output($rss->as_string);
+    $r->content_type("application/rss+xml");
+    return
+}
+
+sub get_photos {
+    my $r = shift;
+    my $maybe_photos = $r->{objects}||[];
+    return (@$maybe_photos && $maybe_photos->[0]->isa("Memories::Photo")) 
+            ? $maybe_photos :
+            ($r->{template_args}->{photos} || []);
+}
+
+sub last_search {
+    my $r = shift;
+    my $photos = $r->get_photos; 
+    $r->{session}{last_search} = join ",", map { $_->id } @$photos 
+        if @$photos > 1;
+}
+
+sub additional_data { 
+    my $r = shift;
+    if ($r->params->{view_cal}) { 
+    $r->{template_args}{view_cal} = eval {
+            Time::Piece->strptime($r->{params}{view_cal}, "%Y-%m-%d") }; 
+    }
+    $r->{template_args}{now} = Time::Piece->new;
+    if ($r->session) {
+        (tied %{$r->session})->{lock_manager}->clean('/var/lib/memories/sessionlock', 3600) #remove files older than 1 hour
+    }
+    return $r->do_rss if ($r->params->{format} =~ /rss/)
+}
+
+use Maypole::Constants;
+sub authenticate {
+   my ($self, $r) = @_;
+   return DECLINED if $self->path =~/static|store/; # XXX
+   $r->get_user;
+   return OK; 
+}
+
+
+use Cache::SharedMemoryCache;
+my %cache_options = ( 'namespace' => 'MemoriesStuff',
+                   'default_expires_in' => 600 );
+my $cache =
+   new Cache::SharedMemoryCache( \%cache_options ) or
+     croak( "Couldn't instantiate SharedMemoryCache" );
+
+sub zap_cache { $cache->Clear }
+use Storable qw(freeze); use MIME::Base64;
+sub do_cached {
+    my ($self, $codeblock,$arg) = @_;
+    my $key = 0+$codeblock; if ($arg) { $key .=":".encode_base64(freeze(\$arg));  }
+    my $c = $cache->get(0+$codeblock); return @$c if $c;
+    my @stuff = $codeblock->($arg);
+    $cache->set(0+$codeblock, [ @stuff ]);
+    return @stuff;
+}
+
+sub _recent_uploads { Memories::Photo->search_recent() }
+
+sub recent_uploads { shift->do_cached(\&_recent_uploads) }
+sub tagcloud { shift->do_cached(\&_tagcloud) }
+
+sub _tagcloud {
+    my $cloud = HTML::TagCloud->new();
+    my $base = Memories->config->uri_base."tag/view/";
+    for my $tagging (Memories::Tagging->search_summary) {
+        my $name = $tagging->tag->name;
+        $cloud->add($name,
+            $base.uri_escape($name),
+            $tagging->{count}
+        )
+    }
+    $cloud
+}
+
+sub calendar {
+    # shift->do_cached(\&_calendar, shift ) }
+#sub _calendar {
+    my $self = shift;
+    my $arg = shift;
+    my ($y, $m) = split /-/, ($arg || Time::Piece->new->ymd);
+    my @m = Calendar::Simple::calendar($m, $y);
+    my @month;
+    foreach my $week (@m) {
+        my @weekdays;
+        foreach my $day (@$week) {
+                my $d = { day => $day };
+                if ($day) {
+                    my $tag = "date:$y-$m-".sprintf("%02d", $day);
+                    my ($x) = Memories::SystemTag->search(name => $tag);
+                    if ($x) { $d->{tag} = "/system_tag/view/$tag" }
+                }
+                push(@weekdays, $d);
+        }
+        push(@month, \@weekdays);
+    }
+    return \@month;
+}
+
+# THIS IS A HACK
+
+use Time::Seconds;
+sub Time::Piece::next_month {
+    my $tp = shift;
+    my $month = $tp + ONE_MONTH;
+    return if $month > Time::Piece->new;
+    return $month
+}
+sub Time::Piece::prev_month {
+    my $tp = shift;
+    my $month = $tp - ONE_MONTH;
+    return $month
+}
+
+
+sub tag_select {
+    my ($r, $tags) = @_;
+    my %counter;
+    my @photos = Memories::Photo->sth_to_objects(Memories::Tag->multi_search(@$tags));
+    for (map {$_->tags} @photos) { 
+        $counter{$_->name}++; 
+    } 
+    delete $counter{$_->name} for @$tags;
+    my @super;
+
+    my $cloud = HTML::TagCloud->new();
+    my $base = $r->config->uri_base.$r->path."/";
+    my $tags;
+    for my $name (sort {$a cmp $b} keys %counter) {
+        if ($counter{$name} == @photos) {
+            push @super, $name;
+        } else {
+            $cloud->add($name, $base.uri_escape($name), $counter{$name});
+            $tags++;
+        }
+    }
+    my %res;
+    if (@super) { $res{super} = \@super }
+    if ($tags) { $res{cloud} = $cloud }
+    \%res;
+}
+1;