DBI stories_by_date() now use Gruta::Data::today().
[gruta.git] / Gruta.pm
bloba65278d0fd177b9d696699b6c526eb8e47f24036
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;
82 return $self->_call('stories_by_date', 1, @_, 'today' => Gruta::Data::today()); }
83 sub search_stories { my $self = shift; return $self->_call('search_stories', 1, @_); }
85 sub stories_top_ten {
86 my $self = shift;
88 my @l = $self->_call('stories_top_ten', 0, @_);
90 return sort { $b->[0] cmp $a->[0] } @l;
93 sub search_stories_by_tag { my $self = shift; return $self->_call('search_stories_by_tag', 0, @_); }
95 sub tags {
96 my $self = shift;
98 my @l = $self->_call('tags', 0, @_);
100 return sort { $b->[1] <=> $a->[1] } @l;
103 sub insert_topic { my $self = shift; return $self->_call('insert_topic', 1, @_); }
104 sub insert_user { my $self = shift; return $self->_call('insert_user', 1, @_); }
105 sub insert_story { my $self = shift; return $self->_call('insert_story', 1, @_); }
108 sub auth {
109 my $self = shift;
111 if (@_) { $self->{auth} = shift; } # Gruta::Data::User
113 return $self->{auth};
117 sub auth_from_sid {
118 my $self = shift;
119 my $sid = shift;
121 my $u = undef;
123 if ($sid) {
124 $self->_call('purge_old_sessions', 0);
126 if (my $session = $self->_call('session', 1, $sid)) {
127 $u = $session->source->user( $session->get('user_id') );
128 $u->set('sid', $sid);
129 $self->auth($u);
133 return $u;
137 sub login {
138 my $self = shift;
139 my $user_id = shift;
140 my $passwd = shift;
142 my $sid = undef;
144 if (my $u = $self->user( $user_id )) {
146 # account expired? go!
147 if (my $xdate = $u->get('xdate')) {
148 if (Gruta::Data::today() > $xdate) {
149 return undef;
153 my $p = $u->get('password');
155 if (crypt($passwd, $p) eq $p) {
156 # create new sid
157 $sid = time() . $$;
159 my $session = Gruta::Data::Session->new(
160 id => $sid,
161 time => time(),
162 user_id => $user_id
165 $u->source->insert_session( $session );
167 $u->set('sid', $sid);
168 $self->auth($u);
172 return $sid;
176 sub logout {
177 my $self = shift;
179 if (my $auth = $self->auth()) {
180 if( my $sid = $auth->get('sid')) {
181 if (my $session = $auth->source->session( $sid )) {
182 $session->delete() if $session->can('delete');
187 $self->auth( undef );
188 return $self;
192 sub _link_to_topic {
193 my $self = shift;
194 my $topic_id = shift;
196 my $ret = undef;
198 if (my $t = $self->topic($topic_id)) {
199 $ret = "<a href='?t=TOPIC;topic=$topic_id'>" .
200 $t->get('name') . '</a>';
202 else {
203 $ret = "Bad topic $topic_id";
206 return $ret;
210 sub _link_to_story {
211 my $self = shift;
212 my $topic_id = shift;
213 my $story_id = shift;
215 my $ret = undef;
217 if (my $s = $self->story($topic_id, $story_id)) {
218 $ret = "<a href='?t=STORY;topic=$topic_id;id=$story_id'>" .
219 $s->get('title') . '</a>';
221 else {
222 $ret = "Bad story '$topic_id/$story_id'";
225 return $ret;
229 sub special_uris {
230 my $self = shift;
231 my $string = shift;
233 $string =~ s!topic://([\w\d_]+)!$self->_link_to_topic($1)!ge;
234 $string =~ s!story://([\w\d_]+)/([\w\d_]+)!$self->_link_to_story($1,$2)!ge;
236 return $string;
240 sub transfer_to_source {
241 my $self = shift;
242 my $dst = shift;
244 foreach my $id ($self->users()) {
245 my $u = $self->user($id);
246 $dst->insert_user($u);
249 foreach my $topic_id (sort $self->topics()) {
250 my $t = $self->topic($topic_id);
252 my $nti = $topic_id;
254 # is it an archive?
255 if ($nti =~ /-arch$/) {
256 # don't insert topic, just rename
257 $nti =~ s/-arch$//;
259 else {
260 $dst->insert_topic($t);
263 foreach my $id ($self->stories($topic_id)) {
265 # get story and its tags
266 my $s = $self->story($topic_id, $id);
267 my @tags = $s->tags();
269 # set new topic
270 $s->set('topic_id', $nti);
272 my $ns = $dst->insert_story($s);
274 if (@tags) {
275 $ns->tags(@tags);
280 return $self;
284 sub flush_story_cache {
285 my $self = shift;
287 $self->{story_cache} = {};
291 sub new {
292 my $class = shift;
294 my $g = bless( { @_ } , $class);
296 $g->{id} ||= 'Gruta';
297 $g->{story_cache} = {};
298 $g->{renderers_h} = {};
300 if (ref($g->{sources}) ne 'ARRAY') {
301 $g->{sources} = [ $g->{sources} ];
304 if ($g->{renderers}) {
305 if (ref($g->{renderers}) ne 'ARRAY') {
306 $g->{renderers} = [ $g->{renderers} ];
309 foreach my $r (@{$g->{renderers}}) {
310 $g->{renderers_h}->{$r->{renderer_id}} = $r;
314 $g->template->data($g) if $g->{template};
315 $g->cgi->data($g) if $g->{cgi};
317 return $g;
320 sub run {
321 my $self = shift;
323 if ($self->{cgi}) {
324 $self->cgi->run();