source: trunk/wiki.cgi @ 3

Last change on this file since 3 was 2, checked in by kake, 19 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 22.2 KB
Line 
1#!/usr/bin/perl -w
2
3use strict;
4use warnings;
5
6use lib qw( /home/kake/local/share/perl/5.6.1/
7            /home/kake/local/lib/perl/5.6.1/
8          );
9
10use CGI qw/:standard/;
11use CGI::Wiki;
12use CGI::Wiki::Store::SQLite;
13use CGI::Wiki::Search::SII;
14use CGI::Wiki::Formatter::UseMod;
15use CGI::Wiki::Plugin::Locator::UK;
16use Geography::NationalGrid;
17use Geography::NationalGrid::GB;
18use CGI::Wiki::Plugin::RSS::ModWiki;
19use CGI::Wiki::Plugin::RSS::ChefMoz;
20use Template;
21use CGI::Carp qw(fatalsToBrowser);
22use Time::Piece;
23use URI::Escape;
24
25# config vars
26my $FULL_CGI_URL = "http://the.earth.li/~kake/cgi-bin/cgi-wiki/wiki.cgi?";
27
28# Make store.
29my $store   = CGI::Wiki::Store::SQLite->new(
30    dbname     => "/home/kake/public_html/cgi-out/cgi-wiki.db"
31);
32
33# Make search.
34my $indexdb = Search::InvertedIndex::DB::DB_File_SplitHash->new(
35    -map_name  => "/home/kake/public_html/cgi-out/cgi-wiki-index.db",
36    -lock_mode => "EX"
37);
38
39my $search  = CGI::Wiki::Search::SII->new( indexdb => $indexdb );
40
41# Make formatter.
42my %macros = (
43    '@SEARCHBOX' =>
44        qq(<form action="wiki.cgi" method="get">
45           <input type="hidden" name="action" value="search">
46           <input type="text" size="20" name="terms">
47           <input type="submit" name="Search" value="Search"></form>),
48    qr/\@INDEX_LINK\s+\[\[Category\s+([^\]]+)\]\]/ =>
49        sub { return qq(<a href="wiki.cgi?action=catindex&category=) . uri_escape($_[0]) . qq(">View all pages in Category $_[0]</a>)
50            }
51);
52
53my $formatter = CGI::Wiki::Formatter::UseMod->new(
54    extended_links      => 1,
55    implicit_links      => 0,
56    allowed_tags        => [qw(a p b strong i em pre small img table td tr th
57                               br hr ul li center blockquote kbd div code
58                               strike)],
59    macros              => \%macros,
60    node_prefix         => 'wiki.cgi?',
61    edit_prefix         => 'wiki.cgi?action=edit&id='
62);
63
64my %conf = ( store     => $store,
65             search    => $search,
66             formatter => $formatter );
67
68my ($wiki, $locator, $q);
69eval {
70    $wiki = CGI::Wiki->new(%conf);
71    $locator = CGI::Wiki::Plugin::Locator::UK->new( wiki => $wiki );
72
73    # Get CGI object, find out what to do.
74    $q = CGI->new;
75
76    # Note $q->param('keywords') gives you the entire param string.
77    # We need this because usemod has URLs like foo.com/wiki.pl?This_Page
78    my $node = $q->param('id') || $q->param('title') || $q->param('keywords') || "";
79    $node = $formatter->node_param_to_node_name( $node );
80
81    my $action = $q->param('action') || 'display';
82    my $commit = $q->param('Save') || 0;
83    my $preview = $q->param('preview') || 0;
84    my $search_terms = $q->param('terms') || $q->param('search') || '';
85    my $username = $q->param('username') || '';
86    my $format = $q->param('format') || '';
87
88    # Alternative method of calling search, supported by usemod.
89    $action = 'search' if $q->param("search");
90
91    if ($commit) {
92        commit_node($node);
93    } elsif ($preview) {
94        preview_node($node);
95    } elsif ($action eq 'edit') {
96        edit_node($node);
97    } elsif ($action eq 'search') {
98        do_search($search_terms);
99    } elsif ($action eq 'show_backlinks') {
100        show_backlinks($node);
101    } elsif ($action eq 'index') {
102        my @all_nodes = $wiki->list_all_nodes();
103        my @nodes = map { { name  => $_,
104                            param => $formatter->node_name_to_node_param($_) }
105                        } sort @all_nodes;
106        process_template("site_index.tt", "index", { nodes => \@nodes });
107    } elsif ($action eq 'random') {
108        my @nodes = $wiki->list_all_nodes();
109        $node = $nodes[int(rand(scalar(@nodes) + 1)) + 1];
110        redirect_to_node($node);
111        exit 0;
112    } elsif ($action eq 'catindex') {
113        my $cat = $q->param('category');
114        my @cats = $wiki->list_nodes_by_metadata( metadata_type => "category",
115                                                  metadata_value => $cat );
116        my @nodes = map { { name  => $_,
117                            param => $formatter->node_name_to_node_param($_) }
118                        } sort @cats;
119        my ($template, $omit_header);
120        if ( $format eq "rdf" ) {
121            $template = "rdf_index.tt";
122            $omit_header = 1;
123#            print "Content-type: application/xml\n\n";
124            print "Content-type: text/plain\n\n";
125        } else {
126            $template = "site_index.tt";
127        }
128        process_template($template, "Category Index",
129                         { nodes    => \@nodes,
130                           category => { name => $q->escapeHTML($cat),
131                                         url  => "wiki.cgi?Category_"
132                        . uri_escape($formatter->node_name_to_node_param($cat))
133                                        }
134                          },
135                          {},
136                          $omit_header);
137    } elsif ($action eq 'find_within_distance') {
138        my $metres = $q->param("distance_in_metres");
139        my @finds = $locator->find_within_distance( node => $node,
140                                                    metres => $metres );
141        my @nodes;
142        foreach my $find ( @finds ) {
143            my $distance = $locator->distance( from_node => $node,
144                                               to_node   => $find,
145                                               unit      => "metres" );
146            push @nodes, { name => $find,
147                           param => $formatter->node_name_to_node_param($find),
148                           distance => $distance };
149        }
150        @nodes = sort { $a->{distance} <=> $b->{distance} } @nodes;
151        process_template("site_index.tt", "index",
152                         { nodes  => \@nodes,
153                           origin => $node,
154                           origin_param => $formatter->node_name_to_node_param($node),
155                           limit  => "$metres metres" } );
156    } elsif ($action eq 'userstats') {
157        show_userstats( $username );
158    } elsif ($action eq 'list_all_versions') {
159        list_all_versions($node);
160    } elsif ($action eq 'rss') {
161        my $feed = $q->param("feed");
162        if ( !defined $feed or $feed eq "recent_changes" ) {
163            emit_recent_changes_rss();
164        } elsif ( $feed eq "chef_moz" ) {
165            emit_chef_moz_rss( node => $node );
166        } elsif ( $feed eq "chef_dan" ) {
167            emit_chef_dan_rss( node => $node );
168        } else {
169            croak "Unknown RSS feed type '$feed'";
170        }
171    } else {
172        my $version = $q->param("version");
173        display_node($node, $version);
174    }
175};
176
177if ($@) {
178    my $error = $@;
179    warn $error;
180    print $q->header;
181    print qq(<html><head><title>ERROR</title></head><body>
182             <p>Sorry!  Something went wrong.  Please contact the
183             Wiki administrator at
184             <a href="mailto:kake\@earth.li">kake\@earth.li</a> and quote
185             the following error message:</p><blockquote>)
186      . $q->escapeHTML($error)
187      . qq(</blockquote><p><a href="wiki.cgi">Return to the Wiki home page</a>
188           </body></html>);
189}
190exit 0;
191
192############################ subroutines ###################################
193
194sub redirect_to_node {
195    my $node = shift;
196    print $q->redirect($FULL_CGI_URL . $q->escape($formatter->node_name_to_node_param($node)));
197    exit 0;
198}
199
200sub display_node {
201    my ($node, $version) = @_;
202    $node ||= "Home";
203
204    my %tt_vars;
205
206    # If this is a Category node, check whether it exists and write it
207    # a stub node if it doesn't.
208    if ( $node =~ /^Category (.*)$/ ) {
209        $tt_vars{is_category_node} = 1;
210        $tt_vars{category_name}    = $1;
211
212        unless ( $wiki->node_exists($node) ) {
213            warn "Creating default node $node";
214            $wiki->write_node( $node,
215                               "\@INDEX_LINK [[$node]]",
216                               undef,
217                               { username => "Auto Create",
218                                 comment  => "Auto created category stub page"
219                               }
220            );
221        }
222    }
223
224    my %current_data = $wiki->retrieve_node( $node );
225    my $current_version = $current_data{version};
226    undef $version if ($version && $version == $current_version);
227    my %criteria = ( name => $node );
228    $criteria{version} = $version if $version;#retrieve_node default is current
229
230    my %node_data = $wiki->retrieve_node( %criteria );
231    my $raw = $node_data{content};
232    if ( $raw =~ /^#REDIRECT\s+(.+?)\s+$/ ) {
233        my $redirect = $1;
234        # Strip off enclosing [[ ]] in case this is an extended link.
235        $redirect =~ s/^\[\[//;
236        $redirect =~ s/\]\]$//;
237        # See if this is a valid node, if not then just show the page as-is.
238        if ( $wiki->node_exists($redirect) ) {
239            redirect_to_node($redirect);
240        }
241    }
242    my $content    = $wiki->format($raw);
243    my $modified   = $node_data{last_modified};
244    my %metadata   = %{$node_data{metadata}};
245    my $catref     = $metadata{category};
246    my $locref     = $metadata{locale};
247    my $os_x       = $metadata{os_x}[0];
248    my $os_y       = $metadata{os_y}[0];
249    my $phone      = $metadata{phone}[0];
250    my $website    = $metadata{website}[0];
251    my $hours_text = $metadata{opening_hours_text}[0];
252    my $postcode   = $metadata{postcode}[0];
253
254    my ($lat, $long);
255    if ( $os_x && $os_y ) {
256        my $point = Geography::NationalGrid::GB->new( Easting  => $os_x,
257                                                      Northing => $os_y );
258        $lat  = $point->latitude;
259        $long = $point->longitude;
260    }
261
262    my @categories = map { { name => $_,
263                             url  => "wiki.cgi?Category_"
264            . uri_escape($formatter->node_name_to_node_param($_)) } } @$catref;
265
266    my @locales    = map { { name => $_,
267                             url  => "wiki.cgi?Category_"
268            . uri_escape($formatter->node_name_to_node_param($_)) } } @$locref;
269
270    %tt_vars = (    %tt_vars,
271                    content       => $content,
272                    categories    => \@categories,
273                    locales       => \@locales,
274                    os_x          => $os_x,
275                    os_y          => $os_y,
276                    phone         => $phone,
277                    website       => $website,
278                    hours_text    => $hours_text,
279                    postcode      => $postcode,
280                    latitude      => $lat,
281                    longitude     => $long,
282                    last_modified => $modified,
283                    version       => $node_data{version},
284                    node_name     => $q->escapeHTML($node),
285                    node_param    => $q->escape($node) );
286
287    # We've undef'ed $version above if this is the current version.
288    $tt_vars{current} = 1 unless $version;
289
290    if ($node eq "RecentChanges") {
291        my @recent = $wiki->list_recent_changes( days => 7 );
292        @recent = map { {name          => $q->escapeHTML($_->{name}),
293                         last_modified => $q->escapeHTML($_->{last_modified}),
294                         comment       => $q->escapeHTML($_->{metadata}{comment}[0]),
295                         username      => $q->escapeHTML($_->{metadata}{username}[0]),
296                         url           => "wiki.cgi?"
297          . $q->escape($formatter->node_name_to_node_param($_->{name})) }
298                       } @recent;
299        $tt_vars{recent_changes} = \@recent;
300        $tt_vars{days} = 7;
301        process_template("recent_changes.tt", $node, \%tt_vars);
302    } elsif ($node eq "Home") {
303        my @recent = $wiki->list_recent_changes( last_n_changes => 10);
304        @recent = map { {name          => $q->escapeHTML($_->{name}),
305                         last_modified => $q->escapeHTML($_->{last_modified}),
306                         comment       => $q->escapeHTML($_->{metadata}{comment}[0]),
307                         username      => $q->escapeHTML($_->{metadata}{username}[0]),
308                         url           => "wiki.cgi?"
309          . $q->escape($formatter->node_name_to_node_param($_->{name})) }
310                       } @recent;
311        $tt_vars{recent_changes} = \@recent;
312        process_template("home_node.tt", $node, \%tt_vars);
313    } else {
314        process_template("node.tt", $node, \%tt_vars);
315    }
316}
317
318sub list_all_versions {
319    my $node = shift;
320    my %curr_data = $wiki->retrieve_node($node);
321    my $curr_version = $curr_data{version};
322    croak "This is the first version" unless $curr_version > 1;
323    my @history;
324    for my $version ( 1 .. $curr_version ) {
325        my %node_data = $wiki->retrieve_node( name    => $node,
326                                              version => $version );
327        push @history, { version  => $version,
328                         modified => $node_data{last_modified},
329                         username => $node_data{metadata}{username}[0],
330                         comment  => $node_data{metadata}{comment}[0]   };
331    }
332    @history = reverse @history;
333    my %tt_vars = ( node    => $node,
334                    version => $curr_version,
335                    history => \@history );
336    process_template("node_history.tt", $node, \%tt_vars );
337}
338
339sub show_userstats {
340    my $username = shift;
341    croak "No username supplied to show_userstats" unless $username;
342    my @nodes = $wiki->list_recent_changes(
343        last_n_changes => 5,
344        metadata_is    => { username => $username }
345    );
346    @nodes = map { {name          => $q->escapeHTML($_->{name}),
347                    last_modified => $q->escapeHTML($_->{last_modified}),
348                    comment       => $q->escapeHTML($_->{metadata}{comment}[0]),
349                    url           => "wiki.cgi?"
350          . $q->escape($formatter->node_name_to_node_param($_->{name})) }
351                       } @nodes;
352    my %tt_vars = ( last_five_nodes => \@nodes,
353                    username        => $username );
354    process_template("userstats.tt", "", \%tt_vars);
355}
356
357sub preview_node {
358    my $node = shift;
359    my $content         = $q->param('content');
360    $content =~ s/\r\n/\n/gs;
361    my $checksum        = $q->param('checksum');
362    my $categories_text = $q->param('categories');
363    my $os_x            = $q->param('os_x');
364    my $os_y            = $q->param('os_y');
365    my $phone           = $q->param('phone');
366    my $website         = $q->param('website');
367    my $hours_text      = $q->param('hours_text');
368    my $postcode        = $q->param('postcode');
369    my $username        = $q->param('username');
370    my $comment         = $q->param('comment');
371
372    my @categories = sort split("\r\n", $categories_text);
373
374    if ($wiki->verify_checksum($node, $checksum)) {
375        my %tt_vars = ( content      => $q->escapeHTML($content),
376                        categories   => \@categories,
377                        os_x         => $os_x,
378                        os_y         => $os_y,
379                        phone         => $phone,
380                        website       => $website,
381                        hours_text    => $hours_text,
382                        postcode     => $postcode,
383                        username     => $username,
384                        comment      => $comment,
385                        preview_html => $wiki->format($content),
386                        checksum     => $q->escapeHTML($checksum) );
387
388        process_template("edit_form.tt", $node, \%tt_vars);
389    } else {
390    croak "edit_conflict needs to be brought up to date to cope with metadata";
391        my %node_data = $wiki->retrieve_node($node);
392        my ($stored, $checksum) = @node_data{ qw( content checksum ) };
393        my %tt_vars = ( checksum    => $q->escapeHTML($checksum),
394                        new_content => $q->escapeHTML($content),
395                        stored      => $q->escapeHTML($stored) );
396        process_template("edit_conflict.tt", $node, \%tt_vars);
397    }
398}
399
400sub edit_node {
401    my $node = shift;
402    my %node_data = $wiki->retrieve_node($node);
403    my ($content, $checksum) = @node_data{ qw( content checksum ) };
404    my %metadata   = %{$node_data{metadata}};
405    my $catref     = $metadata{category};
406    my $locref     = $metadata{locale};
407    my $os_x       = $metadata{os_x}[0];
408    my $os_y       = $metadata{os_y}[0];
409    my $phone      = $metadata{phone}[0];
410    my $website    = $metadata{website}[0];
411    my $hours_text = $metadata{opening_hours_text}[0];
412    my $postcode   = $metadata{postcode}[0];
413    my %tt_vars = ( content    => $q->escapeHTML($content),
414                    checksum   => $q->escapeHTML($checksum),
415                    categories => $catref,
416                    locales    => $locref,
417                    os_x       => $os_x,
418                    os_y       => $os_y,
419                    phone      => $phone,
420                    website    => $website,
421                    hours_text => $hours_text,
422                    postcode   => $postcode
423    );
424
425    process_template("edit_form.tt", $node, \%tt_vars);
426}
427
428
429sub emit_recent_changes_rss {
430    my $rss = CGI::Wiki::Plugin::RSS::ModWiki->new(
431        wiki      => $wiki,
432        site_name => "CGI::Wiki Test Site",
433        site_description => "A clone of the Open Community Guide To London",
434        make_node_url => sub {
435            my ( $node_name, $version ) = @_;
436            return "http://the.earth.li/~kake/cgi-bin/cgi-wiki/wiki.cgi?id="
437                 . uri_escape(
438                        $wiki->formatter->node_name_to_node_param( $node_name )
439                             )
440                 . ";version=" . uri_escape($version);
441          },
442        recent_changes_link =>
443            "http://the.earth.li/~kake/cgi-bin/cgi-wiki/wiki.cgi?RecentChanges"
444     );
445
446    print "Content-type: text/plain\n\n";
447    print $rss->recent_changes;
448    exit 0;
449}
450
451sub emit_chef_moz_rss {
452    my %args = @_;
453    my $node = $args{node};
454    my $rss = CGI::Wiki::Plugin::RSS::ChefMoz->new(
455        wiki      => $wiki,
456        site_name => "CGI::Wiki Test Site",
457        site_description => "A clone of the Open Community Guide To London",
458        make_node_url => sub {
459            my ( $node_name, $version ) = @_;
460            return "http://the.earth.li/~kake/cgi-bin/cgi-wiki/wiki.cgi?id="
461                 . uri_escape(
462                        $wiki->formatter->node_name_to_node_param( $node_name )
463                             )
464                 . ";version=" . uri_escape($version);
465        },
466        full_node_prefix =>
467            "http://the.earth.li/~kake/cgi-bin/cgi-wiki/wiki.cgi?",
468        default_city => "London",
469        default_country => "United Kingdom"
470     );
471
472    print "Content-type: text/plain\n\n";
473    print $rss->chef_moz( node => $node );
474    exit 0;
475}
476
477sub emit_chef_dan_rss {
478    my %args = @_;
479    my $node = $args{node};
480    my $rss = CGI::Wiki::Plugin::RSS::ChefMoz->new(
481        wiki      => $wiki,
482        site_name => "CGI::Wiki Test Site",
483        site_description => "A clone of the Open Community Guide To London",
484        make_node_url => sub {
485            my ( $node_name, $version ) = @_;
486            if ( defined $version ) {
487               return "http://the.earth.li/~kake/cgi-bin/cgi-wiki/wiki.cgi?id="
488                 . uri_escape(
489                        $wiki->formatter->node_name_to_node_param( $node_name )
490                             )
491                 . ";version=" . uri_escape($version);
492             } else {
493                return "http://the.earth.li/~kake/cgi-bin/cgi-wiki/wiki.cgi?"
494                 . uri_escape(
495                        $wiki->formatter->node_name_to_node_param( $node_name )
496                             );
497             }
498        },
499        full_node_prefix => "REMOVE - not used",
500        default_city => "London",
501        default_country => "United Kingdom"
502     );
503
504    print "Content-type: text/plain\n\n";
505    print $rss->chef_dan( node => $node );
506    exit 0;
507}
508
509
510sub process_template {
511    my ($template, $node, $vars, $conf, $omit_header) = @_;
512
513    $vars ||= {};
514    $conf ||= {};
515
516    my %tt_vars = ( %$vars,
517                    site_name     => "CGI::Wiki Test Site",
518                    cgi_url       => "wiki.cgi",
519                    full_cgi_url  => $FULL_CGI_URL,
520                    contact_email => "kake\@earth.li",
521                    description   => "",
522                    keywords      => "",
523                    stylesheet    => "http://grault.net/grubstreet/grubstreet.css",
524                    home_link     => "wiki.cgi",
525                    home_name     => "Home" );
526
527    if ($node) {
528        $tt_vars{node_name} = $q->escapeHTML($node);
529        $tt_vars{node_param} = $q->escape($formatter->node_name_to_node_param($node));
530    }
531
532    my %tt_conf = ( %$conf,
533                INCLUDE_PATH => "/home/kake/public_html/cgi-bin/cgi-wiki/templates" );
534
535    # Create Template object, print CGI header, process template.
536    my $tt = Template->new(\%tt_conf);
537    print $q->header unless $omit_header;
538    unless ($tt->process($template, \%tt_vars)) {
539        print qq(<html><head><title>ERROR</title></head><body><p>
540                 Failed to process template: )
541          . $tt->error
542          . qq(</p></body></html>);
543    }
544}
545
546
547sub commit_node {
548    my $node = shift;
549    my $content  = $q->param('content');
550    $content =~ s/\r\n/\n/gs;
551    my $checksum = $q->param('checksum');
552    my $categories_text = $q->param('categories');
553    my $locales_text    = $q->param('locales');
554    my $os_x            = $q->param('os_x');
555    my $os_y            = $q->param('os_y');
556    my $phone           = $q->param('phone');
557    my $website         = $q->param('website');
558    my $hours_text      = $q->param('hours_text');
559    my $postcode        = $q->param('postcode');
560    my $username        = $q->param('username');
561    my $comment         = $q->param('comment');
562
563    my @categories = sort split("\r\n", $categories_text);
564    my @locales    = sort split("\r\n", $locales_text);
565
566    my $written = $wiki->write_node($node, $content, $checksum,
567                                    { category   => \@categories,
568                                      locale     => \@locales,
569                                      os_x       => $os_x,
570                                      os_y       => $os_y,
571                                      phone      => $phone,
572                                      website    => $website,
573                              opening_hours_text => $hours_text,
574                                      postcode   => $postcode,
575                                      username   => $username,
576                                      comment    => $comment      } );
577    if ($written) {
578        redirect_to_node($node);
579    } else {
580    croak "edit_conflict needs to be brought up to date to cope with metadata";
581        my %node_data = $wiki->retrieve_node($node);
582        my ($stored, $checksum) = @node_data{ qw( content checksum ) };
583        my %tt_vars = ( checksum    => $q->escapeHTML($checksum),
584                        new_content => $q->escapeHTML($content),
585                        stored      => $q->escapeHTML($stored) );
586        process_template("edit_conflict.tt", $node, \%tt_vars);
587    }
588}
589
590
591sub do_search {
592    my $terms = shift;
593    my %finds = $wiki->search_nodes($terms);
594#    my @sorted = sort { $finds{$a} cmp $finds{$b} } keys %finds;
595    my @sorted = sort keys %finds;
596    my @results = map {
597        { url   => $q->escape($formatter->node_name_to_node_param($_)),
598          title => $q->escapeHTML($_)
599        }             } @sorted;
600    my %tt_vars = ( results      => \@results,
601                    num_results  => scalar @results,
602                    not_editable => 1,
603                    search_terms => $q->escapeHTML($terms) );
604    process_template("search_results.tt", "", \%tt_vars);
605}
606
607sub show_backlinks {
608    my $node = shift;
609    my @backlinks = $wiki->list_backlinks( node => $node );
610    my @results = map {
611        { url   => $q->escape($formatter->node_name_to_node_param($_)),
612          title => $q->escapeHTML($_)
613        }             } sort @backlinks;
614    my %tt_vars = ( results      => \@results,
615                    num_results  => scalar @results,
616                    not_editable => 1 );
617    process_template("backlink_results.tt", $node, \%tt_vars);
618}
619
Note: See TracBrowser for help on using the repository browser.