6 $Gruta::VERSION
= '2.0-pre2';
8 sub sources
{ return @
{$_[0]->{sources
}}; }
9 sub template
{ return $_[0]->{template
}; }
10 sub cgi
{ return $_[0]->{cgi
}; }
15 if (not $self->{_today
}) {
16 my ($S,$M,$H,$d,$m,$y) = (localtime)[0..5];
18 sprintf("%04d%02d%02d%02d%02d%02d",
19 1900 + $y, $m + 1, $d, $H, $M, $S);
22 return $self->{_today
};
29 print STDERR
$self->{id
}, ' ', scalar(localtime), ': ', $msg, "\n";
40 foreach my $s ($self->sources()) {
41 if (my $m = $s->can($method)) {
42 my @pr = $m->($s, @_);
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); }
66 if (! $topic_id || ! $id) {
71 my $ck = $topic_id . '/' . $id;
73 if ($story = $self->{story_cache
}->{$ck}) {
77 if (not $story = $self->_call('story', 1, $topic_id, $id)) {
81 my $format = $story->get('format') || 'grutatxt';
83 if (my $rndr = $self->{renderers_h
}->{$format}) {
87 return $self->{story_cache
}->{$ck} = $story;
91 sub stories
{ my $self = shift; return $self->_call('stories', 0, @_); }
92 sub stories_by_date
{ my $self = shift;
93 return $self->_call('stories_by_date', 1, @_, 'today' => $self->today()); }
94 sub search_stories
{ my $self = shift; return $self->_call('search_stories', 1, @_); }
99 my @l = $self->_call('stories_top_ten', 0, @_);
101 return sort { $b->[0] cmp $a->[0] } @l;
104 sub search_stories_by_tag
{ my $self = shift; return $self->_call('search_stories_by_tag', 0, @_); }
109 my @l = $self->_call('tags', 0, @_);
111 return sort { $b->[1] cmp $a->[1] } @l;
114 sub insert_topic
{ my $self = shift; return $self->_call('insert_topic', 1, @_); }
115 sub insert_user
{ my $self = shift; return $self->_call('insert_user', 1, @_); }
116 sub insert_story
{ my $self = shift; return $self->_call('insert_story', 1, @_); }
122 if (@_) { $self->{auth
} = shift; } # Gruta::Data::User
124 return $self->{auth
};
135 $self->_call('purge_old_sessions', 0);
137 if (my $session = $self->_call('session', 1, $sid)) {
138 $u = $session->source->user( $session->get('user_id') );
139 $u->set('sid', $sid);
155 if (my $u = $self->user( $user_id )) {
157 my $p = $u->get('password');
159 if (crypt($passwd, $p) eq $p) {
163 my $session = Gruta
::Data
::Session
->new(
169 $u->source->insert_session( $session );
171 $u->set('sid', $sid);
183 if (my $auth = $self->auth()) {
184 if( my $sid = $auth->get('sid')) {
185 if (my $session = $auth->source->session( $sid )) {
186 $session->delete() if $session->can('delete');
191 $self->auth( undef );
198 my $topic_id = shift;
202 if (my $t = $self->topic($topic_id)) {
203 $ret = "<a href='?t=TOPIC;topic=$topic_id'>" .
204 $t->get('name') . '</a>';
207 $ret = "Bad topic $topic_id";
216 my $topic_id = shift;
217 my $story_id = shift;
221 if (my $s = $self->story($topic_id, $story_id)) {
222 $ret = "<a href='?t=STORY;topic=$topic_id;id=$story_id'>" .
223 $s->get('title') . '</a>';
226 $ret = "Bad story '$topic_id/$story_id'";
237 $string =~ s!topic://([\w\d_]+)!$self->_link_to_topic($1)!ge;
238 $string =~ s!story://([\w\d_]+)/([\w\d_]+)!$self->_link_to_story($1,$2)!ge;
244 sub transfer_to_source
{
248 foreach my $id ($self->users()) {
249 my $u = $self->user($id);
250 $dst->insert_user($u);
253 foreach my $topic_id (sort $self->topics()) {
254 my $t = $self->topic($topic_id);
259 if ($nti =~ /-arch$/) {
260 # don't insert topic, just rename
264 $dst->insert_topic($t);
267 foreach my $id ($self->stories($topic_id)) {
269 # get story and its tags
270 my $s = $self->story($topic_id, $id);
271 my @tags = $s->tags();
274 $s->set('topic_id', $nti);
276 my $ns = $dst->insert_story($s);
288 sub flush_story_cache
{
291 $self->{story_cache
} = {};
298 my $g = bless( { @_ } , $class);
300 $g->{id
} ||= 'Gruta';
301 $g->{story_cache
} = {};
302 $g->{renderers_h
} = {};
304 if (ref($g->{sources
}) ne 'ARRAY') {
305 $g->{sources
} = [ $g->{sources
} ];
308 if ($g->{renderers
}) {
309 if (ref($g->{renderers
}) ne 'ARRAY') {
310 $g->{renderers
} = [ $g->{renderers
} ];
313 foreach my $r (@
{$g->{renderers
}}) {
314 $g->{renderers_h
}->{$r->{renderer_id
}} = $r;
318 $g->template->data($g) if $g->{template
};
319 $g->cgi->data($g) if $g->{cgi
};