source: trunk/lib/OpenGuides.pm @ 1228

Last change on this file since 1228 was 1228, checked in by nick, 13 years ago

Finish off the metadata discovery things

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