10 $Gruta::VERSION
= '2.1.0-dev';
11 $Gruta::VERSION_CODENAME
= '"Calenzano"';
13 sub sources
{ return @
{$_[0]->{sources
}}; }
14 sub template
{ return $_[0]->{template
}; }
15 sub cgi
{ return $_[0]->{cgi
}; }
17 sub version
{ return $Gruta::VERSION
. ' ' . $Gruta::VERSION_CODENAME
; }
23 print STDERR
$self->{id
}, ' ', scalar(localtime), ': ', $msg, "\n";
34 if (!exists($self->{calls
}->{$method})) {
36 # cache all calls in the sources
39 foreach my $s ($self->sources()) {
40 if (my $m = $s->can($method)) {
41 push(@c, sub { return $m->($s, @_) });
45 $self->{calls
}->{$method} = [ @c ];
48 foreach my $m (@
{ $self->{calls
}->{$method}}) {
58 return wantarray ?
@r : $r[0];
61 sub topic
{ my $self = shift; return $self->_call('topic', 1, @_); }
62 sub topics
{ my $self = shift; return $self->_call('topics', 0); }
64 sub user
{ my $self = shift; return $self->_call('user', 1, @_); }
65 sub users
{ my $self = shift; return $self->_call('users', 0); }
72 if (! $topic_id || ! $id) {
77 my $ck = $topic_id . '/' . $id;
79 if ($story = $self->{story_cache
}->{$ck}) {
83 if (not $story = $self->_call('story', 1, $topic_id, $id)) {
87 my $format = $story->get('format') || 'grutatxt';
89 if (my $rndr = $self->{renderers_h
}->{$format}) {
93 return $self->{story_cache
}->{$ck} = $story;
97 sub stories
{ my $self = shift; return $self->_call('stories', 0, @_); }
104 my @r = sort { $b->[2] cmp $a->[2] } $self->_call('stories_by_date', 0, $topics, %opts);
106 if ($opts{num
} && scalar(@r) > $opts{num
}) {
107 @r = @r[0 .. $opts{num
} - 1];
115 my $topic_id = shift;
117 my @l = $self->_call('search_stories', 1, $topic_id, @_);
119 return sort { $self->story($topic_id, $a)->get('title') cmp
120 $self->story($topic_id, $b)->get('title') } @l;
123 sub stories_top_ten
{
126 my @l = $self->_call('stories_top_ten', 0, @_);
128 return sort { $b->[0] <=> $a->[0] } @l;
134 my @l = $self->_call('stories_by_tag', 0, @_);
136 return sort { $self->story($a->[0], $a->[1])->get('title') cmp
137 $self->story($b->[0], $b->[1])->get('title') } @l;
143 my @l = $self->_call('tags', 0, @_);
145 return sort { $a->[0] cmp $b->[0] } @l;
148 sub insert_topic
{ my $self = shift; return $self->_call('insert_topic', 1, @_); }
149 sub insert_user
{ my $self = shift; return $self->_call('insert_user', 1, @_); }
150 sub insert_story
{ my $self = shift; return $self->_call('insert_story', 1, @_); }
156 if (@_) { $self->{auth
} = shift; } # Gruta::Data::User
158 return $self->{auth
};
169 $self->_call('purge_old_sessions', 0);
171 if (my $session = $self->_call('session', 1, $sid)) {
172 $u = $session->source->user( $session->get('user_id') );
175 $u->set('sid', $sid);
192 if (my $u = $self->user( $user_id )) {
194 # account expired? go!
195 if (my $xdate = $u->get('xdate')) {
196 if (Gruta
::Data
::today
() > $xdate) {
201 my $p = $u->get('password');
203 if (Gruta
::Data
::crypt($passwd, $p) eq $p) {
205 my $session = Gruta
::Data
::Session
->new(user_id
=> $user_id);
207 $u->source->insert_session( $session );
209 $sid = $session->get('id');
210 $u->set('sid', $sid);
222 if (my $auth = $self->auth()) {
223 if( my $sid = $auth->get('sid')) {
224 if (my $session = $auth->source->session( $sid )) {
225 $session->delete() if $session->can('delete');
230 $self->auth( undef );
235 sub base_url
{ $_[0]->{args
}->{base_url
} || '' };
239 my $st = shift || '';
242 my $ret = $self->base_url();
244 # strip all undefined or empty arguments
245 %args = map { $_, $args{$_} } grep { $args{$_} } keys(%args);
247 if ($self->{args
}->{static_urls
}) {
248 my $kn = scalar(keys(%args));
250 if ($st eq 'INDEX' && $kn == 0) {
253 elsif ($st eq 'TOPIC' && $kn == 1) {
254 return $ret . $args{topic
} . '/';
256 elsif ($st eq 'STORY' && $kn == 2) {
257 return $ret . $args{topic
} . '/' . $args{id
} . '.html';
264 $ret .= '?' . join(';', map { "$_=$args{$_}" } sort keys(%args));
271 sub _topic_special_uri
{
273 my $topic_id = shift;
277 if (my $t = $self->topic($topic_id)) {
278 $ret = sprintf('<a href="%s">%s</a>',
279 $self->url('TOPIC', 'topic' => $topic_id),
284 $ret = "Bad topic $topic_id";
291 sub _story_special_uri
{
293 my $topic_id = shift;
294 my $story_id = shift;
298 if (my $s = $self->story($topic_id, $story_id)) {
299 $ret = sprintf('<a href="%s">%s</a>',
301 'topic' => $topic_id,
308 $ret = "Bad story '$topic_id/$story_id'";
315 sub _img_special_uri
{
320 my $r = sprintf('<img src = "%simg/%s" />',
321 $self->base_url(), $src
325 $r = "<span class = '$class'>" . $r . '</span>';
332 sub _content_special_uri
{
334 my $topic_id = shift;
335 my $story_id = shift;
340 if (my $s = $self->story($topic_id, $story_id)) {
341 $ret = $self->special_uris($s->get($field));
344 $ret = "Bad story '$topic_id/$story_id'";
356 $string =~ s!topic://([\w\d_-]+)!$self->_topic_special_uri($1)!ge;
357 $string =~ s!story://([\w\d_-]+)/([\w\d_-]+)!$self->_story_special_uri($1,$2)!ge;
358 $string =~ s!img://([\w\d_\.-]+)/?([\w\d_-]*)!$self->_img_special_uri($1,$2)!ge;
359 $string =~ s!body://([\w\d_-]+)/([\w\d_-]+)!$self->_content_special_uri($1,$2,'body')!ge;
360 $string =~ s!abstract://([\w\d_-]+)/([\w\d_-]+)!$self->_content_special_uri($1,$2,'abstract')!ge;
366 sub transfer_to_source
{
370 foreach my $id ($self->users()) {
371 my $u = $self->user($id);
372 $dst->insert_user($u);
375 foreach my $topic_id (sort $self->topics()) {
376 my $t = $self->topic($topic_id);
381 if ($nti =~ /-arch$/) {
382 # don't insert topic, just rename
386 $dst->insert_topic($t);
389 foreach my $id ($self->stories($topic_id)) {
391 # get story and its tags
392 my $s = $self->story($topic_id, $id);
393 my @tags = $s->tags();
396 $s->set('topic_id', $nti);
398 my $ns = $dst->insert_story($s);
410 sub flush_story_cache
{
413 $self->{story_cache
} = {};
420 my $g = bless( { @_ } , $class);
422 $g->{id
} ||= 'Gruta';
425 $g->{story_cache
} = {};
426 $g->{renderers_h
} = {};
430 if (ref($g->{sources
}) ne 'ARRAY') {
431 $g->{sources
} = [ $g->{sources
} ];
434 foreach my $s (@
{$g->{sources
}}) {
439 if ($g->{renderers
}) {
440 if (ref($g->{renderers
}) ne 'ARRAY') {
441 $g->{renderers
} = [ $g->{renderers
} ];
444 foreach my $r (@
{$g->{renderers
}}) {
445 $g->{renderers_h
}->{$r->{renderer_id
}} = $r;
449 if ($g->{template
}) {
450 $g->template->data($g);