source: trunk/lib/OpenGuides.pm @ 1064

Last change on this file since 1064 was 1064, checked in by kake, 14 years ago

Add intercept_redirect parameter to Openguides->display_node - used with the return_output parameter for testing.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 75.7 KB
Line 
1package OpenGuides;
2use strict;
3
4use Carp "croak";
5use CGI;
6use Wiki::Toolkit::Plugin::Diff;
7use Wiki::Toolkit::Plugin::Locator::Grid;
8use OpenGuides::CGI;
9use OpenGuides::Feed;
10use OpenGuides::Template;
11use OpenGuides::Utils;
12use Time::Piece;
13use URI::Escape;
14
15use vars qw( $VERSION );
16
17$VERSION = '0.60';
18
19=head1 NAME
20
21OpenGuides - A complete web application for managing a collaboratively-written guide to a city or town.
22
23=head1 DESCRIPTION
24
25The OpenGuides software provides the framework for a collaboratively-written
26city guide.  It is similar to a wiki but provides somewhat more structured
27data storage allowing you to annotate wiki pages with information such as
28category, location, and much more.  It provides searching facilities
29including "find me everything within a certain distance of this place".
30Every page includes a link to a machine-readable (RDF) version of the page.
31
32=head1 METHODS
33
34=over
35
36=item B<new>
37
38  my $config = OpenGuides::Config->new( file => "wiki.conf" );
39  my $guide = OpenGuides->new( config => $config );
40
41=cut
42
43sub new {
44    my ($class, %args) = @_;
45    my $self = {};
46    bless $self, $class;
47    my $wiki = OpenGuides::Utils->make_wiki_object( config => $args{config} );
48    $self->{wiki} = $wiki;
49    $self->{config} = $args{config};
50
51    my $geo_handler = $self->config->geo_handler;
52    my $locator;
53    if ( $geo_handler == 1 ) {
54        $locator = Wiki::Toolkit::Plugin::Locator::Grid->new(
55                                             x => "os_x",    y => "os_y" );
56    } elsif ( $geo_handler == 2 ) {
57        $locator = Wiki::Toolkit::Plugin::Locator::Grid->new(
58                                             x => "osie_x",  y => "osie_y" );
59    } else {
60        $locator = Wiki::Toolkit::Plugin::Locator::Grid->new(
61                                             x => "easting", y => "northing" );
62    }
63    $wiki->register_plugin( plugin => $locator );
64    $self->{locator} = $locator;
65
66    my $differ = Wiki::Toolkit::Plugin::Diff->new;
67    $wiki->register_plugin( plugin => $differ );
68    $self->{differ} = $differ;
69
70    if($self->config->ping_services) {
71        eval {
72            require Wiki::Toolkit::Plugin::Ping;
73        };
74
75        if ( $@ ) {
76            warn "You asked for some ping services, but can't find "
77                 . "Wiki::Toolkit::Plugin::Ping";
78        } else {
79            my @ws = split(/\s*,\s*/, $self->config->ping_services);
80            my %well_known = Wiki::Toolkit::Plugin::Ping->well_known;
81            my %services;
82            foreach my $s (@ws) {
83                if($well_known{$s}) {
84                    $services{$s} = $well_known{$s};
85                } else {
86                    warn("Ignoring unknown ping service '$s'");
87                }
88            }
89            my $ping = Wiki::Toolkit::Plugin::Ping->new(
90                node_to_url => $self->{config}->{script_url}
91                               . $self->{config}->{script_name} . '?$node',
92                services => \%services
93            );
94            $wiki->register_plugin( plugin => $ping );
95        }
96    }
97
98    return $self;
99}
100
101=item B<wiki>
102
103An accessor, returns the underlying L<Wiki::Toolkit> object.
104
105=cut
106
107sub wiki {
108    my $self = shift;
109    return $self->{wiki};
110}
111
112=item B<config>
113
114An accessor, returns the underlying L<OpenGuides::Config> object.
115
116=cut
117
118sub config {
119    my $self = shift;
120    return $self->{config};
121}
122
123=item B<locator>
124
125An accessor, returns the underlying L<Wiki::Toolkit::Plugin::Locator::UK> object.
126
127=cut
128
129sub locator {
130    my $self = shift;
131    return $self->{locator};
132}
133
134=item B<differ>
135
136An accessor, returns the underlying L<Wiki::Toolkit::Plugin::Diff> object.
137
138=cut
139
140sub differ {
141    my $self = shift;
142    return $self->{differ};
143}
144
145=item B<display_node>
146
147  # Print node to STDOUT.
148  $guide->display_node(
149                          id      => "Calthorpe Arms",
150                          version => 2,
151                      );
152
153  # Or return output as a string (useful for writing tests).
154  $guide->display_node(
155                          id            => "Calthorpe Arms",
156                          return_output => 1,
157                      );
158
159  # Or return the hash of variables that will be passed to the template
160  # (not including those set additionally by OpenGuides::Template).
161  $guide->display_node(
162                          id             => "Calthorpe Arms",
163                          return_tt_vars => 1,
164                      );
165
166If C<version> is omitted then it will assume you want the latest version.
167
168Note that if you pass the C<return_output> parameter, and your node is a
169redirecting node, this method will fake the redirect and return the output
170that will actually end up in the user's browser.  If instead you want to see
171the HTTP headers that will be printed in order to perform the redirect, pass
172the C<intercept_redirect> parameter as well.  The C<intercept_redirect>
173parameter has no effect if the node isn't a redirect, or if the
174C<return_output> parameter is omitted.
175
176(At the moment, C<return_tt_vars> acts as if the C<intercept_redirect>
177parameter was passed.)
178
179=cut
180
181sub display_node {
182    my ($self, %args) = @_;
183    my $return_output = $args{return_output} || 0;
184    my $intercept_redirect = $args{intercept_redirect};
185    my $version = $args{version};
186    my $id = $args{id} || $self->config->home_name;
187    my $wiki = $self->wiki;
188    my $config = $self->config;
189    my $oldid = $args{oldid} || '';
190    my $do_redirect = defined($args{redirect}) ? $args{redirect} : 1;
191
192    my %tt_vars;
193
194    $tt_vars{home_name} = $self->config->home_name;
195   
196    if ( $id =~ /^(Category|Locale) (.*)$/ ) {
197        my $type = $1;
198        $tt_vars{is_indexable_node} = 1;
199        $tt_vars{index_type} = lc($type);
200        $tt_vars{index_value} = $2;
201        $tt_vars{"rss_".lc($type)."_url"} =
202                           $config->script_name . "?action=rc;format=rss;"
203                           . lc($type) . "=" . lc(CGI->escape($2));
204        $tt_vars{"atom_".lc($type)."_url"} =
205                           $config->script_name . "?action=rc;format=atom;"
206                           . lc($type) . "=" . lc(CGI->escape($2));
207    }
208
209    my %current_data = $wiki->retrieve_node( $id );
210    my $current_version = $current_data{version};
211    undef $version if ($version && $version == $current_version);
212    my %criteria = ( name => $id );
213    $criteria{version} = $version if $version; # retrieve_node default is current
214
215    my %node_data = $wiki->retrieve_node( %criteria );
216
217    # Fixes passing undefined values to Text::Wikiformat if node doesn't exist.
218    my $content = '';
219    if ($node_data{content}) {
220        $content    = $wiki->format($node_data{content});
221    }
222
223    my $modified   = $node_data{last_modified};
224    my $moderated  = $node_data{moderated};
225    my %metadata   = %{$node_data{metadata}};
226
227    my ($wgs84_long, $wgs84_lat) = OpenGuides::Utils->get_wgs84_coords(
228                                        longitude => $metadata{longitude}[0],
229                                        latitude => $metadata{latitude}[0],
230                                        config => $config);
231    if ($args{format} && $args{format} eq 'raw') {
232        print "Content-Type: text/plain\n\n";
233        print $node_data{content};
234        return 0;
235    }
236   
237    my %metadata_vars = OpenGuides::Template->extract_metadata_vars(
238                            wiki     => $wiki,
239                            config   => $config,
240                            metadata => $node_data{metadata}
241                        );
242
243    %tt_vars = (
244                   %tt_vars,
245                   %metadata_vars,
246                   content       => $content,
247                   last_modified => $modified,
248                   version       => $node_data{version},
249                   node          => $id,
250                   language      => $config->default_language,
251                   moderated     => $moderated,
252                   oldid         => $oldid,
253                   enable_gmaps  => 1,
254                   wgs84_long    => $wgs84_long,
255                   wgs84_lat     => $wgs84_lat
256               );
257
258    if ( $config->show_gmap_in_node_display
259           && $self->get_cookie( "display_google_maps" ) ) {
260        $tt_vars{display_google_maps} = 1;
261    }
262
263    # Should we include a standard list of categories or locales?
264    if ($config->enable_common_categories || $config->enable_common_locales) {
265        $tt_vars{common_catloc} = 1;
266        $tt_vars{common_categories} = $config->enable_common_categories;
267        $tt_vars{common_locales} = $config->enable_common_locales;
268        $tt_vars{catloc_link} = $config->script_url . $config->script_name
269                                . "?id=";
270    }
271   
272    if ( $node_data{content} && $node_data{content} =~ /^#REDIRECT\s+(.+?)\s*$/ ) {
273        my $redirect = $1;
274        # Strip off enclosing [[ ]] in case this is an extended link.
275        $redirect =~ s/^\[\[//;
276        $redirect =~ s/\]\]\s*$//;
277
278        # Don't redirect if the parameter "redirect" is given as 0.
279        if ($do_redirect == 0) {
280            return %tt_vars if $args{return_tt_vars};
281            $tt_vars{current} = 1;
282            my $output = $self->process_template(
283                                                  id            => $id,
284                                                  template      => "node.tt",
285                                                  tt_vars       => \%tt_vars,
286                                                );
287            return $output if $return_output;
288            print $output;
289        } elsif ( $wiki->node_exists($redirect) && $redirect ne $id && $redirect ne $oldid ) {
290            # Avoid loops by not generating redirects to the same node or the previous node.
291            if ( $return_output ) {
292                if ( $intercept_redirect ) {
293                    return $self->redirect_to_node( $redirect, $id );
294                } else {
295                    return $self->display_node( id            => $redirect,
296                                                oldid         => $id,
297                                                return_output => 1,
298                                              );
299                }
300            }
301            print $self->redirect_to_node( $redirect, $id );
302            return 0;
303        }
304    }
305
306    # We've undef'ed $version above if this is the current version.
307    $tt_vars{current} = 1 unless $version;
308
309    if ($id eq "RecentChanges") {
310        $self->display_recent_changes(%args);
311    } elsif ( $id eq $self->config->home_name ) {
312        if ( $self->config->recent_changes_on_home_page ) {
313            my @recent = $wiki->list_recent_changes(
314                last_n_changes => 10,
315                metadata_was   => { edit_type => "Normal edit" },
316            );
317            @recent = map {
318                            {
319                              name          => CGI->escapeHTML($_->{name}),
320                              last_modified =>
321                                  CGI->escapeHTML($_->{last_modified}),
322                              version       => CGI->escapeHTML($_->{version}),
323                              comment       =>
324                                  CGI->escapeHTML($_->{metadata}{comment}[0]),
325                              username      =>
326                                  CGI->escapeHTML($_->{metadata}{username}[0]),
327                              url           => $config->script_name . "?"
328                                             . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name}))
329                            }
330                          } @recent;
331            $tt_vars{recent_changes} = \@recent;
332        }
333        return %tt_vars if $args{return_tt_vars};
334        my $output = $self->process_template(
335                                                id            => $id,
336                                                template      => "home_node.tt",
337                                                tt_vars       => \%tt_vars,
338                                            );
339        return $output if $return_output;
340        print $output;
341    } else {
342        return %tt_vars if $args{return_tt_vars};
343        my $output = $self->process_template(
344                                                id            => $id,
345                                                template      => "node.tt",
346                                                tt_vars       => \%tt_vars,
347                                            );
348        return $output if $return_output;
349        print $output;
350    }
351}
352
353=item B<display_random_page>
354
355  $guide->display_random_page;
356
357Display a random page.  As with other methods, the C<return_output>
358parameter can be used to return the output instead of printing it to STDOUT.
359You can also restrict it to a given category and/or locale by supplying
360appropriate parameters:
361
362  $guide->display_random_page(
363                               category => "pubs",
364                               locale   => "bermondsey",
365                             );
366
367The values of these parameters are case-insensitive.
368
369You can make sure this method never returns pages that are themselves
370categories and/or locales by setting C<random_page_omits_categories>
371and/or C<random_page_omits_locales> in your wiki.conf.
372
373=cut
374
375sub display_random_page {
376    my ( $self, %args ) = @_;
377    my $wiki = $self->wiki;
378    my $config = $self->config;
379
380    my ( @catnodes, @locnodes, @nodes );
381    if ( $args{category} ) {
382        @catnodes = $wiki->list_nodes_by_metadata(
383            metadata_type  => "category",
384            metadata_value => $args{category},
385            ignore_case    => 1,
386        );
387    }
388    if ( $args{locale} ) {
389        @locnodes = $wiki->list_nodes_by_metadata(
390            metadata_type  => "locale",
391            metadata_value => $args{locale},
392            ignore_case    => 1,
393        );
394    }
395
396    if ( $args{category} && $args{locale} ) {
397        # If we have both category and locale, return the intersection.
398        my %count;
399        foreach my $node ( @catnodes, @locnodes ) {
400            $count{$node}++;
401        }
402        foreach my $node ( keys %count ) {
403            push @nodes, $node if $count{$node} > 1;
404        }
405    } elsif ( $args{category} ) {
406        @nodes = @catnodes;
407    } elsif ( $args{locale} ) {
408        @nodes = @locnodes;
409    } else {
410        @nodes = $wiki->list_all_nodes();
411    }
412
413    my $omit_cats = $config->random_page_omits_categories;
414    my $omit_locs = $config->random_page_omits_locales;
415
416    if ( $omit_cats || $omit_locs ) {
417        my %all_nodes = map { $_ => $_ } @nodes;
418        if ( $omit_cats ) {
419            my @cats = $wiki->list_nodes_by_metadata(
420                                                  metadata_type  => "category",
421                                                  metadata_value => "category",
422                                                  ignore_case => 1,
423            );
424            foreach my $omit ( @cats ) {
425                delete $all_nodes{$omit};
426            }
427        }
428        if ( $omit_locs ) {
429            my @locs = $wiki->list_nodes_by_metadata(
430                                                  metadata_type  => "category",
431                                                  metadata_value => "locales",
432                                                  ignore_case => 1,
433            );
434            foreach my $omit ( @locs ) {
435                delete $all_nodes{$omit};
436            }
437        }
438        @nodes = keys %all_nodes;
439    }
440    my $node = $nodes[ rand @nodes ];
441    my $output;
442
443    if ( $node ) {
444        $output = $self->redirect_to_node( $node );
445    } else {
446        my %tt_vars = (
447                        category => $args{category},
448                        locale   => $args{locale},
449                      );
450        $output = OpenGuides::Template->output(
451            wiki     => $wiki,
452            config   => $config,
453            template => "random_page_failure.tt",
454            vars     => \%tt_vars,
455        );
456    }
457    return $output if $args{return_output};
458    print $output;
459}
460
461=item B<display_edit_form>
462
463  $guide->display_edit_form(
464                             id => "Vivat Bacchus",
465                           );
466
467Display an edit form for the specified node.  As with other methods, the
468C<return_output> parameter can be used to return the output instead of
469printing it to STDOUT.
470
471=cut
472
473sub display_edit_form {
474    my ($self, %args) = @_;
475    my $return_output = $args{return_output} || 0;
476    my $config = $self->config;
477    my $wiki = $self->wiki;
478    my $node = $args{id};
479    my %node_data = $wiki->retrieve_node($node);
480    my ($content, $checksum) = @node_data{ qw( content checksum ) };
481    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
482
483    my $username = $self->get_cookie( "username" );
484    my $edit_type = $self->get_cookie( "default_edit_type" ) eq "normal"
485                        ? "Normal edit"
486                        : "Minor tidying";
487
488    my %metadata_vars = OpenGuides::Template->extract_metadata_vars(
489                             wiki     => $wiki,
490                             config   => $config,
491                 metadata => $node_data{metadata} );
492
493    $metadata_vars{website} ||= 'http://';
494    my $moderate = $wiki->node_required_moderation($node);
495
496    my %tt_vars = ( content         => CGI->escapeHTML($content),
497                    checksum        => CGI->escapeHTML($checksum),
498                    %metadata_vars,
499                    config          => $config,
500                    username        => $username,
501                    edit_type       => $edit_type,
502                    moderate        => $moderate,
503                    deter_robots    => 1,
504    );
505
506    my $output = $self->process_template(
507                                          id            => $node,
508                                          template      => "edit_form.tt",
509                                          tt_vars       => \%tt_vars,
510                                        );
511    return $output if $return_output;
512    print $output;
513}
514
515=item B<preview_edit>
516
517  $guide->preview_edit(
518                        id      => "Vivat Bacchus",
519                        cgi_obj => $q,
520                      );
521
522Preview the edited version of the specified node.  As with other methods, the
523C<return_output> parameter can be used to return the output instead of
524printing it to STDOUT.
525
526=cut
527
528sub preview_edit {
529    my ($self, %args) = @_;
530    my $node = $args{id};
531    my $q = $args{cgi_obj};
532    my $return_output = $args{return_output};
533    my $wiki = $self->wiki;
534    my $config = $self->config;
535
536    my $content  = $q->param('content');
537    $content     =~ s/\r\n/\n/gs;
538    my $checksum = $q->param('checksum');
539
540    my %new_metadata = OpenGuides::Template->extract_metadata_vars(
541                                               wiki                 => $wiki,
542                                               config               => $config,
543                                               cgi_obj              => $q,
544                                               set_coord_field_vars => 1,
545    );
546    foreach my $var ( qw( username comment edit_type ) ) {
547        $new_metadata{$var} = $q->escapeHTML($q->param($var));
548    }
549
550    if ($wiki->verify_checksum($node, $checksum)) {
551        my $moderate = $wiki->node_required_moderation($node);
552        my %tt_vars = (
553            %new_metadata,
554            config                 => $config,
555            content                => $q->escapeHTML($content),
556            preview_html           => $wiki->format($content),
557            preview_above_edit_box => $self->get_cookie(
558                                                   "preview_above_edit_box" ),
559            checksum               => $q->escapeHTML($checksum),
560            moderate               => $moderate
561        );
562        my $output = $self->process_template(
563                                              id       => $node,
564                                              template => "edit_form.tt",
565                                              tt_vars  => \%tt_vars,
566                                            );
567        return $output if $args{return_output};
568        print $output;
569    } else {
570        return $self->_handle_edit_conflict(
571                                             id            => $node,
572                                             content       => $content,
573                                             new_metadata  => \%new_metadata,
574                                             return_output => $return_output,
575                                           );
576    }
577}
578
579=item B<display_recent_changes> 
580
581  $guide->display_recent_changes;
582
583As with other methods, the C<return_output> parameter can be used to
584return the output instead of printing it to STDOUT.
585
586=cut
587
588sub display_recent_changes {
589    my ($self, %args) = @_;
590    my $config = $self->config;
591    my $wiki = $self->wiki;
592    my $minor_edits = $self->get_cookie( "show_minor_edits_in_rc" );
593    my $id = $args{id} || $self->config->home_name;
594    my $return_output = $args{return_output} || 0;
595    my (%tt_vars, %recent_changes);
596    my $q = CGI->new;
597    my $since = $q->param("since");
598    if ( $since ) {
599        $tt_vars{since} = $since;
600        my $t = localtime($since); # overloaded by Time::Piece
601        $tt_vars{since_string} = $t->strftime;
602        my %criteria = ( since => $since );   
603        $criteria{metadata_was} = { edit_type => "Normal edit" }
604          unless $minor_edits;
605        my @rc = $self->{wiki}->list_recent_changes( %criteria );
606 
607        @rc = map {
608            {
609              name        => CGI->escapeHTML($_->{name}),
610              last_modified => CGI->escapeHTML($_->{last_modified}),
611              version     => CGI->escapeHTML($_->{version}),
612              comment     => CGI->escapeHTML($_->{metadata}{comment}[0]),
613              username    => CGI->escapeHTML($_->{metadata}{username}[0]),
614              host        => CGI->escapeHTML($_->{metadata}{host}[0]),
615              username_param => CGI->escape($_->{metadata}{username}[0]),
616              edit_type   => CGI->escapeHTML($_->{metadata}{edit_type}[0]),
617              url         => $config->script_name . "?"
618      . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name})),
619        }
620                   } @rc;
621        if ( scalar @rc ) {
622            $recent_changes{since} = \@rc; 
623        }
624    } else {
625        for my $days ( [0, 1], [1, 7], [7, 14], [14, 30] ) {
626            my %criteria = ( between_days => $days );
627            $criteria{metadata_was} = { edit_type => "Normal edit" }
628              unless $minor_edits;
629            my @rc = $self->{wiki}->list_recent_changes( %criteria );
630
631            @rc = map {
632            {
633              name        => CGI->escapeHTML($_->{name}),
634              last_modified => CGI->escapeHTML($_->{last_modified}),
635              version     => CGI->escapeHTML($_->{version}),
636              comment     => CGI->escapeHTML($_->{metadata}{comment}[0]),
637              username    => CGI->escapeHTML($_->{metadata}{username}[0]),
638              host        => CGI->escapeHTML($_->{metadata}{host}[0]),
639              username_param => CGI->escape($_->{metadata}{username}[0]),
640              edit_type   => CGI->escapeHTML($_->{metadata}{edit_type}[0]),
641              url         => $config->script_name . "?"
642      . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name})),
643        }
644                       } @rc;
645            if ( scalar @rc ) {
646                $recent_changes{$days->[1]} = \@rc;
647        }
648        }
649    }
650    $tt_vars{not_editable} = 1;
651    if ($config->enable_common_categories || $config->enable_common_locales) {
652        $tt_vars{common_catloc} = 1;
653        $tt_vars{common_categories} = $config->enable_common_categories;
654        $tt_vars{common_locales} = $config->enable_common_locales;
655        $tt_vars{catloc_link} = $config->script_url . $config->script_name
656                                . "?id=";
657    }
658    $tt_vars{recent_changes} = \%recent_changes;
659    my %processing_args = (
660                            id            => $id,
661                            template      => "recent_changes.tt",
662                            tt_vars       => \%tt_vars,
663                           );
664    if ( !$since && $self->get_cookie("track_recent_changes_views") ) {
665    my $cookie =
666           OpenGuides::CGI->make_recent_changes_cookie(config => $config );
667        $processing_args{cookies} = $cookie;
668        $tt_vars{last_viewed} = OpenGuides::CGI->get_last_recent_changes_visit_from_cookie( config => $config );
669    }
670    return %tt_vars if $args{return_tt_vars};
671    my $output = $self->process_template( %processing_args );
672    return $output if $return_output;
673    print $output;
674}
675
676=item B<display_diffs>
677
678  $guide->display_diffs(
679                           id            => "Home Page",
680                           version       => 6,
681                           other_version => 5,
682                       );
683
684  # Or return output as a string (useful for writing tests).
685  my $output = $guide->display_diffs(
686                                        id            => "Home Page",
687                                        version       => 6,
688                                        other_version => 5,
689                                        return_output => 1,
690                                    );
691
692  # Or return the hash of variables that will be passed to the template
693  # (not including those set additionally by OpenGuides::Template).
694  my %vars = $guide->display_diffs(
695                                      id             => "Home Page",
696                                      version        => 6,
697                                      other_version  => 5,
698                                      return_tt_vars => 1,
699                                  );
700
701=cut
702
703sub display_diffs {
704    my ($self, %args) = @_;
705    my %diff_vars = $self->differ->differences(
706                                                  node          => $args{id},
707                                                  left_version  => $args{version},
708                                                  right_version => $args{other_version},
709                                              );
710    $diff_vars{not_deletable} = 1;
711    $diff_vars{not_editable}  = 1;
712    $diff_vars{deter_robots}  = 1;
713    return %diff_vars if $args{return_tt_vars};
714    my $output = $self->process_template(
715                                            id       => $args{id},
716                                            template => "differences.tt",
717                                            tt_vars  => \%diff_vars
718                                        );
719    return $output if $args{return_output};
720    print $output;
721}
722
723=item B<find_within_distance>
724
725  $guide->find_within_distance(
726                                  id => $node,
727                                  metres => $q->param("distance_in_metres")
728                              );
729
730=cut
731
732sub find_within_distance {
733    my ($self, %args) = @_;
734    my $node = $args{id};
735    my $metres = $args{metres};
736    my %data = $self->wiki->retrieve_node( $node );
737    my $lat = $data{metadata}{latitude}[0];
738    my $long = $data{metadata}{longitude}[0];
739    my $script_url = $self->config->script_url;
740    my $q = CGI->new;
741    print $q->redirect( $script_url . "search.cgi?lat=$lat;long=$long;distance_in_metres=$metres" );
742}
743
744=item B<show_backlinks>
745
746  $guide->show_backlinks( id => "Calthorpe Arms" );
747
748As with other methods, parameters C<return_tt_vars> and
749C<return_output> can be used to return these things instead of
750printing the output to STDOUT.
751
752=cut
753
754sub show_backlinks {
755    my ($self, %args) = @_;
756    my $wiki = $self->wiki;
757    my $formatter = $wiki->formatter;
758
759    my @backlinks = $wiki->list_backlinks( node => $args{id} );
760    my @results = map {
761                          {
762                              url   => CGI->escape($formatter->node_name_to_node_param($_)),
763                              title => CGI->escapeHTML($_)
764                          }
765                      } sort @backlinks;
766    my %tt_vars = ( results       => \@results,
767                    num_results   => scalar @results,
768                    not_deletable => 1,
769                    deter_robots  => 1,
770                    not_editable  => 1 );
771    return %tt_vars if $args{return_tt_vars};
772    my $output = OpenGuides::Template->output(
773                                                 node    => $args{id},
774                                                 wiki    => $wiki,
775                                                 config  => $self->config,
776                                                 template=>"backlink_results.tt",
777                                                 vars    => \%tt_vars,
778                                             );
779    return $output if $args{return_output};
780    print $output;
781}
782
783=item B<show_index>
784
785  $guide->show_index(
786                        type   => "category",
787                        value  => "pubs",
788                    );
789
790  # RDF version.
791  $guide->show_index(
792                        type   => "locale",
793                        value  => "Holborn",
794                        format => "rdf",
795                    );
796
797  # RSS / Atom version (recent changes style).
798  $guide->show_index(
799                        type   => "locale",
800                        value  => "Holborn",
801                        format => "rss",
802                    );
803
804  # Or return output as a string (useful for writing tests).
805  $guide->show_index(
806                        type          => "category",
807                        value         => "pubs",
808                        return_output => 1,
809                    );
810
811If either the C<type> or the C<value> parameter is omitted, then all pages
812will be returned.
813
814=cut
815
816sub show_index {
817    my ($self, %args) = @_;
818    my $wiki = $self->wiki;
819    my $formatter = $wiki->formatter;
820    my %tt_vars;
821    my @selnodes;
822
823    if ( $args{type} and $args{value} ) {
824        if ( $args{type} eq "fuzzy_title_match" ) {
825            my %finds = $wiki->fuzzy_title_match( $args{value} );
826            @selnodes = sort { $finds{$a} <=> $finds{$b} } keys %finds;
827            $tt_vars{criterion} = {
828                type  => $args{type},  # for RDF version
829                value => $args{value}, # for RDF version
830                name  => CGI->escapeHTML("Fuzzy Title Match on '$args{value}'")
831            };
832            $tt_vars{not_editable} = 1;
833        } else {
834            @selnodes = $wiki->list_nodes_by_metadata(
835                metadata_type  => $args{type},
836                metadata_value => $args{value},
837                ignore_case    => 1
838            );
839            my $name = ucfirst($args{type}) . " $args{value}";
840            my $url = $self->config->script_name
841                      . "?"
842                      . ucfirst( $args{type} )
843                      . "_"
844                      . uri_escape(
845                                      $formatter->node_name_to_node_param($args{value})
846                                  );
847            $tt_vars{criterion} = {
848                type  => $args{type},
849                value => $args{value}, # for RDF version
850                name  => CGI->escapeHTML( $name ),
851                url   => $url
852            };
853            $tt_vars{not_editable} = 1;
854        }
855    } else {
856        @selnodes = $wiki->list_all_nodes();
857    }
858
859    my @nodes = map {
860                        {
861                            name      => $_,
862                            node_data => { $wiki->retrieve_node( name => $_ ) },
863                            param     => $formatter->node_name_to_node_param($_) }
864                        } sort @selnodes;
865
866    # Convert the lat+long to WGS84 as required
867    for(my $i=0; $i<scalar @nodes;$i++) {
868        my $node = $nodes[$i];
869        if($node) {
870            my %metadata = %{$node->{node_data}->{metadata}};
871            my ($wgs84_long, $wgs84_lat);
872            eval {
873                ($wgs84_long, $wgs84_lat) = OpenGuides::Utils->get_wgs84_coords(
874                                      longitude => $metadata{longitude}[0],
875                                      latitude => $metadata{latitude}[0],
876                                      config => $self->config);
877            };
878            warn $@." on ".$metadata{latitude}[0]." ".$metadata{longitude}[0] if $@;
879
880            push @{$nodes[$i]->{node_data}->{metadata}->{wgs84_long}}, $wgs84_long;
881            push @{$nodes[$i]->{node_data}->{metadata}->{wgs84_lat}},  $wgs84_lat;
882        }
883    }
884
885    $tt_vars{nodes} = \@nodes;
886
887    my ($template, %conf);
888
889    if ( $args{format} ) {
890        if ( $args{format} eq "rdf" ) {
891            $template = "rdf_index.tt";
892            $conf{content_type} = "application/rdf+xml";
893        }
894        elsif ( $args{format} eq "plain" ) {
895            $template = "plain_index.tt";
896            $conf{content_type} = "text/plain";
897        } elsif ( $args{format} eq "map" ) {
898            my $q = CGI->new;
899            $tt_vars{zoom} = $q->param('zoom') || '';
900            $tt_vars{lat} = $q->param('lat') || '';
901            $tt_vars{long} = $q->param('long') || '';
902            $tt_vars{map_type} = $q->param('map_type') || '';
903            $tt_vars{centre_long} = $self->config->centre_long;
904            $tt_vars{centre_lat} = $self->config->centre_lat;
905            $tt_vars{default_gmaps_zoom} = $self->config->default_gmaps_zoom;
906            $tt_vars{enable_gmaps} = 1;
907            $tt_vars{display_google_maps} = 1; # override for this page
908            $template = "map_index.tt";
909           
910        } elsif( $args{format} eq "rss" || $args{format} eq "atom") {
911            # They really wanted a recent changes style rss/atom feed
912            my $feed_type = $args{format};
913            my ($feed,$content_type) = $self->get_feed_and_content_type($feed_type);
914            $feed->set_feed_name_and_url_params(
915                        "Index of $args{type} $args{value}",
916                        "action=index;index_type=$args{type};index_value=$args{value}"
917            );
918
919            # Grab the actual node data out of @nodes
920            my @node_data;
921            foreach my $node (@nodes) {
922                $node->{node_data}->{name} = $node->{name};
923                push @node_data, $node->{node_data};
924            }
925
926            my $output = "Content-Type: ".$content_type."\n";
927            $output .= $feed->build_feed_for_nodes($feed_type, @node_data);
928
929            return $output if $args{return_output};
930            print $output;
931            return;
932        }
933    } else {
934        $template = "site_index.tt";
935    }
936
937    %conf = (
938                %conf,
939                template    => $template,
940                tt_vars     => \%tt_vars,
941            );
942
943    my $output = $self->process_template( %conf );
944    return $output if $args{return_output};
945    print $output;
946}
947
948=item B<list_all_versions>
949
950  $guide->list_all_versions ( id => "Home Page" );
951
952  # Or return output as a string (useful for writing tests).
953  $guide->list_all_versions (
954                                id            => "Home Page",
955                                return_output => 1,
956                            );
957
958  # Or return the hash of variables that will be passed to the template
959  # (not including those set additionally by OpenGuides::Template).
960  $guide->list_all_versions (
961                                id             => "Home Page",
962                                return_tt_vars => 1,
963                            );
964
965=cut
966
967sub list_all_versions {
968    my ($self, %args) = @_;
969    my $return_output = $args{return_output} || 0;
970    my $node = $args{id};
971    my %curr_data = $self->wiki->retrieve_node($node);
972    my $curr_version = $curr_data{version};
973    my @history;
974    for my $version ( 1 .. $curr_version ) {
975        my %node_data = $self->wiki->retrieve_node( name    => $node,
976                                                    version => $version );
977        # $node_data{version} will be zero if this version was deleted.
978        push @history, {
979            version  => CGI->escapeHTML( $version ),
980            modified => CGI->escapeHTML( $node_data{last_modified} ),
981            username => CGI->escapeHTML( $node_data{metadata}{username}[0] ),
982            comment  => CGI->escapeHTML( $node_data{metadata}{comment}[0] ),
983                       } if $node_data{version};
984    }
985    @history = reverse @history;
986    my %tt_vars = (
987                      node          => $node,
988                      version       => $curr_version,
989                      not_deletable => 1,
990                      not_editable  => 1,
991                      deter_robots  => 1,
992                      history       => \@history
993                  );
994    return %tt_vars if $args{return_tt_vars};
995    my $output = $self->process_template(
996                                            id       => $node,
997                                            template => "node_history.tt",
998                                            tt_vars  => \%tt_vars,
999                                        );
1000    return $output if $return_output;
1001    print $output;
1002}
1003
1004=item B<get_feed_and_content_type>
1005
1006Fetch the OpenGuides feed object, and the output content type, for the
1007supplied feed type.
1008
1009Handles all the setup for the OpenGuides feed object.
1010
1011=cut
1012
1013sub get_feed_and_content_type {
1014    my ($self, $feed_type) = @_;
1015
1016    my $feed = OpenGuides::Feed->new(
1017                                        wiki       => $self->wiki,
1018                                        config     => $self->config,
1019                                        og_version => $VERSION,
1020                                    );
1021
1022    my $content_type = $feed->default_content_type($feed_type);
1023
1024    return ($feed, $content_type);
1025}
1026
1027=item B<display_feed>
1028
1029  # Last ten non-minor edits to Hammersmith pages in RSS 1.0 format
1030  $guide->display_feed(
1031                         feed_type          => 'rss',
1032                         feed_listing       => 'recent_changes',
1033                         items              => 10,
1034                         ignore_minor_edits => 1,
1035                         locale             => "Hammersmith",
1036                     );
1037
1038  # All edits bob has made to pub pages in the last week in Atom format
1039  $guide->display_feed(
1040                         feed_type    => 'atom',
1041                         feed_listing => 'recent_changes',
1042                         days         => 7,
1043                         username     => "bob",
1044                         category     => "Pubs",
1045                     );
1046
1047C<feed_type> is a mandatory parameter. Supported values at present are
1048"rss" and "atom".
1049
1050C<feed_listing> is a mandatory parameter. Supported values at present
1051are "recent_changes". (More values are coming soon though!)
1052
1053As with other methods, the C<return_output> parameter can be used to
1054return the output instead of printing it to STDOUT.
1055
1056=cut
1057
1058sub display_feed {
1059    my ($self, %args) = @_;
1060
1061    my $feed_type = $args{feed_type};
1062    croak "No feed type given" unless $feed_type;
1063
1064    my $feed_listing = $args{feed_listing};
1065    croak "No feed listing given" unless $feed_listing;
1066   
1067    my $return_output = $args{return_output} ? 1 : 0;
1068
1069    # Basic criteria, whatever the feed listing type is
1070    my %criteria = (
1071                       feed_type             => $feed_type,
1072                       feed_listing          => $feed_listing,
1073                       also_return_timestamp => 1,
1074                   );
1075
1076    # Feed listing specific criteria
1077    if($feed_listing eq "recent_changes") {
1078        $criteria{items} = $args{items} || "";
1079        $criteria{days}  = $args{days}  || "";
1080        $criteria{ignore_minor_edits} = $args{ignore_minor_edits} ? 1 : 0;
1081
1082        my $username = $args{username} || "";
1083        my $category = $args{category} || "";
1084        my $locale   = $args{locale}   || "";
1085
1086        my %filter;
1087        $filter{username} = $username if $username;
1088        $filter{category} = $category if $category;
1089        $filter{locale}   = $locale   if $locale;
1090        if ( scalar keys %filter ) {
1091            $criteria{filter_on_metadata} = \%filter;
1092        }
1093    }
1094    elsif($feed_listing eq "node_all_versions") {
1095        $criteria{name} = $args{name};
1096    }
1097
1098
1099    # Get the feed object, and the content type
1100    my ($feed,$content_type) = $self->get_feed_and_content_type($feed_type);
1101
1102    my $output = "Content-Type: ".$content_type;
1103    if($self->config->http_charset) {
1104        $output .= "; charset=".$self->config->http_charset;
1105    }
1106    $output .= "\n";
1107   
1108    # Get the feed, and the timestamp, in one go
1109    my ($feed_output, $feed_timestamp) = 
1110        $feed->make_feed( %criteria );
1111    my $maker = $feed->fetch_maker($feed_type);
1112 
1113    $output .= "Last-Modified: " . ($maker->parse_feed_timestamp($feed_timestamp))->strftime('%a, %d %b %Y %H:%M:%S +0000') . "\n\n";
1114    $output .= $feed_output;
1115
1116    return $output if $return_output;
1117    print $output;
1118}
1119
1120sub display_about {
1121    my ($self, %args) = @_;
1122
1123    my $output;
1124
1125    if ($args{format} && $args{format} =~ /^rdf$/i) {
1126        $output = qq{Content-Type: application/rdf+xml
1127
1128<?xml version="1.0" encoding="UTF-8"?>
1129<rdf:RDF xmlns      = "http://usefulinc.com/ns/doap#"
1130         xmlns:rdf  = "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
1131         xmlns:foaf = "http://xmlns.com/foaf/0.1/">
1132<Project rdf:ID="OpenGuides">
1133  <name>OpenGuides</name>
1134
1135  <created>2003-04-29</created>
1136 
1137  <shortdesc xml:lang="en">
1138    A wiki engine for collaborative description of places with specialised
1139    geodata metadata features.
1140  </shortdesc>
1141
1142  <description xml:lang="en">
1143    OpenGuides is a collaborative wiki environment, written in Perl, for
1144    building guides and sharing information, as both human-readable text
1145    and RDF. The engine contains a number of geodata-specific metadata
1146    mechanisms such as locale search, node classification and integration
1147    with Google Maps.
1148  </description>
1149
1150  <homepage rdf:resource="http://openguides.org/" />
1151  <mailing-list rdf:resource="http://openguides.org/mm/listinfo/openguides-dev/" />
1152  <mailing-list rdf:resource="http://urchin.earth.li/mailman/listinfo/openguides-commits/" />
1153
1154  <maintainer>
1155    <foaf:Person rdf:ID="OpenGuidesMaintainer">
1156      <foaf:name>Dominic Hargreaves</foaf:name>
1157      <foaf:homepage rdf:resource="http://www.larted.org.uk/~dom/" />
1158    </foaf:Person>
1159  </maintainer>
1160
1161  <repository>
1162    <SVNRepository rdf:ID="OpenGuidesSVN">
1163      <location rdf:resource="https://urchin.earth.li/svn/openguides/" />
1164      <browse rdf:resource="http://dev.openguides.org/browser" />
1165    </SVNRepository>
1166  </repository>
1167
1168  <release>
1169    <Version rdf:ID="OpenGuidesVersion">
1170      <revision>$VERSION</revision>
1171    </Version>
1172  </release>
1173
1174  <download-page rdf:resource="http://search.cpan.org/dist/OpenGuides/" />
1175 
1176  <!-- Freshmeat category: Internet :: WWW/HTTP :: Dynamic Content -->
1177  <category rdf:resource="http://freshmeat.net/browse/92/" />
1178 
1179  <license rdf:resource="http://www.opensource.org/licenses/gpl-license.php" />
1180  <license rdf:resource="http://www.opensource.org/licenses/artistic-license.php" />
1181
1182</Project>
1183
1184</rdf:RDF>};
1185    }
1186    else {
1187        my $site_name  = $self->config->{site_name};
1188        my $script_name = $self->config->{script_name};
1189        $output = qq{Content-Type: text/html; charset=utf-8
1190
1191<html>
1192<head>
1193  <title>About $site_name</title>
1194<style type="text/css">
1195body        { margin: 0px; }
1196#content    { padding: 50px; margin: auto; width: 50%; }
1197h1          { margin-bottom: 0px; font-style: italic; }
1198h2          { margin-top: 0px; }
1199#logo       { text-align: center; }
1200#about      { margin: 0em 0em 1em 0em; border-top: 1px solid #ddd; border-bottom: 1px solid #ddd; }
1201#meta       { font-size: small; text-align: center;}
1202</style>
1203<link rel="alternate"
1204  type="application/rdf+xml"
1205  title="DOAP (Description Of A Project) profile for this site's software"
1206  href="$script_name?action=about;format=rdf" />
1207</head>
1208<body>
1209<div id="content">
1210<div id="logo">
1211<a href="http://openguides.org/"><img
1212src="http://openguides.org/img/logo.png" alt="OpenGuides"></a>
1213<h1><a href="$script_name">$site_name</a></h1>
1214<h2>is powered by <a href="http://openguides.org/">OpenGuides</a> -<br>
1215the guides made by you.</h2>
1216<h3>version <a href="http://search.cpan.org/~dom/OpenGuides-$VERSION">$VERSION</a></h3>
1217</div>
1218<div id="about">
1219<p>
1220<a href="http://www.w3.org/RDF/"><img
1221src="http://openguides.org/img/rdf_icon.png" width="44" height="48"
1222style="float: right; margin-left: 10px; border: 0px"></a> OpenGuides is a
1223web-based collaborative <a href="http://wiki.org/wiki.cgi?WhatIsWiki">wiki</a>
1224environment for building guides and sharing information, as both
1225human-readable text and <a href="http://www.w3.org/RDF/"><acronym
1226title="Resource Description Framework">RDF</acronym></a>. The engine contains
1227a number of geodata-specific metadata mechanisms such as locale search, node
1228classification and integration with <a href="http://maps.google.com/">Google
1229Maps</a>.
1230</p>
1231<p>
1232OpenGuides is written in <a href="http://www.perl.org/">Perl</a>, and is
1233made available under the same license as Perl itself (dual <a
1234href="http://dev.perl.org/licenses/artistic.html" title='The "Artistic Licence"'>Artistic</a> and <a
1235href="http://www.opensource.org/licenses/gpl-license.php"><acronym
1236title="GNU Public Licence">GPL</acronym></a>). Developer information for the
1237project is available from the <a href="http://dev.openguides.org/">OpenGuides
1238development site</a>.
1239</p>
1240<p>
1241Copyright &copy;2003-2007, <a href="http://openguides.org/">The OpenGuides
1242Project</a>. "OpenGuides", "[The] Open Guide To..." and "The guides made by
1243you" are trademarks of The OpenGuides Project. Any uses on this site are made
1244with permission.
1245</p>
1246</div>
1247<div id="meta">
1248<a href="$script_name?action=about;format=rdf"><acronym
1249title="Description Of A Project">DOAP</acronym> RDF version of this
1250information</a>
1251</div>
1252</div>
1253</body>
1254</html>};
1255    }
1256   
1257    return $output if $args{return_output};
1258    print $output;
1259}
1260
1261=item B<commit_node>
1262
1263  $guide->commit_node(
1264                         id      => $node,
1265                         cgi_obj => $q,
1266                     );
1267
1268As with other methods, parameters C<return_tt_vars> and
1269C<return_output> can be used to return these things instead of
1270printing the output to STDOUT.
1271
1272If you have specified the C<spam_detector_module> option in your
1273C<wiki.conf>, this method will attempt to call the <looks_like_spam>
1274method of that module to determine whether the edit is spam.  If this
1275method returns true, then the C<spam_detected.tt> template will be
1276used to display an error message.
1277
1278The C<looks_like_spam> method will be passed a datastructure containing
1279content and metadata.
1280
1281The geographical data that you should provide in the L<CGI> object
1282depends on the handler you chose in C<wiki.conf>.
1283
1284=over
1285
1286=item *
1287
1288B<British National Grid> - provide either C<os_x> and C<os_y> or
1289C<latitude> and C<longitude>; whichever set of data you give, it will
1290be converted to the other and both sets will be stored.
1291
1292=item *
1293
1294B<Irish National Grid> - provide either C<osie_x> and C<osie_y> or
1295C<latitude> and C<longitude>; whichever set of data you give, it will
1296be converted to the other and both sets will be stored.
1297
1298=item *
1299
1300B<UTM ellipsoid> - provide C<latitude> and C<longitude>; these will be
1301converted to easting and northing and both sets of data will be stored.
1302
1303=back
1304
1305=cut
1306
1307sub commit_node {
1308    my ($self, %args) = @_;
1309    my $node = $args{id};
1310    my $q = $args{cgi_obj};
1311    my $return_output = $args{return_output};
1312    my $wiki = $self->wiki;
1313    my $config = $self->config;
1314
1315    my $content  = $q->param("content");
1316    $content =~ s/\r\n/\n/gs;
1317    my $checksum = $q->param("checksum");
1318
1319    my %new_metadata = OpenGuides::Template->extract_metadata_vars(
1320        wiki    => $wiki,
1321        config  => $config,
1322        cgi_obj => $q
1323    );
1324
1325    delete $new_metadata{website} if $new_metadata{website} eq 'http://';
1326
1327    $new_metadata{opening_hours_text} = $q->param("hours_text") || "";
1328
1329    # Pick out the unmunged versions of lat/long if they're set.
1330    # (If they're not, it means they weren't munged in the first place.)
1331    $new_metadata{latitude} = delete $new_metadata{latitude_unmunged}
1332        if $new_metadata{latitude_unmunged};
1333    $new_metadata{longitude} = delete $new_metadata{longitude_unmunged}
1334        if $new_metadata{longitude_unmunged};
1335
1336    foreach my $var ( qw( summary username comment edit_type ) ) {
1337        $new_metadata{$var} = $q->param($var) || "";
1338    }
1339    $new_metadata{host} = $ENV{REMOTE_ADDR};
1340
1341    # Wiki::Toolkit::Plugin::RSS::ModWiki wants "major_change" to be set.
1342    $new_metadata{major_change} = ( $new_metadata{edit_type} eq "Normal edit" )
1343                                    ? 1
1344                                    : 0;
1345
1346    # If we can, check to see if this edit looks like spam.
1347    my $spam_detector = $config->spam_detector_module;
1348    my $is_spam;
1349    if ( $spam_detector ) {
1350        eval {
1351            eval "require $spam_detector";
1352            $is_spam = $spam_detector->looks_like_spam(
1353                node    => $node,
1354                content => $content,
1355                metadata => \%new_metadata,
1356            );
1357        };
1358    }
1359
1360    if ( $is_spam ) {
1361        my $output = OpenGuides::Template->output(
1362            wiki     => $self->wiki,
1363            config   => $config,
1364            template => "spam_detected.tt",
1365            vars     => {
1366                          not_editable => 1,
1367                        },
1368        );
1369        return $output if $return_output;
1370        print $output;
1371        return;
1372    }
1373
1374    # Check to make sure all the indexable nodes are created
1375    # Skip this for nodes needing moderation - this occurs for them once
1376    #  they've been moderated
1377    unless($wiki->node_required_moderation($node)) {
1378        $self->_autoCreateCategoryLocale(
1379                                          id       => $node,
1380                                          metadata => \%new_metadata
1381        );
1382    }
1383   
1384    my $written = $wiki->write_node( $node, $content, $checksum,
1385                                     \%new_metadata );
1386
1387    if ($written) {
1388        my $output = $self->redirect_to_node($node);
1389        return $output if $return_output;
1390        print $output;
1391    } else {
1392        return $self->_handle_edit_conflict(
1393                                             id            => $node,
1394                                             content       => $content,
1395                                             new_metadata  => \%new_metadata,
1396                                             return_output => $return_output,
1397                                           );
1398    }
1399}
1400
1401sub _handle_edit_conflict {
1402    my ($self, %args) = @_;
1403    my $return_output = $args{return_output} || 0;
1404    my $config = $self->config;
1405    my $wiki = $self->wiki;
1406    my $node = $args{id};
1407    my $content = $args{content};
1408    my %new_metadata = %{$args{new_metadata}};
1409
1410    my %node_data = $wiki->retrieve_node($node);
1411    my %tt_vars = ( checksum       => $node_data{checksum},
1412                    new_content    => $content,
1413                    content        => $node_data{content} );
1414    my %old_metadata = OpenGuides::Template->extract_metadata_vars(
1415                                           wiki     => $wiki,
1416                                           config   => $config,
1417                                           metadata => $node_data{metadata} );
1418    # Make sure we look at all variables.
1419    my @tmp = (keys %new_metadata, keys %old_metadata );
1420    my %tmp_hash = map { $_ => 1; } @tmp;
1421    my @all_vars = keys %tmp_hash;
1422
1423    foreach my $mdvar ( keys %new_metadata ) {
1424        if ($mdvar eq "locales") {
1425            $tt_vars{$mdvar} = $old_metadata{locales};
1426            $tt_vars{"new_$mdvar"} = $new_metadata{locale};
1427        } elsif ($mdvar eq "categories") {
1428            $tt_vars{$mdvar} = $old_metadata{categories};
1429            $tt_vars{"new_$mdvar"} = $new_metadata{category};
1430        } elsif ($mdvar eq "username" or $mdvar eq "comment"
1431                  or $mdvar eq "edit_type" ) {
1432            $tt_vars{$mdvar} = $new_metadata{$mdvar};
1433        } else {
1434            $tt_vars{$mdvar} = $old_metadata{$mdvar};
1435            $tt_vars{"new_$mdvar"} = $new_metadata{$mdvar};
1436        }
1437    }
1438
1439    $tt_vars{coord_field_1} = $old_metadata{coord_field_1};
1440    $tt_vars{coord_field_2} = $old_metadata{coord_field_2};
1441    $tt_vars{coord_field_1_value} = $old_metadata{coord_field_1_value};
1442    $tt_vars{coord_field_2_value} = $old_metadata{coord_field_2_value};
1443    $tt_vars{"new_coord_field_1_value"}
1444                                = $new_metadata{$old_metadata{coord_field_1}};
1445    $tt_vars{"new_coord_field_2_value"}
1446                                = $new_metadata{$old_metadata{coord_field_2}};
1447
1448    $tt_vars{conflict} = 1;
1449    return %tt_vars if $args{return_tt_vars};
1450    my $output = $self->process_template(
1451                                          id       => $node,
1452                                          template => "edit_form.tt",
1453                                          tt_vars  => \%tt_vars,
1454                                        );
1455    return $output if $args{return_output};
1456    print $output;
1457}
1458
1459=item B<_autoCreateCategoryLocale>
1460
1461  $guide->_autoCreateCategoryLocale(
1462                         id       => "FAQ",
1463                         metadata => \%metadata,
1464                     );
1465
1466When a new node is added, or a previously un-moderated node is moderated,
1467identifies if any of its Categories or Locales are missing, and creates them.
1468
1469Guide admins can control the text that gets put into the content field of the
1470autocreated node by putting it in custom_autocreate_content.tt in their custom
1471templates directory.  The following TT variables will be available to the
1472template:
1473
1474=over
1475
1476=item * index_type (e.g. C<Category>)
1477
1478=item * index_value (e.g. C<Vegan-friendly>)
1479
1480=item * node_name (e.g. C<Category Vegan-Friendly>)
1481
1482=back
1483
1484(Note capitalisation - index_value is what they typed in to the form, and
1485node_name is the fully free-upper-ed name of the autocreated node.)
1486
1487For nodes not requiring moderation, should be called on writing the node
1488For nodes requiring moderation, should only be called on moderation
1489
1490=cut
1491
1492sub _autoCreateCategoryLocale {
1493    my ($self, %args) = @_;
1494
1495    my $wiki = $self->wiki;
1496    my $id = $args{'id'};
1497    my %metadata = %{$args{'metadata'}};
1498
1499    # Check to make sure all the indexable nodes are created
1500    my $config = $self->config;
1501    my $template_path = $config->template_path;
1502    my $custom_template_path = $config->custom_template_path || "";
1503    my $tt = Template->new( { INCLUDE_PATH =>
1504                                  "$custom_template_path:$template_path" } );
1505
1506    foreach my $type (qw(Category Locale)) {
1507        my $lctype = lc($type);
1508        foreach my $index (@{$metadata{$lctype}}) {
1509            $index =~ s/(.*)/\u$1/;
1510            my $node = $type . " " . $index;
1511            # Uppercase the node name before checking for existence
1512            $node = $wiki->formatter->_do_freeupper( $node );
1513            unless ( $wiki->node_exists($node) ) {
1514                my $category = $type eq "Category" ? "Category" : "Locales";
1515                # Try to get the autocreated content from a custom template;
1516                # if we fail, use some default text.
1517                my $blurb;
1518                my %tt_vars = (
1519                                index_type  => $type,
1520                                index_value => $index,
1521                                node_name   => $node,
1522                              );
1523                my $ok = $tt->process( "custom_autocreate_content.tt",
1524                                       \%tt_vars, \$blurb );
1525                if ( !$ok ) {
1526                    $blurb = "\@INDEX_LINK [[$node]]";
1527                }
1528                $wiki->write_node(
1529                                     $node,
1530                                     $blurb,
1531                                     undef,
1532                                     {
1533                                         username => "Auto Create",
1534                                         comment  => "Auto created $lctype stub page",
1535                                         category => $category
1536                                     }
1537                );
1538            }
1539        }
1540    }
1541}
1542
1543
1544=item B<delete_node>
1545
1546  $guide->delete_node(
1547                         id       => "FAQ",
1548                         version  => 15,
1549                         password => "beer",
1550                     );
1551
1552C<version> is optional - if it isn't supplied then all versions of the
1553node will be deleted; in other words the node will be entirely
1554removed.
1555
1556If C<password> is not supplied then a form for entering the password
1557will be displayed.
1558
1559As with other methods, parameters C<return_tt_vars> and
1560C<return_output> can be used to return these things instead of
1561printing the output to STDOUT.
1562
1563=cut
1564
1565sub delete_node {
1566    my ($self, %args) = @_;
1567    my $node = $args{id} or croak "No node ID supplied for deletion";
1568    my $return_tt_vars = $args{return_tt_vars} || 0;
1569    my $return_output = $args{return_output} || 0;
1570
1571    my %tt_vars = (
1572                      not_editable  => 1,
1573                      not_deletable => 1,
1574                      deter_robots  => 1,
1575                  );
1576    $tt_vars{delete_version} = $args{version} || "";
1577
1578    my $password = $args{password};
1579
1580    if ($password) {
1581        if ($password ne $self->config->admin_pass) {
1582            return %tt_vars if $return_tt_vars;
1583            my $output = $self->process_template(
1584                                                    id       => $node,
1585                                                    template => "delete_password_wrong.tt",
1586                                                    tt_vars  => \%tt_vars,
1587                                                );
1588            return $output if $return_output;
1589            print $output;
1590        } else {
1591            $self->wiki->delete_node(
1592                                        name    => $node,
1593                                        version => $args{version},
1594                                    );
1595            # Check whether any versions of this node remain.
1596            my %check = $self->wiki->retrieve_node( name => $node );
1597            $tt_vars{other_versions_remain} = 1 if $check{version};
1598            return %tt_vars if $return_tt_vars;
1599            my $output = $self->process_template(
1600                                                    id       => $node,
1601                                                    template => "delete_done.tt",
1602                                                    tt_vars  => \%tt_vars,
1603                                                );
1604            return $output if $return_output;
1605            print $output;
1606        }
1607    } else {
1608        return %tt_vars if $return_tt_vars;
1609        my $output = $self->process_template(
1610                                                id       => $node,
1611                                                template => "delete_confirm.tt",
1612                                                tt_vars  => \%tt_vars,
1613                                            );
1614        return $output if $return_output;
1615        print $output;
1616    }
1617}
1618
1619=item B<set_node_moderation>
1620
1621  $guide->set_node_moderation(
1622                         id       => "FAQ",
1623                         password => "beer",
1624                         moderation_flag => 1,
1625                     );
1626
1627Sets the moderation needed flag on a node, either on or off.
1628
1629If C<password> is not supplied then a form for entering the password
1630will be displayed.
1631
1632=cut
1633
1634sub set_node_moderation {
1635    my ($self, %args) = @_;
1636    my $node = $args{id} or croak "No node ID supplied for node moderation";
1637    my $return_tt_vars = $args{return_tt_vars} || 0;
1638    my $return_output = $args{return_output} || 0;
1639
1640    # Get the moderation flag into something sane
1641    if($args{moderation_flag} eq "1" || $args{moderation_flag} eq "yes" ||
1642       $args{moderation_flag} eq "on" || $args{moderation_flag} eq "true") {
1643        $args{moderation_flag} = 1;
1644    } else {
1645        $args{moderation_flag} = 0;
1646    }
1647
1648    # Set up the TT variables
1649    my %tt_vars = (
1650                      not_editable  => 1,
1651                      not_deletable => 1,
1652                      deter_robots  => 1,
1653                      moderation_action => 'set_moderation',
1654                      moderation_flag   => $args{moderation_flag},
1655                      moderation_url_args => 'action=set_moderation;moderation_flag='.$args{moderation_flag},
1656                  );
1657
1658    my $password = $args{password};
1659
1660    if ($password) {
1661        if ($password ne $self->config->admin_pass) {
1662            return %tt_vars if $return_tt_vars;
1663            my $output = $self->process_template(
1664                                                    id       => $node,
1665                                                    template => "moderate_password_wrong.tt",
1666                                                    tt_vars  => \%tt_vars,
1667                                                );
1668            return $output if $return_output;
1669            print $output;
1670        } else {
1671            my $worked = $self->wiki->set_node_moderation(
1672                                        name    => $node,
1673                                        required => $args{moderation_flag},
1674                         );
1675            my $moderation_flag = "changed";
1676            unless($worked) {
1677                $moderation_flag = "unknown_node";
1678                warn("Tried to set moderation status on node '$node', which doesn't exist");
1679            }
1680
1681            # Send back to the admin interface
1682            my $script_url = $self->config->script_url;
1683            my $script_name = $self->config->script_name;
1684            my $q = CGI->new;
1685            my $output = $q->redirect( $script_url.$script_name."?action=admin;moderation=".$moderation_flag );
1686            return $output if $return_output;
1687            print $output;
1688        }
1689    } else {
1690        return %tt_vars if $return_tt_vars;
1691        my $output = $self->process_template(
1692                                                id       => $node,
1693                                                template => "moderate_confirm.tt",
1694                                                tt_vars  => \%tt_vars,
1695                                            );
1696        return $output if $return_output;
1697        print $output;
1698    }
1699}
1700
1701=item B<moderate_node>
1702
1703  $guide->moderate_node(
1704                         id       => "FAQ",
1705                         version  => 12,
1706                         password => "beer",
1707                     );
1708
1709Marks a version of a node as moderated. Will also auto-create and Locales
1710and Categories for the newly moderated version.
1711
1712If C<password> is not supplied then a form for entering the password
1713will be displayed.
1714
1715=cut
1716
1717sub moderate_node {
1718    my ($self, %args) = @_;
1719    my $node = $args{id} or croak "No node ID supplied for node moderation";
1720    my $version = $args{version} or croak "No node version supplied for node moderation";
1721    my $return_tt_vars = $args{return_tt_vars} || 0;
1722    my $return_output = $args{return_output} || 0;
1723
1724    # Set up the TT variables
1725    my %tt_vars = (
1726                      not_editable  => 1,
1727                      not_deletable => 1,
1728                      deter_robots  => 1,
1729                      version       => $version,
1730                      moderation_action => 'moderate',
1731                      moderation_url_args => 'action=moderate;version='.$version
1732                  );
1733
1734    my $password = $args{password};
1735    unless($self->config->moderation_requires_password) {
1736        $password = $self->config->admin_pass;
1737    }
1738
1739    if ($password) {
1740        if ($password ne $self->config->admin_pass) {
1741            return %tt_vars if $return_tt_vars;
1742            my $output = $self->process_template(
1743                                                    id       => $node,
1744                                                    template => "moderate_password_wrong.tt",
1745                                                    tt_vars  => \%tt_vars,
1746                                                );
1747            return $output if $return_output;
1748            print $output;
1749        } else {
1750            $self->wiki->moderate_node(
1751                                        name    => $node,
1752                                        version => $version
1753                                    );
1754
1755            # Create any categories or locales for it
1756            my %details = $self->wiki->retrieve_node(
1757                                        name    => $node,
1758                                        version => $version
1759                                    );
1760            $self->_autoCreateCategoryLocale(
1761                                          id       => $node,
1762                                          metadata => $details{'metadata'}
1763            );
1764
1765            # Send back to the admin interface
1766            my $script_url = $self->config->script_url;
1767            my $script_name = $self->config->script_name;
1768            my $q = CGI->new;
1769            my $output = $q->redirect( $script_url.$script_name."?action=admin;moderation=moderated" );
1770            return $output if $return_output;
1771            print $output;
1772        }
1773    } else {
1774        return %tt_vars if $return_tt_vars;
1775        my $output = $self->process_template(
1776                                                id       => $node,
1777                                                template => "moderate_confirm.tt",
1778                                                tt_vars  => \%tt_vars,
1779                                            );
1780        return $output if $return_output;
1781        print $output;
1782    }
1783}
1784
1785=item B<show_missing_metadata>
1786
1787Search for nodes which don't have a certain kind of metadata. Optionally
1788also excludes Locales and Categories
1789
1790=cut
1791
1792sub show_missing_metadata {
1793    my ($self, %args) = @_;
1794    my $return_tt_vars = $args{return_tt_vars} || 0;
1795    my $return_output = $args{return_output} || 0;
1796
1797    my $wiki = $self->wiki;
1798    my $formatter = $self->wiki->formatter;
1799    my $script_name = $self->config->script_name;
1800
1801    my ($metadata_type, $metadata_value, $exclude_locales, $exclude_categories)
1802        = @args{ qw( metadata_type metadata_value exclude_locales exclude_categories ) };
1803
1804    my @nodes;
1805    my $done_search = 0;
1806
1807    # Only search if they supplied at least a metadata type
1808    if($metadata_type) {
1809        $done_search = 1;
1810        @nodes = $wiki->list_nodes_by_missing_metadata(
1811                            metadata_type => $metadata_type,
1812                            metadata_value => $metadata_value,
1813                            ignore_case    => 1,
1814        );
1815
1816        # Do we need to filter some nodes out?
1817        if($exclude_locales || $exclude_categories) {
1818            my @all_nodes = @nodes;
1819            @nodes = ();
1820
1821            foreach my $node (@all_nodes) {
1822                if($exclude_locales && $node =~ /^Locale /) { next; }
1823                if($exclude_categories && $node =~ /^Category /) { next; }
1824                push @nodes, $node;
1825            }
1826        }
1827    }
1828
1829    # Build nice edit etc links for our nodes
1830    my @tt_nodes;
1831    for my $node (@nodes) {
1832        my %n;
1833
1834        # Make the URLs
1835        my $node_param = uri_escape( $formatter->node_name_to_node_param( $node ) );
1836
1837        # Save into the hash
1838        $n{'name'} = $node;
1839        $n{'view_url'} = $script_name . "?id=" . $node_param;
1840        $n{'edit_url'} = $script_name . "?id=" . $node_param . ";action=edit";
1841        push @tt_nodes, \%n;
1842    }
1843
1844    # Set up our TT variables, including the search parameters
1845    my %tt_vars = (
1846                      not_editable  => 1,
1847                      not_deletable => 1,
1848                      deter_robots  => 1,
1849
1850                      nodes => \@tt_nodes,
1851                      done_search    => $done_search,
1852                      metadata_type  => $metadata_type,
1853                      metadata_value => $metadata_value,
1854                      exclude_locales => $exclude_locales,
1855                      exclude_categories => $exclude_categories,
1856
1857                      script_name => $script_name
1858                  );
1859    return %tt_vars if $return_tt_vars;
1860
1861    # Render to the page
1862    my $output = $self->process_template(
1863                                           id       => "",
1864                                           template => "missing_metadata.tt",
1865                                           tt_vars  => \%tt_vars,
1866                                        );
1867    return $output if $return_output;
1868    print $output;
1869}
1870
1871=item B<revert_user_interface>
1872
1873If C<password> is not supplied then a form for entering the password
1874will be displayed, along with a list of all the edits the user made.
1875
1876If the password is given, will delete all of these versions.
1877=cut
1878sub revert_user_interface {
1879    my ($self, %args) = @_;
1880
1881    my $password = $args{password} || '';
1882    my $return_tt_vars = $args{return_tt_vars} || 0;
1883    my $return_output = $args{return_output} || 0;
1884
1885    my $wiki = $self->wiki;
1886    my $formatter = $self->wiki->formatter;
1887    my $script_name = $self->config->script_name;
1888
1889    my ($type,$value);
1890    if($args{'username'}) {
1891        ($type,$value) = ('username', $args{'username'});
1892    }
1893    if($args{'host'}) {
1894        ($type,$value) = ('host', $args{'host'});
1895    }
1896    unless($type && $value) {
1897        croak("One of username or host must be given");
1898    }
1899
1900    # Grab everything they've touched, ever
1901    my @user_edits = $self->wiki->list_recent_changes(
1902                            since => 1,
1903                            metadata_was => { $type => $value },
1904    );
1905
1906    if ($password) {
1907        if ($password ne $self->config->admin_pass) {
1908            croak("Bad password supplied");
1909        } else {
1910            # Delete all these versions
1911            foreach my $edit (@user_edits) {
1912                $self->wiki->delete_node(
1913                                name => $edit->{name},
1914                                version => $edit->{version},
1915                );
1916            }
1917
1918            # Grab new list
1919            @user_edits = $self->wiki->list_recent_changes(
1920                            since => 1,
1921                            metadata_was => { $type => $value },
1922            );
1923        }
1924    } else {
1925        # Don't do anything
1926    }
1927
1928    # Set up our TT variables, including the search parameters
1929    my %tt_vars = (
1930                      not_editable  => 1,
1931                      not_deletable => 1,
1932                      deter_robots  => 1,
1933
1934                      edits          => \@user_edits,
1935                      username       => $args{username},
1936                      host           => $args{host},
1937                      by_type        => $type,
1938                      by             => $value,
1939
1940                      script_name => $script_name
1941                  );
1942    return %tt_vars if $return_tt_vars;
1943
1944    # Render to the page
1945    my $output = $self->process_template(
1946                                           id       => "",
1947                                           template => "admin_revert_user.tt",
1948                                           tt_vars  => \%tt_vars,
1949                                        );
1950    return $output if $return_output;
1951    print $output;
1952}
1953
1954=item B<display_admin_interface>
1955
1956Fetch everything we need to display the admin interface, and passes it off
1957 to the template
1958
1959=cut
1960
1961sub display_admin_interface {
1962    my ($self, %args) = @_;
1963    my $return_tt_vars = $args{return_tt_vars} || 0;
1964    my $return_output = $args{return_output} || 0;
1965
1966    my $wiki = $self->wiki;
1967    my $formatter = $self->wiki->formatter;
1968    my $script_name = $self->config->script_name;
1969
1970    # Grab all the recent nodes
1971    my @all_nodes = $wiki->list_recent_changes(last_n_changes => 100);
1972
1973    # Split into nodes, Locales and Categories
1974    my @nodes;
1975    my @categories;
1976    my @locales;
1977    for my $node (@all_nodes) {
1978        # Add moderation status
1979        $node->{'moderate'} = $wiki->node_required_moderation($node->{'name'});
1980
1981        # Make the URLs
1982        my $node_param = uri_escape( $formatter->node_name_to_node_param( $node->{'name'} ) );
1983        $node->{'view_url'} = $script_name . "?id=" . $node_param;
1984        $node->{'versions_url'} = $script_name .
1985                        "?action=list_all_versions;id=" . $node_param;
1986        $node->{'moderation_url'} = $script_name .
1987                        "?action=set_moderation;id=" . $node_param;
1988        $node->{'revert_user_url'} = $script_name . "?action=revert_user" .
1989                        ";username=".$node->{metadata}->{username}->[0];
1990
1991        # Filter
1992        if($node->{'name'} =~ /^Category /) {
1993            $node->{'page_name'} = $node->{'name'};
1994            $node->{'name'} =~ s/^Category //;
1995            push @categories, $node;
1996        } elsif($node->{'name'} =~ /^Locale /) {
1997            $node->{'page_name'} = $node->{'name'};
1998            $node->{'name'} =~ s/^Locale //;
1999            push @locales, $node;
2000        } else {
2001            push @nodes, $node;
2002        }
2003    }
2004
2005    # Handle completed notice for actions
2006    my $completed_action = "";
2007    if($args{moderation_completed}) {
2008        if($args{moderation_completed} eq "moderation") {
2009            $completed_action = "Version moderated";
2010        }
2011        if($args{moderation_completed} eq "changed") {
2012            $completed_action = "Node moderation flag changed";
2013        }
2014        if($args{moderation_completed} eq "unknown_node") {
2015            $completed_action = "Node moderation flag not changed, node not known";
2016        }
2017    }
2018
2019    # Render in a template
2020    my %tt_vars = (
2021                      not_editable  => 1,
2022                      not_deletable => 1,
2023                      deter_robots  => 1,
2024                      nodes      => \@nodes,
2025                      categories => \@categories,
2026                      locales    => \@locales,
2027                      completed_action => $completed_action
2028                  );
2029    return %tt_vars if $return_tt_vars;
2030    my $output = $self->process_template(
2031                                           id       => "",
2032                                           template => "admin_home.tt",
2033                                           tt_vars  => \%tt_vars,
2034                                        );
2035    return $output if $return_output;
2036    print $output;
2037}
2038
2039sub process_template {
2040    my ($self, %args) = @_;
2041    my %output_conf = (
2042                          wiki     => $self->wiki,
2043                          config   => $self->config,
2044                          node     => $args{id},
2045                          template => $args{template},
2046                          vars     => $args{tt_vars},
2047                          cookies  => $args{cookies},
2048                      );
2049    if ( $args{content_type} ) {
2050        $output_conf{content_type} = $args{content_type};
2051    }
2052    return OpenGuides::Template->output( %output_conf );
2053}
2054
2055sub redirect_to_node {
2056    my ($self, $node, $redirected_from) = @_;
2057   
2058    my $script_url = $self->config->script_url;
2059    my $script_name = $self->config->script_name;
2060    my $formatter = $self->wiki->formatter;
2061
2062    my $id = $formatter->node_name_to_node_param( $node );
2063    my $oldid;
2064    $oldid = $formatter->node_name_to_node_param( $redirected_from ) if $redirected_from;
2065
2066    my $redir_param = "$script_url$script_name?";
2067    $redir_param .= 'id=' if $oldid;
2068    $redir_param .= $id;
2069    $redir_param .= ";oldid=$oldid" if $oldid;
2070   
2071    my $q = CGI->new;
2072    return $q->redirect( $redir_param );
2073}
2074
2075sub get_cookie {
2076    my $self = shift;
2077    my $config = $self->config;
2078    my $pref_name = shift or return "";
2079    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
2080    return $cookie_data{$pref_name};
2081}
2082
2083
2084=head1 BUGS AND CAVEATS
2085
2086UTF8 data are currently not handled correctly throughout.
2087
2088Other bugs are documented at
2089L<http://dev.openguides.org/>
2090
2091=head1 SEE ALSO
2092
2093=over 4
2094
2095=item * L<http://london.openguides.org/|The Open Guide to London>, the first and biggest OpenGuides site.
2096
2097=item * L<http://openguides.org/|The OpenGuides website>, with a list of all live OpenGuides installs.
2098
2099=item * L<Wiki::Toolkit>, the Wiki toolkit which does the heavy lifting for OpenGuides
2100
2101=back
2102
2103=head1 FEEDBACK
2104
2105If you have a question, a bug report, or a patch, or you're interested
2106in joining the development team, please contact openguides-dev@lists.openguides.org
2107(moderated mailing list, will reach all current developers but you'll have
2108to wait for your post to be approved) or file a bug report at
2109L<http://dev.openguides.org/>
2110
2111=head1 AUTHOR
2112
2113The OpenGuides Project (openguides-dev@lists.openguides.org)
2114
2115=head1 COPYRIGHT
2116
2117     Copyright (C) 2003-2007 The OpenGuides Project.  All Rights Reserved.
2118
2119The OpenGuides distribution is free software; you can redistribute it
2120and/or modify it under the same terms as Perl itself.
2121
2122=head1 CREDITS
2123
2124Programming by Dominic Hargreaves, Earle Martin, Kake Pugh, and Ivor
2125Williams.  Testing and bug reporting by Billy Abbott, Jody Belka,
2126Kerry Bosworth, Simon Cozens, Cal Henderson, Steve Jolly, and Bob
2127Walker (among others).  Much of the Module::Build stuff copied from
2128the Siesta project L<http://siesta.unixbeard.net/>
2129
2130=cut
2131
21321;
Note: See TracBrowser for help on using the repository browser.