Added index navigation to bin/gruta-snapshot.
[gruta.git] / Gruta.pm
blob5c5bca42759028653d080c42e82a3f20f52eac4d
1 package Gruta;
3 use strict;
4 use warnings;
6 use locale;
8 use Gruta::Data;
10 $Gruta::VERSION = '2.3.3-dev';
11 $Gruta::VERSION_CODENAME = '"Volterra"';
13 sub source {
14 $_[0]->{source};
17 sub template {
18 $_[0]->{template};
21 sub cgi {
22 $_[0]->{cgi};
25 sub version {
26 $Gruta::VERSION . ' ' . $Gruta::VERSION_CODENAME;
29 sub log {
30 my $self = shift;
31 my $msg = shift;
33 print STDERR $self->{id}, ' ', scalar(localtime), ': ', $msg, "\n";
37 sub render {
38 my $self = shift;
39 my $story = shift; # Gruta::Data::Story
41 my $format = $story->get('format') || 'grutatxt';
43 if (my $rndr = $self->{renderers_h}->{$format}) {
44 $rndr->story($story);
49 sub auth {
50 my $self = shift;
52 if (@_) {
53 $self->{auth} = shift; # Gruta::Data::User
56 return $self->{auth};
60 sub session {
61 my $self = shift;
63 if (@_) {
64 $self->{session} = shift; # Gruta::Data::Session
67 return $self->{session};
71 sub auth_from_sid {
72 my $self = shift;
73 my $sid = shift;
75 my $u = undef;
77 if ($sid) {
78 $self->source->purge_old_sessions();
80 if (my $session = $self->source->session($sid)) {
81 $u = $session->source->user( $session->get('user_id') );
83 if ($u) {
84 $self->auth($u);
85 $self->session($session);
90 return $u;
94 sub login {
95 my $self = shift;
96 my $user_id = shift;
97 my $passwd = shift;
99 my $sid = undef;
101 if (my $u = $self->source->user( $user_id )) {
103 # account expired? go!
104 if (my $xdate = $u->get('xdate')) {
105 if (Gruta::Data::today() > $xdate) {
106 return undef;
110 my $p = $u->get('password');
112 if (Gruta::Data::crypt($passwd, $p) eq $p) {
113 # create new sid
114 my $session = Gruta::Data::Session->new(user_id => $user_id);
115 $self->source->insert_session($session);
117 # store user and session
118 $self->auth($u);
119 $self->session($session);
121 # and return sid to signal a valid login
122 $sid = $session->get('id');
127 return $sid;
131 sub logout {
132 my $self = shift;
134 if (my $session = $self->session()) {
135 $session->delete();
138 $self->auth(undef);
139 $self->session(undef);
141 return $self;
145 sub base_url {
146 $_[0]->{args}->{base_url} || ''
150 sub url {
151 my $self = shift;
152 my $st = shift || '';
153 my %args = @_;
155 if (scalar(@_) % 2) {
156 $self->log('Bad url: ' . join(';', $st, @_));
159 my $ret = $self->base_url();
161 # strip all undefined or empty arguments
162 %args = map { $_, $args{$_} } grep { $args{$_} } keys(%args);
164 if ($self->{args}->{static_urls}) {
165 my $kn = scalar(keys(%args));
167 if ($kn == 0) {
168 my %p = (
169 'INDEX' => '',
170 'RSS' => 'rss.xml',
171 'SITEMAP' => 'sitemap.xml',
172 'CSS' => 'style.css',
173 'TAGS' => 'tag/',
174 'TOP_TEN' => 'top/'
177 if (exists($p{$st})) {
178 return $ret . $p{$st};
182 if ($kn == 1) {
183 if ($st eq 'INDEX' && $args{offset}) {
184 return $ret . $args{offset} . '.html';
186 if ($st eq 'TOPIC' && $args{topic}) {
187 return $ret . $args{topic} . '/';
189 if ($st eq 'SEARCH_BY_TAG' && $args{tag}) {
190 return $ret . 'tag/' . $args{tag} . '.html';
194 if ($kn == 2) {
195 if ($st eq 'STORY' && $args{topic} && $args{id}) {
196 return $ret . $args{topic} . '/' . $args{id} . '.html';
198 if ($st eq 'TOPIC' && $args{topic} && $args{offset}) {
199 return $ret . $args{topic} . '/~' . $args{offset} . '.html';
201 if ($st eq 'SEARCH_BY_DATE' && $args{from} && $args{to}) {
202 # special case: full day search
203 $args{from} =~ /^([0-9]{8})/;
204 my $d = $1;
206 if ($d && $args{from} =~ /^${d}000000$/ && $args{to} =~ /^${d}235959$/) {
207 return $ret . $d . '/';
210 return $ret . $args{from} . '-' . $args{to} . '.html';
214 # if static_urls is 2, *never* return non-static
215 if ($self->{args}->{static_urls} == 2) {
216 return $ret;
220 if ($st) {
221 $args{t} = $st;
223 $ret .= '?' . join(';', map { "$_=$args{$_}" } sort keys(%args));
226 return $ret;
230 sub _topic_special_uri {
231 my $self = shift;
232 my $topic_id = shift;
234 my $ret = undef;
236 if (my $t = $self->source->topic($topic_id)) {
237 $ret = sprintf('<a href="%s">%s</a>',
238 $self->url('TOPIC', 'topic' => $topic_id),
239 $t->get('name')
242 else {
243 $ret = "Bad topic $topic_id";
246 return $ret;
250 sub _story_special_uri {
251 my $self = shift;
252 my $topic_id = shift;
253 my $story_id = shift;
255 my $ret = undef;
257 if (my $s = $self->source->story($topic_id, $story_id)) {
259 if ($s->is_visible($self->auth())) {
260 $ret = sprintf('<a href = "%s">%s</a>',
261 $self->url('STORY',
262 'topic' => $topic_id,
263 'id' => $story_id
265 $s->get('title')
268 else {
269 $ret = $s->get('title');
272 else {
273 my $topic = $self->source->topic($topic_id);
275 if (!$topic) {
276 $ret = "Bad topic '$topic_id'";
278 else {
279 $ret = "Bad story '$topic_id/$story_id'";
281 if ($topic->is_editor($self->auth())) {
282 $ret .= sprintf(' <a href = "%s">[+]</a>',
283 $self->url('EDIT_STORY',
284 'topic' => $topic_id,
285 'id' => $story_id
292 return $ret;
296 sub _img_special_uri {
297 my $self = shift;
298 my $src = shift;
299 my $class = shift;
301 my $more = '';
303 # try to load Image::Size
304 eval("use Image::Size;");
306 if (!$@) {
307 # if available and image is found, add dimensions to <img>
308 my ($w, $h) = imgsize('img/' . $src);
310 if ($w && $h) {
311 $more = sprintf('width = "%d" height = "%d"', $w, $h);
315 my $r = sprintf('<img src = "%simg/%s" %s />',
316 $self->base_url(), $src, $more
319 if ($class) {
320 $r = "<span class = '$class'>" . $r . '</span>';
323 return $r;
327 sub _thumb_special_uri {
328 my $self = shift;
329 my $src = shift;
330 my $class = shift;
332 my $more = '';
334 my $r = sprintf(
335 '<a href = "%simg/%s"><img src = "%simg/%s" width = "%d" /></a>',
336 $self->base_url(),
337 $src,
338 $self->base_url(),
339 $src,
340 ($self->{args}->{thumbnail_size} || 400)
343 if ($class) {
344 $r = "<span class = '$class'>" . $r . '</span>';
347 return $r;
351 sub _content_special_uri {
352 my $self = shift;
353 my $topic_id = shift;
354 my $story_id = shift;
355 my $field = shift;
357 my $ret = undef;
359 if (my $s = $self->source->story($topic_id, $story_id)) {
360 $ret = $self->special_uris($s->get($field));
362 else {
363 $ret = "Bad story '$topic_id/$story_id'";
366 return $ret;
371 sub special_uris {
372 my $self = shift;
373 my $string = shift;
375 $string =~ s!topic://([\w\d_-]+)!$self->_topic_special_uri($1)!ge;
376 $string =~ s!story://([\w\d_-]+)/([\w\d_-]+)!$self->_story_special_uri($1,$2)!ge;
377 $string =~ s!img://([\w\d_\.-]+)/?([\w\d_-]*)!$self->_img_special_uri($1,$2)!ge;
378 $string =~ s!thumb://([\w\d_\.-]+)/?([\w\d_-]*)!$self->_thumb_special_uri($1,$2)!ge;
379 $string =~ s!body://([\w\d_-]+)/([\w\d_-]+)!$self->_content_special_uri($1,$2,'body')!ge;
380 $string =~ s!abstract://([\w\d_-]+)/([\w\d_-]+)!$self->_content_special_uri($1,$2,'abstract')!ge;
382 return $string;
386 sub transfer_to_source {
387 my $self = shift;
388 my $dst = shift;
390 foreach my $id ($self->source->users()) {
391 my $u = $self->source->user($id);
392 $dst->insert_user($u);
395 foreach my $topic_id (sort $self->source->topics()) {
396 my $t = $self->source->topic($topic_id);
398 my $nti = $topic_id;
400 # is it an archive?
401 if ($nti =~ /-arch$/) {
402 # don't insert topic, just rename
403 $nti =~ s/-arch$//;
405 else {
406 $dst->insert_topic($t);
409 foreach my $id ($self->source->stories($topic_id)) {
411 # get story and its tags
412 my $s = $self->source->story($topic_id, $id);
413 my @tags = $s->tags();
415 # set new topic
416 $s->set('topic_id', $nti);
418 my $ns = $dst->insert_story($s);
420 if (@tags) {
421 $ns->tags(@tags);
426 foreach my $id ($self->source->templates()) {
427 my $t = $self->source->template($id);
428 $dst->insert_template($t);
431 return $self;
435 sub new {
436 my $class = shift;
438 my $g = bless( { @_ } , $class);
440 $g->{id} ||= 'Gruta';
441 $g->{args} ||= {};
443 $g->{renderers_h} = {};
445 if ($g->{sources}) {
446 if (ref($g->{sources}) ne 'ARRAY') {
447 $g->{sources} = [ $g->{sources} ];
450 if (!$g->{source}) {
451 $g->{source} = (@{$g->{sources}})[0];
455 if ($g->{source}) {
456 $g->source->data($g);
459 if ($g->{renderers}) {
460 if (ref($g->{renderers}) ne 'ARRAY') {
461 $g->{renderers} = [ $g->{renderers} ];
464 foreach my $r (@{$g->{renderers}}) {
465 $g->{renderers_h}->{$r->{renderer_id}} = $r;
469 if ($g->{template}) {
470 $g->template->data($g);
473 if ($g->{cgi}) {
474 $g->cgi->data($g);
477 # ensure base_url has a final /
478 if ($g->{args}->{base_url} && $g->{args}->{base_url} !~ /\/$/) {
479 $g->{args}->{base_url} .= '/';
482 return $g;
485 sub run {
486 my $self = shift;
488 if ($self->{cgi}) {
489 $self->cgi->run();