Deleted {-cgi-query} from the search box.
[gruta.git] / Gruta.pm
blobcca10422ad576fa47d00e6e0e28ea782e268b8cc
1 package Gruta;
3 use strict;
4 use warnings;
6 use Gruta::Data;
8 $Gruta::VERSION = '2.0.0-rc1';
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, @_); }
83 sub stories_by_date { my $self = shift; return $self->_call('stories_by_date', 1, @_); }
85 sub search_stories {
86 my $self = shift;
87 my $topic_id = shift;
89 my @l = $self->_call('search_stories', 1, $topic_id, @_);
91 return sort { $self->story($topic_id, $a)->get('title') cmp
92 $self->story($topic_id, $b)->get('title') } @l;
95 sub stories_top_ten {
96 my $self = shift;
98 my @l = $self->_call('stories_top_ten', 0, @_);
100 return sort { $b->[0] cmp $a->[0] } @l;
103 sub search_stories_by_tag {
104 my $self = shift;
106 my @l = $self->_call('search_stories_by_tag', 0, @_);
108 return sort { $self->story($a->[0], $a->[1])->get('title') cmp
109 $self->story($b->[0], $b->[1])->get('title') } @l;
112 sub tags {
113 my $self = shift;
115 my @l = $self->_call('tags', 0, @_);
117 return sort { $a->[0] cmp $b->[0] } @l;
120 sub insert_topic { my $self = shift; return $self->_call('insert_topic', 1, @_); }
121 sub insert_user { my $self = shift; return $self->_call('insert_user', 1, @_); }
122 sub insert_story { my $self = shift; return $self->_call('insert_story', 1, @_); }
125 sub auth {
126 my $self = shift;
128 if (@_) { $self->{auth} = shift; } # Gruta::Data::User
130 return $self->{auth};
134 sub auth_from_sid {
135 my $self = shift;
136 my $sid = shift;
138 my $u = undef;
140 if ($sid) {
141 $self->_call('purge_old_sessions', 0);
143 if (my $session = $self->_call('session', 1, $sid)) {
144 $u = $session->source->user( $session->get('user_id') );
145 $u->set('sid', $sid);
146 $self->auth($u);
150 return $u;
154 sub login {
155 my $self = shift;
156 my $user_id = shift;
157 my $passwd = shift;
159 my $sid = undef;
161 if (my $u = $self->user( $user_id )) {
163 # account expired? go!
164 if (my $xdate = $u->get('xdate')) {
165 if (Gruta::Data::today() > $xdate) {
166 return undef;
170 my $p = $u->get('password');
172 if (crypt($passwd, $p) eq $p) {
173 # create new sid
174 $sid = time() . $$;
176 my $session = Gruta::Data::Session->new(
177 id => $sid,
178 time => time(),
179 user_id => $user_id
182 $u->source->insert_session( $session );
184 $u->set('sid', $sid);
185 $self->auth($u);
189 return $sid;
193 sub logout {
194 my $self = shift;
196 if (my $auth = $self->auth()) {
197 if( my $sid = $auth->get('sid')) {
198 if (my $session = $auth->source->session( $sid )) {
199 $session->delete() if $session->can('delete');
204 $self->auth( undef );
205 return $self;
209 sub _link_to_topic {
210 my $self = shift;
211 my $topic_id = shift;
213 my $ret = undef;
215 if (my $t = $self->topic($topic_id)) {
216 $ret = "<a href='?t=TOPIC;topic=$topic_id'>" .
217 $t->get('name') . '</a>';
219 else {
220 $ret = "Bad topic $topic_id";
223 return $ret;
227 sub _link_to_story {
228 my $self = shift;
229 my $topic_id = shift;
230 my $story_id = shift;
232 my $ret = undef;
234 if (my $s = $self->story($topic_id, $story_id)) {
235 $ret = "<a href='?t=STORY;topic=$topic_id;id=$story_id'>" .
236 $s->get('title') . '</a>';
238 else {
239 $ret = "Bad story '$topic_id/$story_id'";
242 return $ret;
246 sub special_uris {
247 my $self = shift;
248 my $string = shift;
250 $string =~ s!topic://([\w\d_]+)!$self->_link_to_topic($1)!ge;
251 $string =~ s!story://([\w\d_]+)/([\w\d_]+)!$self->_link_to_story($1,$2)!ge;
253 return $string;
257 sub transfer_to_source {
258 my $self = shift;
259 my $dst = shift;
261 foreach my $id ($self->users()) {
262 my $u = $self->user($id);
263 $dst->insert_user($u);
266 foreach my $topic_id (sort $self->topics()) {
267 my $t = $self->topic($topic_id);
269 my $nti = $topic_id;
271 # is it an archive?
272 if ($nti =~ /-arch$/) {
273 # don't insert topic, just rename
274 $nti =~ s/-arch$//;
276 else {
277 $dst->insert_topic($t);
280 foreach my $id ($self->stories($topic_id)) {
282 # get story and its tags
283 my $s = $self->story($topic_id, $id);
284 my @tags = $s->tags();
286 # set new topic
287 $s->set('topic_id', $nti);
289 my $ns = $dst->insert_story($s);
291 if (@tags) {
292 $ns->tags(@tags);
297 return $self;
301 sub flush_story_cache {
302 my $self = shift;
304 $self->{story_cache} = {};
308 sub new {
309 my $class = shift;
311 my $g = bless( { @_ } , $class);
313 $g->{id} ||= 'Gruta';
314 $g->{story_cache} = {};
315 $g->{renderers_h} = {};
317 if (ref($g->{sources}) ne 'ARRAY') {
318 $g->{sources} = [ $g->{sources} ];
321 if ($g->{renderers}) {
322 if (ref($g->{renderers}) ne 'ARRAY') {
323 $g->{renderers} = [ $g->{renderers} ];
326 foreach my $r (@{$g->{renderers}}) {
327 $g->{renderers_h}->{$r->{renderer_id}} = $r;
331 $g->template->data($g) if $g->{template};
332 $g->cgi->data($g) if $g->{cgi};
334 return $g;
337 sub run {
338 my $self = shift;
340 if ($self->{cgi}) {
341 $self->cgi->run();