Adapted FS's search_stories() to new semantics in stories_by_date().
[gruta.git] / Gruta.pm
blob6b2538f8c175be152d43fee485b0aa85c06cc5eb
1 package Gruta;
3 use strict;
4 use warnings;
6 use Gruta::Data;
8 $Gruta::VERSION = '2.0.0-rc3';
10 sub sources { return @{$_[0]->{sources}}; }
11 sub template { return $_[0]->{template}; }
12 sub cgi { return $_[0]->{cgi}; }
14 sub version { return $Gruta::VERSION; }
16 sub log {
17 my $self = shift;
18 my $msg = shift;
20 print STDERR $self->{id}, ' ', scalar(localtime), ': ', $msg, "\n";
24 sub _call {
25 my $self = shift;
26 my $method = shift;
27 my $short = shift;
29 my @r = ();
31 foreach my $s ($self->sources()) {
32 if (my $m = $s->can($method)) {
33 my @pr = $m->($s, @_);
35 if (@pr && $pr[0]) {
36 @r = (@r, @pr);
38 last if $short;
43 return wantarray ? @r : $r[0];
46 sub topic { my $self = shift; return $self->_call('topic', 1, @_); }
47 sub topics { my $self = shift; return $self->_call('topics', 0); }
49 sub user { my $self = shift; return $self->_call('user', 1, @_); }
50 sub users { my $self = shift; return $self->_call('users', 0); }
52 sub story {
53 my $self = shift;
54 my $topic_id = shift;
55 my $id = shift;
57 if (! $topic_id || ! $id) {
58 return undef;
61 my $story = undef;
62 my $ck = $topic_id . '/' . $id;
64 if ($story = $self->{story_cache}->{$ck}) {
65 return $story;
68 if (not $story = $self->_call('story', 1, $topic_id, $id)) {
69 return undef;
72 my $format = $story->get('format') || 'grutatxt';
74 if (my $rndr = $self->{renderers_h}->{$format}) {
75 $rndr->story($story);
78 return $self->{story_cache}->{$ck} = $story;
82 sub stories { my $self = shift; return $self->_call('stories', 0, @_); }
84 sub stories_by_date {
85 my $self = shift;
86 my $topics = shift;
87 my %opts = @_;
89 if (!$topics) {
90 $topics = [ $self->topics() ];
93 my @r = sort { $b->[2] cmp $a->[2] } $self->_call('stories_by_date', 0, $topics, %opts);
95 if (scalar(@r) > $opts{num}) {
96 @r = @r[0 .. $opts{num} - 1];
99 return @r;
102 sub search_stories {
103 my $self = shift;
104 my $topic_id = shift;
106 my @l = $self->_call('search_stories', 1, $topic_id, @_);
108 return sort { $self->story($topic_id, $a)->get('title') cmp
109 $self->story($topic_id, $b)->get('title') } @l;
112 sub stories_top_ten {
113 my $self = shift;
115 my @l = $self->_call('stories_top_ten', 0, @_);
117 return sort { $b->[0] <=> $a->[0] } @l;
120 sub search_stories_by_tag {
121 my $self = shift;
123 my @l = $self->_call('search_stories_by_tag', 0, @_);
125 return sort { $self->story($a->[0], $a->[1])->get('title') cmp
126 $self->story($b->[0], $b->[1])->get('title') } @l;
129 sub tags {
130 my $self = shift;
132 my @l = $self->_call('tags', 0, @_);
134 return sort { $a->[0] cmp $b->[0] } @l;
137 sub insert_topic { my $self = shift; return $self->_call('insert_topic', 1, @_); }
138 sub insert_user { my $self = shift; return $self->_call('insert_user', 1, @_); }
139 sub insert_story { my $self = shift; return $self->_call('insert_story', 1, @_); }
142 sub auth {
143 my $self = shift;
145 if (@_) { $self->{auth} = shift; } # Gruta::Data::User
147 return $self->{auth};
151 sub auth_from_sid {
152 my $self = shift;
153 my $sid = shift;
155 my $u = undef;
157 if ($sid) {
158 $self->_call('purge_old_sessions', 0);
160 if (my $session = $self->_call('session', 1, $sid)) {
161 $u = $session->source->user( $session->get('user_id') );
162 $u->set('sid', $sid);
163 $self->auth($u);
167 return $u;
171 sub login {
172 my $self = shift;
173 my $user_id = shift;
174 my $passwd = shift;
176 my $sid = undef;
178 if (my $u = $self->user( $user_id )) {
180 # account expired? go!
181 if (my $xdate = $u->get('xdate')) {
182 if (Gruta::Data::today() > $xdate) {
183 return undef;
187 my $p = $u->get('password');
189 if (crypt($passwd, $p) eq $p) {
190 # create new sid
191 $sid = time() . $$;
193 my $session = Gruta::Data::Session->new(
194 id => $sid,
195 time => time(),
196 user_id => $user_id
199 $u->source->insert_session( $session );
201 $u->set('sid', $sid);
202 $self->auth($u);
206 return $sid;
210 sub logout {
211 my $self = shift;
213 if (my $auth = $self->auth()) {
214 if( my $sid = $auth->get('sid')) {
215 if (my $session = $auth->source->session( $sid )) {
216 $session->delete() if $session->can('delete');
221 $self->auth( undef );
222 return $self;
226 sub _link_to_topic {
227 my $self = shift;
228 my $topic_id = shift;
230 my $ret = undef;
232 if (my $t = $self->topic($topic_id)) {
233 $ret = "<a href='?t=TOPIC;topic=$topic_id'>" .
234 $t->get('name') . '</a>';
236 else {
237 $ret = "Bad topic $topic_id";
240 return $ret;
244 sub _link_to_story {
245 my $self = shift;
246 my $topic_id = shift;
247 my $story_id = shift;
249 my $ret = undef;
251 if (my $s = $self->story($topic_id, $story_id)) {
252 $ret = "<a href='?t=STORY;topic=$topic_id;id=$story_id'>" .
253 $s->get('title') . '</a>';
255 else {
256 $ret = "Bad story '$topic_id/$story_id'";
259 return $ret;
263 sub special_uris {
264 my $self = shift;
265 my $string = shift;
267 $string =~ s!topic://([\w\d_]+)!$self->_link_to_topic($1)!ge;
268 $string =~ s!story://([\w\d_]+)/([\w\d_]+)!$self->_link_to_story($1,$2)!ge;
270 return $string;
274 sub transfer_to_source {
275 my $self = shift;
276 my $dst = shift;
278 foreach my $id ($self->users()) {
279 my $u = $self->user($id);
280 $dst->insert_user($u);
283 foreach my $topic_id (sort $self->topics()) {
284 my $t = $self->topic($topic_id);
286 my $nti = $topic_id;
288 # is it an archive?
289 if ($nti =~ /-arch$/) {
290 # don't insert topic, just rename
291 $nti =~ s/-arch$//;
293 else {
294 $dst->insert_topic($t);
297 foreach my $id ($self->stories($topic_id)) {
299 # get story and its tags
300 my $s = $self->story($topic_id, $id);
301 my @tags = $s->tags();
303 # set new topic
304 $s->set('topic_id', $nti);
306 my $ns = $dst->insert_story($s);
308 if (@tags) {
309 $ns->tags(@tags);
314 return $self;
318 sub flush_story_cache {
319 my $self = shift;
321 $self->{story_cache} = {};
325 sub new {
326 my $class = shift;
328 my $g = bless( { @_ } , $class);
330 $g->{id} ||= 'Gruta';
331 $g->{story_cache} = {};
332 $g->{renderers_h} = {};
334 if (ref($g->{sources}) ne 'ARRAY') {
335 $g->{sources} = [ $g->{sources} ];
338 if ($g->{renderers}) {
339 if (ref($g->{renderers}) ne 'ARRAY') {
340 $g->{renderers} = [ $g->{renderers} ];
343 foreach my $r (@{$g->{renderers}}) {
344 $g->{renderers_h}->{$r->{renderer_id}} = $r;
348 if ($g->{template}) {
349 $g->template->data($g);
352 if ($g->{cgi}) {
353 $g->cgi->data($g);
356 my @u;
358 if (not @u = $g->users()) {
359 my $u = Gruta::Data::User->new(
360 id => 'admin',
361 is_admin => 1,
362 can_upload => 1,
363 username => 'Admin',
364 email => 'webmaster@localhost'
367 $u->password('admin');
368 $g->insert_user($u);
371 return $g;
374 sub run {
375 my $self = shift;
377 if ($self->{cgi}) {
378 $self->cgi->run();