]> git.decadent.org.uk Git - memories.git/blob - Memories.pm
Add dh_installdeb so the maintainer scripts are actually included.
[memories.git] / Memories.pm
1 package Memories;
2 use strict;
3 our $VERSION = "1.2";
4 use Maypole::Application qw(Upload Authentication::UserSessionCookie);
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 do_rss {
30     my $r = shift;
31     $r->model_class->process($r);
32     my $rss = XML::RSS->new(version => "2.0");
33     $rss->channel(
34         title => ($r->config->{application_name}. " : ".ucfirst($r->action)." ".ucfirst($r->table)." ".($r->objects||[])->[0]) ,
35         link  => $r->config->{uri_base}."/".$r->path
36     );
37     my $maybe_photos = $r->{objects}||[];
38     my $photos = 
39         (@$maybe_photos && $maybe_photos->[0]->isa("Memories::Photo")) 
40             ? $maybe_photos :
41             ($r->{template_args}->{photos} || []);
42     for my $item (@$photos) { 
43         my $link = $r->config->{uri_base}."photo/view/".$item->id;
44         $rss->add_item( title => $item->title, link => $link,
45             description => 
46     "<a href=\"$link\">
47     <img src=\"". $item->thumb_url."\" alt=\"".$item->title."\"></a>",
48             dc => { subject => join " ", $item->tags },
49             pubDate => $item->uploaded->strftime("%a, %d %b %Y %H:%M:%S %z")
50         )
51     }
52     $r->output($rss->as_string);
53     $r->content_type("application/rss+xml");
54     return
55 }
56
57 sub additional_data { 
58     my $r = shift;
59     if ($r->params->{view_cal}) { 
60     $r->{template_args}{view_cal} = eval {
61             Time::Piece->strptime($r->{params}{view_cal}, "%Y-%m-%d") }; 
62     }
63     $r->{template_args}{now} = Time::Piece->new;
64     return $r->do_rss if ($r->params->{format} =~ /rss/)        
65 }
66
67 use Maypole::Constants;
68 sub authenticate {
69    my ($self, $r) = @_;
70    return DECLINED if $self->path =~/static|store/; # XXX
71    $r->get_user;
72    return OK; 
73 }
74
75
76 use Cache::SharedMemoryCache;
77 my %cache_options = ( 'namespace' => 'MemoriesStuff',
78                    'default_expires_in' => 600 );
79 my $cache =
80    new Cache::SharedMemoryCache( \%cache_options ) or
81      croak( "Couldn't instantiate SharedMemoryCache" );
82
83 sub zap_cache { $cache->Clear }
84 use Storable qw(freeze); use MIME::Base64;
85 sub do_cached {
86     my ($self, $codeblock,$arg) = @_;
87     my $key = 0+$codeblock; if ($arg) { $key .=":".encode_base64(freeze(\$arg));  }
88     my $c = $cache->get(0+$codeblock); return @$c if $c;
89     my @stuff = $codeblock->($arg);
90     $cache->set(0+$codeblock, [ @stuff ]);
91     return @stuff;
92 }
93
94 sub _recent_uploads { Memories::Photo->search_recent() }
95
96 sub recent_uploads { shift->do_cached(\&_recent_uploads) }
97 sub tagcloud { shift->do_cached(\&_tagcloud) }
98
99 sub _tagcloud {
100     my $cloud = HTML::TagCloud->new();
101     my $base = Memories->config->uri_base."tag/view/";
102     for my $tagging (Memories::Tagging->search_summary) {
103         my $name = $tagging->tag->name;
104         $cloud->add($name,
105             $base.uri_escape($name),
106             $tagging->{count}
107         )
108     }
109     $cloud
110 }
111
112 sub calendar {
113     # shift->do_cached(\&_calendar, shift ) }
114 #sub _calendar {
115     my $self = shift;
116     my $arg = shift;
117     my ($y, $m) = split /-/, ($arg || Time::Piece->new->ymd);
118     my @m = Calendar::Simple::calendar($m, $y);
119     my @month;
120     foreach my $week (@m) {
121         my @weekdays;
122         foreach my $day (@$week) {
123                 my $d = { day => $day };
124                 if ($day) {
125                     my $tag = "date:$y-$m-".sprintf("%02d", $day);
126                     my ($x) = Memories::SystemTag->search(name => $tag);
127                     if ($x) { $d->{tag} = "/system_tag/view/$tag" }
128                 }
129                 push(@weekdays, $d);
130         }
131         push(@month, \@weekdays);
132     }
133     return \@month;
134 }
135
136 # THIS IS A HACK
137
138 use Time::Seconds;
139 sub Time::Piece::next_month {
140     my $tp = shift;
141     my $month = $tp + ONE_MONTH;
142     return if $month > Time::Piece->new;
143     return $month
144 }
145 sub Time::Piece::prev_month {
146     my $tp = shift;
147     my $month = $tp - ONE_MONTH;
148     return $month
149 }
150
151
152 sub tag_select {
153     my ($r, $tags) = @_;
154     my %counter;
155     my @photos = Memories::Photo->sth_to_objects(Memories::Tag->multi_search(@$tags));
156     for (map {$_->tags} @photos) { 
157         $counter{$_->name}++; 
158     } 
159     delete $counter{$_->name} for @$tags;
160     my @super;
161
162     my $cloud = HTML::TagCloud->new();
163     my $base = $r->config->uri_base.$r->path."/";
164     my $tags;
165     for my $name (sort {$a cmp $b} keys %counter) {
166         if ($counter{$name} == @photos) {
167             push @super, $name;
168         } else {
169             $cloud->add($name, $base.uri_escape($name), $counter{$name});
170             $tags++;
171         }
172     }
173     my %res;
174     if (@super) { $res{super} = \@super }
175     if ($tags) { $res{cloud} = $cloud }
176     \%res;
177 }
178 1;