source: trunk/lib/OpenGuides.pm @ 1270

Last change on this file since 1270 was 1270, checked in by Dominic Hargreaves, 13 years ago

less hacky determination of empty node

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