Gruta stories_by_date() no longer sets 'today'.
[gruta.git] / Gruta.pm
blobf04acddf1986f5d68e3e4721ad65098217a297ac
1 package Gruta;
3 use strict;
4 use warnings;
6 use Gruta::Data;
8 $Gruta::VERSION = '2.0-pre2';
10 sub sources { return @{$_[0]->{sources}}; }
11 sub template { return $_[0]->{template}; }
12 sub cgi { return $_[0]->{cgi}; }
14 sub log {
15 my $self = shift;
16 my $msg = shift;
18 print STDERR $self->{id}, ' ', scalar(localtime), ': ', $msg, "\n";
22 sub _call {
23 my $self = shift;
24 my $method = shift;
25 my $short = shift;
27 my @r = ();
29 foreach my $s ($self->sources()) {
30 if (my $m = $s->can($method)) {
31 my @pr = $m->($s, @_);
33 if (@pr && $pr[0]) {
34 @r = (@r, @pr);
36 last if $short;
41 return wantarray ? @r : $r[0];
44 sub topic { my $self = shift; return $self->_call('topic', 1, @_); }
45 sub topics { my $self = shift; return $self->_call('topics', 0); }
47 sub user { my $self = shift; return $self->_call('user', 1, @_); }
48 sub users { my $self = shift; return $self->_call('users', 0); }
50 sub story {
51 my $self = shift;
52 my $topic_id = shift;
53 my $id = shift;
55 if (! $topic_id || ! $id) {
56 return undef;
59 my $story = undef;
60 my $ck = $topic_id . '/' . $id;
62 if ($story = $self->{story_cache}->{$ck}) {
63 return $story;
66 if (not $story = $self->_call('story', 1, $topic_id, $id)) {
67 return undef;
70 my $format = $story->get('format') || 'grutatxt';
72 if (my $rndr = $self->{renderers_h}->{$format}) {
73 $rndr->story($story);
76 return $self->{story_cache}->{$ck} = $story;
80 sub stories { my $self = shift; return $self->_call('stories', 0, @_); }
81 sub stories_by_date { my $self = shift; return $self->_call('stories_by_date', 1, @_); }
82 sub search_stories { my $self = shift; return $self->_call('search_stories', 1, @_); }
84 sub stories_top_ten {
85 my $self = shift;
87 my @l = $self->_call('stories_top_ten', 0, @_);
89 return sort { $b->[0] cmp $a->[0] } @l;
92 sub search_stories_by_tag { my $self = shift; return $self->_call('search_stories_by_tag', 0, @_); }
94 sub tags {
95 my $self = shift;
97 my @l = $self->_call('tags', 0, @_);
99 return sort { $b->[1] <=> $a->[1] } @l;
102 sub insert_topic { my $self = shift; return $self->_call('insert_topic', 1, @_); }
103 sub insert_user { my $self = shift; return $self->_call('insert_user', 1, @_); }
104 sub insert_story { my $self = shift; return $self->_call('insert_story', 1, @_); }
107 sub auth {
108 my $self = shift;
110 if (@_) { $self->{auth} = shift; } # Gruta::Data::User
112 return $self->{auth};
116 sub auth_from_sid {
117 my $self = shift;
118 my $sid = shift;
120 my $u = undef;
122 if ($sid) {
123 $self->_call('purge_old_sessions', 0);
125 if (my $session = $self->_call('session', 1, $sid)) {
126 $u = $session->source->user( $session->get('user_id') );
127 $u->set('sid', $sid);
128 $self->auth($u);
132 return $u;
136 sub login {
137 my $self = shift;
138 my $user_id = shift;
139 my $passwd = shift;
141 my $sid = undef;
143 if (my $u = $self->user( $user_id )) {
145 # account expired? go!
146 if (my $xdate = $u->get('xdate')) {
147 if (Gruta::Data::today() > $xdate) {
148 return undef;
152 my $p = $u->get('password');
154 if (crypt($passwd, $p) eq $p) {
155 # create new sid
156 $sid = time() . $$;
158 my $session = Gruta::Data::Session->new(
159 id => $sid,
160 time => time(),
161 user_id => $user_id
164 $u->source->insert_session( $session );
166 $u->set('sid', $sid);
167 $self->auth($u);
171 return $sid;
175 sub logout {
176 my $self = shift;
178 if (my $auth = $self->auth()) {
179 if( my $sid = $auth->get('sid')) {
180 if (my $session = $auth->source->session( $sid )) {
181 $session->delete() if $session->can('delete');
186 $self->auth( undef );
187 return $self;
191 sub _link_to_topic {
192 my $self = shift;
193 my $topic_id = shift;
195 my $ret = undef;
197 if (my $t = $self->topic($topic_id)) {
198 $ret = "<a href='?t=TOPIC;topic=$topic_id'>" .
199 $t->get('name') . '</a>';
201 else {
202 $ret = "Bad topic $topic_id";
205 return $ret;
209 sub _link_to_story {
210 my $self = shift;
211 my $topic_id = shift;
212 my $story_id = shift;
214 my $ret = undef;
216 if (my $s = $self->story($topic_id, $story_id)) {
217 $ret = "<a href='?t=STORY;topic=$topic_id;id=$story_id'>" .
218 $s->get('title') . '</a>';
220 else {
221 $ret = "Bad story '$topic_id/$story_id'";
224 return $ret;
228 sub special_uris {
229 my $self = shift;
230 my $string = shift;
232 $string =~ s!topic://([\w\d_]+)!$self->_link_to_topic($1)!ge;
233 $string =~ s!story://([\w\d_]+)/([\w\d_]+)!$self->_link_to_story($1,$2)!ge;
235 return $string;
239 sub transfer_to_source {
240 my $self = shift;
241 my $dst = shift;
243 foreach my $id ($self->users()) {
244 my $u = $self->user($id);
245 $dst->insert_user($u);
248 foreach my $topic_id (sort $self->topics()) {
249 my $t = $self->topic($topic_id);
251 my $nti = $topic_id;
253 # is it an archive?
254 if ($nti =~ /-arch$/) {
255 # don't insert topic, just rename
256 $nti =~ s/-arch$//;
258 else {
259 $dst->insert_topic($t);
262 foreach my $id ($self->stories($topic_id)) {
264 # get story and its tags
265 my $s = $self->story($topic_id, $id);
266 my @tags = $s->tags();
268 # set new topic
269 $s->set('topic_id', $nti);
271 my $ns = $dst->insert_story($s);
273 if (@tags) {
274 $ns->tags(@tags);
279 return $self;
283 sub flush_story_cache {
284 my $self = shift;
286 $self->{story_cache} = {};
290 sub new {
291 my $class = shift;
293 my $g = bless( { @_ } , $class);
295 $g->{id} ||= 'Gruta';
296 $g->{story_cache} = {};
297 $g->{renderers_h} = {};
299 if (ref($g->{sources}) ne 'ARRAY') {
300 $g->{sources} = [ $g->{sources} ];
303 if ($g->{renderers}) {
304 if (ref($g->{renderers}) ne 'ARRAY') {
305 $g->{renderers} = [ $g->{renderers} ];
308 foreach my $r (@{$g->{renderers}}) {
309 $g->{renderers_h}->{$r->{renderer_id}} = $r;
313 $g->template->data($g) if $g->{template};
314 $g->cgi->data($g) if $g->{cgi};
316 return $g;
319 sub run {
320 my $self = shift;
322 if ($self->{cgi}) {
323 $self->cgi->run();