Fixed the loop_stories_top_ten Artemus function to use the correct arguments.
[gruta.git] / Gruta.pm
blob70648264cf3c14f8bc7de1a7576296b515c68ec8
1 package Gruta;
3 use strict;
4 use warnings;
6 $Gruta::VERSION = '2.0-pre2';
8 sub sources { return @{$_[0]->{sources}}; }
9 sub template { return $_[0]->{template}; }
10 sub cgi { return $_[0]->{cgi}; }
12 sub today {
13 my $self = shift;
15 if (not $self->{_today}) {
16 my ($S,$M,$H,$d,$m,$y) = (localtime)[0..5];
17 $self->{_today} =
18 sprintf("%04d%02d%02d%02d%02d%02d",
19 1900 + $y, $m + 1, $d, $H, $M, $S);
22 return $self->{_today};
25 sub log {
26 my $self = shift;
27 my $msg = shift;
29 print STDERR $self->{id}, ' ', scalar(localtime), ': ', $msg, "\n";
33 sub _call {
34 my $self = shift;
35 my $method = shift;
36 my $short = shift;
38 my @r = ();
40 foreach my $s ($self->sources()) {
41 if (my $m = $s->can($method)) {
42 my @pr = $m->($s, @_);
44 if (@pr && $pr[0]) {
45 @r = (@r, @pr);
47 last if $short;
52 return wantarray ? @r : $r[0];
55 sub topic { my $self = shift; return $self->_call('topic', 1, @_); }
56 sub topics { my $self = shift; return $self->_call('topics', 0); }
58 sub user { my $self = shift; return $self->_call('user', 1, @_); }
59 sub users { my $self = shift; return $self->_call('users', 0); }
61 sub story {
62 my $self = shift;
63 my $topic_id = shift;
64 my $id = shift;
66 my $story = undef;
67 my $ck = $topic_id . '/' . $id;
69 if ($story = $self->{story_cache}->{$ck}) {
70 return $story;
73 if (not $story = $self->_call('story', 1, $topic_id, $id)) {
74 return undef;
77 if (my $rndr = $self->{renderers_h}->{$story->get('format')}) {
78 $rndr->story($story);
81 return $self->{story_cache}->{$ck} = $story;
85 sub stories { my $self = shift; return $self->_call('stories', 0, @_); }
86 sub stories_by_date { my $self = shift;
87 return $self->_call('stories_by_date', 1, @_, 'today' => $self->today()); }
88 sub search_stories { my $self = shift; return $self->_call('search_stories', 1, @_); }
89 sub stories_top_ten { my $self = shift; return $self->_call('stories_top_ten', 0, @_); }
91 sub insert_topic { my $self = shift; $self->_call('insert_topic', 1, @_); return $self; }
92 sub insert_user { my $self = shift; $self->_call('insert_user', 1, @_); return $self; }
93 sub insert_story { my $self = shift; $self->_call('insert_story', 1, @_); return $self; }
96 sub auth {
97 my $self = shift;
99 if (@_) { $self->{auth} = shift; } # Gruta::Data::User
101 return $self->{auth};
105 sub auth_from_sid {
106 my $self = shift;
107 my $sid = shift;
109 my $u = undef;
111 if ($sid) {
112 $self->_call('purge_old_sessions', 0);
114 if (my $session = $self->_call('session', 1, $sid)) {
115 $u = $session->source->user( $session->get('user_id') );
116 $u->set('sid', $sid);
117 $self->auth($u);
121 return $u;
125 sub login {
126 my $self = shift;
127 my $user_id = shift;
128 my $passwd = shift;
130 my $sid = undef;
132 if (my $u = $self->user( $user_id )) {
134 my $p = $u->get('password');
136 if (crypt($passwd, $p) eq $p) {
137 # create new sid
138 $sid = time() . $$;
140 my $session = Gruta::Data::Session->new(
141 id => $sid,
142 time => time(),
143 user_id => $user_id
146 $u->source->insert_session( $session );
148 $u->set('sid', $sid);
149 $self->auth($u);
153 return $sid;
157 sub logout {
158 my $self = shift;
160 if (my $auth = $self->auth()) {
161 if( my $sid = $auth->get('sid')) {
162 if (my $session = $auth->source->session( $sid )) {
163 $session->delete() if $session->can('delete');
168 $self->auth( undef );
169 return $self;
173 sub _link_to_topic {
174 my $self = shift;
175 my $topic_id = shift;
177 my $ret = undef;
179 if (my $t = $self->topic($topic_id)) {
180 $ret = "<a href='?t=TOPIC;topic=$topic_id'>" .
181 $t->get('name') . '</a>';
183 else {
184 $ret = "Bad topic $topic_id";
187 return $ret;
191 sub _link_to_story {
192 my $self = shift;
193 my $topic_id = shift;
194 my $story_id = shift;
196 my $ret = undef;
198 if (my $s = $self->story($topic_id, $story_id)) {
199 $ret = "<a href='?t=STORY;topic=$topic_id;id=$story_id'>" .
200 $s->get('title') . '</a>';
202 else {
203 $ret = "Bad story '$topic_id/$story_id'";
206 return $ret;
210 sub special_uris {
211 my $self = shift;
212 my $string = shift;
214 $string =~ s!topic://([\w\d_]+)!$self->_link_to_topic($1)!ge;
215 $string =~ s!story://([\w\d_]+)/([\w\d_]+)!$self->_link_to_story($1,$2)!ge;
217 return $string;
221 sub transfer_to_source {
222 my $self = shift;
223 my $dst = shift;
225 foreach my $id ($self->users()) {
226 my $u = $self->user($id);
227 $dst->insert_user($u);
230 foreach my $topic_id ($self->topics()) {
231 my $t = $self->topic($topic_id);
232 $dst->insert_topic($t);
234 foreach my $id ($self->stories($topic_id)) {
235 my $s = $self->story($topic_id, $id);
236 $dst->insert_story($s);
240 return $self;
244 sub flush_story_cache {
245 my $self = shift;
247 $self->{story_cache} = {};
251 sub new {
252 my $class = shift;
254 my $g = bless( { @_ } , $class);
256 $g->{id} ||= 'Gruta';
257 $g->{story_cache} = {};
259 if (ref($g->{sources}) ne 'ARRAY') {
260 $g->{sources} = [ $g->{sources} ];
262 if (ref($g->{renderers}) ne 'ARRAY') {
263 $g->{renderers} = [ $g->{renderers} ];
266 $g->{renderers_h} = {};
268 foreach my $r (@{$g->{renderers}}) {
269 $g->{renderers_h}->{$r->{renderer_id}} = $r;
272 $g->template->data($g) if $g->{template};
273 $g->cgi->data($g) if $g->{cgi};
275 return $g;
278 sub run {
279 my $self = shift;
281 if ($self->{cgi}) {
282 $self->cgi->run();