source: trunk/lib/OpenGuides.pm @ 1240

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

Add the ability to whitelist hosts who can change moderated nodes
without explicit moderation - thanks Oliver (fixes #203)

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 82.8 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    my $in_moderate_whitelist
1560        = OpenGuides::Utils->in_moderate_whitelist($self->config, $new_metadata{host});
1561
1562    if ( $in_moderate_whitelist or not $needs_moderation ) {
1563        $self->_autoCreateCategoryLocale(
1564                                          id       => $node,
1565                                          metadata => \%new_metadata
1566        );
1567    }
1568   
1569    my $written = $wiki->write_node( $node, $content, $checksum,
1570                                     \%new_metadata );
1571
1572    if ($written) {
1573        if ( $needs_moderation ) {
1574            if ( $in_moderate_whitelist ) {
1575                $self->wiki->moderate_node(
1576                                            name    => $node,
1577                                            version => $written
1578                );
1579            }
1580            elsif ( $config->send_moderation_notifications ) {
1581                my $body = "The node '$node' in the OpenGuides installation\n" .
1582                    "'" . $config->site_name . "' requires moderation. ".
1583                    "Please visit\n" .
1584                    $config->script_url . $config->script_name .
1585                    "?action=show_needing_moderation\nat your convenience.\n";
1586                eval {
1587                    OpenGuides::Utils->send_email(
1588                        config        => $config,
1589                        subject       => "Node requires moderation",
1590                        body          => $body,
1591                        admin         => 1,
1592                        return_output => $return_output
1593                    );
1594                };
1595                warn $@ if $@;
1596            }
1597        }
1598
1599        my $output = $self->redirect_to_node($node);
1600        return $output if $return_output;
1601        print $output;
1602    } else {
1603        return $self->_handle_edit_conflict(
1604                                             id            => $node,
1605                                             content       => $content,
1606                                             new_metadata  => \%new_metadata,
1607                                             return_output => $return_output,
1608                                           );
1609    }
1610}
1611
1612sub _handle_edit_conflict {
1613    my ($self, %args) = @_;
1614    my $return_output = $args{return_output} || 0;
1615    my $config = $self->config;
1616    my $wiki = $self->wiki;
1617    my $node = $args{id};
1618    my $content = $args{content};
1619    my %new_metadata = %{$args{new_metadata}};
1620
1621    my %node_data = $wiki->retrieve_node($node);
1622    my %tt_vars = ( checksum       => $node_data{checksum},
1623                    new_content    => $content,
1624                    content        => $node_data{content} );
1625    my %old_metadata = OpenGuides::Template->extract_metadata_vars(
1626                                           wiki     => $wiki,
1627                                           config   => $config,
1628                                           metadata => $node_data{metadata} );
1629    # Make sure we look at all variables.
1630    my @tmp = (keys %new_metadata, keys %old_metadata );
1631    my %tmp_hash = map { $_ => 1; } @tmp;
1632    my @all_vars = keys %tmp_hash;
1633
1634    foreach my $mdvar ( keys %new_metadata ) {
1635        if ($mdvar eq "locales") {
1636            $tt_vars{$mdvar} = $old_metadata{locales};
1637            $tt_vars{"new_$mdvar"} = $new_metadata{locale};
1638        } elsif ($mdvar eq "categories") {
1639            $tt_vars{$mdvar} = $old_metadata{categories};
1640            $tt_vars{"new_$mdvar"} = $new_metadata{category};
1641        } elsif ($mdvar eq "username" or $mdvar eq "comment"
1642                  or $mdvar eq "edit_type" ) {
1643            $tt_vars{$mdvar} = $new_metadata{$mdvar};
1644        } else {
1645            $tt_vars{$mdvar} = $old_metadata{$mdvar};
1646            $tt_vars{"new_$mdvar"} = $new_metadata{$mdvar};
1647        }
1648    }
1649
1650    $tt_vars{coord_field_1} = $old_metadata{coord_field_1};
1651    $tt_vars{coord_field_2} = $old_metadata{coord_field_2};
1652    $tt_vars{coord_field_1_value} = $old_metadata{coord_field_1_value};
1653    $tt_vars{coord_field_2_value} = $old_metadata{coord_field_2_value};
1654    $tt_vars{"new_coord_field_1_value"}
1655                                = $new_metadata{$old_metadata{coord_field_1}};
1656    $tt_vars{"new_coord_field_2_value"}
1657                                = $new_metadata{$old_metadata{coord_field_2}};
1658
1659    $tt_vars{conflict} = 1;
1660    return %tt_vars if $args{return_tt_vars};
1661    my $output = $self->process_template(
1662                                          id       => $node,
1663                                          template => "edit_form.tt",
1664                                          tt_vars  => \%tt_vars,
1665                                        );
1666    return $output if $args{return_output};
1667    print $output;
1668}
1669
1670=item B<_autoCreateCategoryLocale>
1671
1672  $guide->_autoCreateCategoryLocale(
1673                         id       => "FAQ",
1674                         metadata => \%metadata,
1675                     );
1676
1677When a new node is added, or a previously un-moderated node is moderated,
1678identifies if any of its Categories or Locales are missing, and creates them.
1679
1680Guide admins can control the text that gets put into the content field of the
1681autocreated node by putting it in custom_autocreate_content.tt in their custom
1682templates directory.  The following TT variables will be available to the
1683template:
1684
1685=over
1686
1687=item * index_type (e.g. C<Category>)
1688
1689=item * index_value (e.g. C<Vegan-friendly>)
1690
1691=item * node_name (e.g. C<Category Vegan-Friendly>)
1692
1693=back
1694
1695(Note capitalisation - index_value is what they typed in to the form, and
1696node_name is the fully free-upper-ed name of the autocreated node.)
1697
1698For nodes not requiring moderation, should be called on writing the node
1699For nodes requiring moderation, should only be called on moderation
1700
1701=cut
1702
1703sub _autoCreateCategoryLocale {
1704    my ($self, %args) = @_;
1705
1706    my $wiki = $self->wiki;
1707    my $id = $args{'id'};
1708    my %metadata = %{$args{'metadata'}};
1709
1710    # Check to make sure all the indexable nodes are created
1711    my $config = $self->config;
1712    my $template_path = $config->template_path;
1713    my $custom_template_path = $config->custom_template_path || "";
1714    my $tt = Template->new( { INCLUDE_PATH =>
1715                                  "$custom_template_path:$template_path" } );
1716
1717    foreach my $type (qw(Category Locale)) {
1718        my $lctype = lc($type);
1719        foreach my $index (@{$metadata{$lctype}}) {
1720            $index =~ s/(.*)/\u$1/;
1721            my $node = $type . " " . $index;
1722            # Uppercase the node name before checking for existence
1723            $node = $wiki->formatter->_do_freeupper( $node );
1724            unless ( $wiki->node_exists($node) ) {
1725                my $category = $type eq "Category" ? "Category" : "Locales";
1726                # Try to get the autocreated content from a custom template;
1727                # if we fail, use some default text.
1728                my $blurb;
1729                my %tt_vars = (
1730                                index_type  => $type,
1731                                index_value => $index,
1732                                node_name   => $node,
1733                              );
1734                my $ok = $tt->process( "custom_autocreate_content.tt",
1735                                       \%tt_vars, \$blurb );
1736                if ( !$ok ) {
1737                    $blurb = "\@INDEX_LINK [[$node]]";
1738                }
1739                $wiki->write_node(
1740                                     $node,
1741                                     $blurb,
1742                                     undef,
1743                                     {
1744                                         username => "Auto Create",
1745                                         comment  => "Auto created $lctype stub page",
1746                                         category => $category
1747                                     }
1748                );
1749            }
1750        }
1751    }
1752}
1753
1754
1755=item B<delete_node>
1756
1757  $guide->delete_node(
1758                         id       => "FAQ",
1759                         version  => 15,
1760                         password => "beer",
1761                     );
1762
1763C<version> is optional - if it isn't supplied then all versions of the
1764node will be deleted; in other words the node will be entirely
1765removed.
1766
1767If C<password> is not supplied then a form for entering the password
1768will be displayed.
1769
1770As with other methods, parameters C<return_tt_vars> and
1771C<return_output> can be used to return these things instead of
1772printing the output to STDOUT.
1773
1774=cut
1775
1776sub delete_node {
1777    my ($self, %args) = @_;
1778    my $node = $args{id} or croak "No node ID supplied for deletion";
1779    my $return_tt_vars = $args{return_tt_vars} || 0;
1780    my $return_output = $args{return_output} || 0;
1781
1782    my %tt_vars = (
1783                      not_editable  => 1,
1784                      not_deletable => 1,
1785                      deter_robots  => 1,
1786                  );
1787    $tt_vars{delete_version} = $args{version} || "";
1788
1789    my $password = $args{password};
1790
1791    if ($password) {
1792        if ($password ne $self->config->admin_pass) {
1793            return %tt_vars if $return_tt_vars;
1794            my $output = $self->process_template(
1795                                                    id       => $node,
1796                                                    template => "delete_password_wrong.tt",
1797                                                    tt_vars  => \%tt_vars,
1798                                                );
1799            return $output if $return_output;
1800            print $output;
1801        } else {
1802            $self->wiki->delete_node(
1803                                        name    => $node,
1804                                        version => $args{version},
1805                                    );
1806            # Check whether any versions of this node remain.
1807            my %check = $self->wiki->retrieve_node( name => $node );
1808            $tt_vars{other_versions_remain} = 1 if $check{version};
1809            return %tt_vars if $return_tt_vars;
1810            my $output = $self->process_template(
1811                                                    id       => $node,
1812                                                    template => "delete_done.tt",
1813                                                    tt_vars  => \%tt_vars,
1814                                                );
1815            return $output if $return_output;
1816            print $output;
1817        }
1818    } else {
1819        return %tt_vars if $return_tt_vars;
1820        my $output = $self->process_template(
1821                                                id       => $node,
1822                                                template => "delete_confirm.tt",
1823                                                tt_vars  => \%tt_vars,
1824                                            );
1825        return $output if $return_output;
1826        print $output;
1827    }
1828}
1829
1830=item B<set_node_moderation>
1831
1832  $guide->set_node_moderation(
1833                         id       => "FAQ",
1834                         password => "beer",
1835                         moderation_flag => 1,
1836                     );
1837
1838Sets the moderation needed flag on a node, either on or off.
1839
1840If C<password> is not supplied then a form for entering the password
1841will be displayed.
1842
1843=cut
1844
1845sub set_node_moderation {
1846    my ($self, %args) = @_;
1847    my $node = $args{id} or croak "No node ID supplied for node moderation";
1848    my $return_tt_vars = $args{return_tt_vars} || 0;
1849    my $return_output = $args{return_output} || 0;
1850
1851    # Get the moderation flag into something sane
1852    if($args{moderation_flag} eq "1" || $args{moderation_flag} eq "yes" ||
1853       $args{moderation_flag} eq "on" || $args{moderation_flag} eq "true") {
1854        $args{moderation_flag} = 1;
1855    } else {
1856        $args{moderation_flag} = 0;
1857    }
1858
1859    # Set up the TT variables
1860    my %tt_vars = (
1861                      not_editable  => 1,
1862                      not_deletable => 1,
1863                      deter_robots  => 1,
1864                      moderation_action => 'set_moderation',
1865                      moderation_flag   => $args{moderation_flag},
1866                      moderation_url_args => 'action=set_moderation;moderation_flag='.$args{moderation_flag},
1867                  );
1868
1869    my $password = $args{password};
1870
1871    if ($password) {
1872        if ($password ne $self->config->admin_pass) {
1873            return %tt_vars if $return_tt_vars;
1874            my $output = $self->process_template(
1875                                                    id       => $node,
1876                                                    template => "moderate_password_wrong.tt",
1877                                                    tt_vars  => \%tt_vars,
1878                                                );
1879            return $output if $return_output;
1880            print $output;
1881        } else {
1882            my $worked = $self->wiki->set_node_moderation(
1883                                        name    => $node,
1884                                        required => $args{moderation_flag},
1885                         );
1886            my $moderation_flag = "changed";
1887            unless($worked) {
1888                $moderation_flag = "unknown_node";
1889                warn("Tried to set moderation status on node '$node', which doesn't exist");
1890            }
1891
1892            # Send back to the admin interface
1893            my $script_url = $self->config->script_url;
1894            my $script_name = $self->config->script_name;
1895            my $q = CGI->new;
1896            my $output = $q->redirect( $script_url.$script_name."?action=admin;moderation=".$moderation_flag );
1897            return $output if $return_output;
1898            print $output;
1899        }
1900    } else {
1901        return %tt_vars if $return_tt_vars;
1902        my $output = $self->process_template(
1903                                                id       => $node,
1904                                                template => "moderate_confirm.tt",
1905                                                tt_vars  => \%tt_vars,
1906                                            );
1907        return $output if $return_output;
1908        print $output;
1909    }
1910}
1911
1912=item B<moderate_node>
1913
1914  $guide->moderate_node(
1915                         id       => "FAQ",
1916                         version  => 12,
1917                         password => "beer",
1918                     );
1919
1920Marks a version of a node as moderated. Will also auto-create and Locales
1921and Categories for the newly moderated version.
1922
1923If C<password> is not supplied then a form for entering the password
1924will be displayed.
1925
1926=cut
1927
1928sub moderate_node {
1929    my ($self, %args) = @_;
1930    my $node = $args{id} or croak "No node ID supplied for node moderation";
1931    my $version = $args{version} or croak "No node version supplied for node moderation";
1932    my $return_tt_vars = $args{return_tt_vars} || 0;
1933    my $return_output = $args{return_output} || 0;
1934
1935    # Set up the TT variables
1936    my %tt_vars = (
1937                      not_editable  => 1,
1938                      not_deletable => 1,
1939                      deter_robots  => 1,
1940                      version       => $version,
1941                      moderation_action => 'moderate',
1942                      moderation_url_args => 'action=moderate;version='.$version
1943                  );
1944
1945    my $password = $args{password};
1946    unless($self->config->moderation_requires_password) {
1947        $password = $self->config->admin_pass;
1948    }
1949
1950    if ($password) {
1951        if ($password ne $self->config->admin_pass) {
1952            return %tt_vars if $return_tt_vars;
1953            my $output = $self->process_template(
1954                                                    id       => $node,
1955                                                    template => "moderate_password_wrong.tt",
1956                                                    tt_vars  => \%tt_vars,
1957                                                );
1958            return $output if $return_output;
1959            print $output;
1960        } else {
1961            $self->wiki->moderate_node(
1962                                        name    => $node,
1963                                        version => $version
1964                                    );
1965
1966            # Create any categories or locales for it
1967            my %details = $self->wiki->retrieve_node(
1968                                        name    => $node,
1969                                        version => $version
1970                                    );
1971            $self->_autoCreateCategoryLocale(
1972                                          id       => $node,
1973                                          metadata => $details{'metadata'}
1974            );
1975
1976            # Send back to the admin interface
1977            my $script_url = $self->config->script_url;
1978            my $script_name = $self->config->script_name;
1979            my $q = CGI->new;
1980            my $output = $q->redirect( $script_url.$script_name."?action=admin;moderation=moderated" );
1981            return $output if $return_output;
1982            print $output;
1983        }
1984    } else {
1985        return %tt_vars if $return_tt_vars;
1986        my $output = $self->process_template(
1987                                                id       => $node,
1988                                                template => "moderate_confirm.tt",
1989                                                tt_vars  => \%tt_vars,
1990                                            );
1991        return $output if $return_output;
1992        print $output;
1993    }
1994}
1995
1996=item B<show_missing_metadata>
1997
1998Search for nodes which don't have a certain kind of metadata. Optionally
1999also excludes Locales and Categories
2000
2001=cut
2002
2003sub show_missing_metadata {
2004    my ($self, %args) = @_;
2005    my $return_tt_vars = $args{return_tt_vars} || 0;
2006    my $return_output = $args{return_output} || 0;
2007
2008    my $wiki = $self->wiki;
2009    my $formatter = $self->wiki->formatter;
2010    my $script_name = $self->config->script_name;
2011
2012    my ($metadata_type, $metadata_value, $exclude_locales, $exclude_categories)
2013        = @args{ qw( metadata_type metadata_value exclude_locales exclude_categories ) };
2014
2015    my @nodes;
2016    my $done_search = 0;
2017
2018    # Only search if they supplied at least a metadata type
2019    if($metadata_type) {
2020        $done_search = 1;
2021        @nodes = $wiki->list_nodes_by_missing_metadata(
2022                            metadata_type => $metadata_type,
2023                            metadata_value => $metadata_value,
2024                            ignore_case    => 1,
2025        );
2026
2027        # Do we need to filter some nodes out?
2028        if($exclude_locales || $exclude_categories) {
2029            my @all_nodes = @nodes;
2030            @nodes = ();
2031
2032            foreach my $node (@all_nodes) {
2033                if($exclude_locales && $node =~ /^Locale /) { next; }
2034                if($exclude_categories && $node =~ /^Category /) { next; }
2035                push @nodes, $node;
2036            }
2037        }
2038    }
2039
2040    # Build nice edit etc links for our nodes
2041    my @tt_nodes;
2042    for my $node (@nodes) {
2043        my %n;
2044
2045        # Make the URLs
2046        my $node_param = uri_escape( $formatter->node_name_to_node_param( $node ) );
2047
2048        # Save into the hash
2049        $n{'name'} = $node;
2050        $n{'view_url'} = $script_name . "?id=" . $node_param;
2051        $n{'edit_url'} = $script_name . "?id=" . $node_param . ";action=edit";
2052        push @tt_nodes, \%n;
2053    }
2054
2055    # Set up our TT variables, including the search parameters
2056    my %tt_vars = (
2057                      not_editable  => 1,
2058                      not_deletable => 1,
2059                      deter_robots  => 1,
2060
2061                      nodes => \@tt_nodes,
2062                      done_search    => $done_search,
2063                      metadata_type  => $metadata_type,
2064                      metadata_value => $metadata_value,
2065                      exclude_locales => $exclude_locales,
2066                      exclude_categories => $exclude_categories,
2067
2068                      script_name => $script_name
2069                  );
2070    return %tt_vars if $return_tt_vars;
2071
2072    # Render to the page
2073    my $output = $self->process_template(
2074                                           id       => "",
2075                                           template => "missing_metadata.tt",
2076                                           tt_vars  => \%tt_vars,
2077                                        );
2078    return $output if $return_output;
2079    print $output;
2080}
2081
2082=item B<revert_user_interface>
2083
2084If C<password> is not supplied then a form for entering the password
2085will be displayed, along with a list of all the edits the user made.
2086
2087If the password is given, will delete all of these versions.
2088=cut
2089sub revert_user_interface {
2090    my ($self, %args) = @_;
2091
2092    my $password = $args{password} || '';
2093    my $return_tt_vars = $args{return_tt_vars} || 0;
2094    my $return_output = $args{return_output} || 0;
2095
2096    my $wiki = $self->wiki;
2097    my $formatter = $self->wiki->formatter;
2098    my $script_name = $self->config->script_name;
2099
2100    my ($type,$value);
2101    if($args{'username'}) {
2102        ($type,$value) = ('username', $args{'username'});
2103    }
2104    if($args{'host'}) {
2105        ($type,$value) = ('host', $args{'host'});
2106    }
2107    unless($type && $value) {
2108        croak("One of username or host must be given");
2109    }
2110
2111    # Grab everything they've touched, ever
2112    my @user_edits = $self->wiki->list_recent_changes(
2113                            since => 1,
2114                            metadata_was => { $type => $value },
2115    );
2116
2117    if ($password) {
2118        if ($password ne $self->config->admin_pass) {
2119            croak("Bad password supplied");
2120        } else {
2121            # Delete all these versions
2122            foreach my $edit (@user_edits) {
2123                $self->wiki->delete_node(
2124                                name => $edit->{name},
2125                                version => $edit->{version},
2126                );
2127            }
2128
2129            # Grab new list
2130            @user_edits = $self->wiki->list_recent_changes(
2131                            since => 1,
2132                            metadata_was => { $type => $value },
2133            );
2134        }
2135    } else {
2136        # Don't do anything
2137    }
2138
2139    # Set up our TT variables, including the search parameters
2140    my %tt_vars = (
2141                      not_editable  => 1,
2142                      not_deletable => 1,
2143                      deter_robots  => 1,
2144
2145                      edits          => \@user_edits,
2146                      username       => $args{username},
2147                      host           => $args{host},
2148                      by_type        => $type,
2149                      by             => $value,
2150
2151                      script_name => $script_name
2152                  );
2153    return %tt_vars if $return_tt_vars;
2154
2155    # Render to the page
2156    my $output = $self->process_template(
2157                                           id       => "",
2158                                           template => "admin_revert_user.tt",
2159                                           tt_vars  => \%tt_vars,
2160                                        );
2161    return $output if $return_output;
2162    print $output;
2163}
2164
2165=item B<display_admin_interface>
2166
2167Fetch everything we need to display the admin interface, and passes it off
2168 to the template
2169
2170=cut
2171
2172sub display_admin_interface {
2173    my ($self, %args) = @_;
2174    my $return_tt_vars = $args{return_tt_vars} || 0;
2175    my $return_output = $args{return_output} || 0;
2176
2177    my $wiki = $self->wiki;
2178    my $formatter = $self->wiki->formatter;
2179    my $script_name = $self->config->script_name;
2180
2181    # Grab all the recent nodes
2182    my @all_nodes = $wiki->list_recent_changes(last_n_changes => 100);
2183
2184    # Split into nodes, Locales and Categories
2185    my @nodes;
2186    my @categories;
2187    my @locales;
2188    for my $node (@all_nodes) {
2189        # Add moderation status
2190        $node->{'moderate'} = $wiki->node_required_moderation($node->{'name'});
2191
2192        # Make the URLs
2193        my $node_param = uri_escape( $formatter->node_name_to_node_param( $node->{'name'} ) );
2194        $node->{'view_url'} = $script_name . "?id=" . $node_param;
2195        $node->{'versions_url'} = $script_name .
2196                        "?action=list_all_versions;id=" . $node_param;
2197        $node->{'moderation_url'} = $script_name .
2198                        "?action=set_moderation;id=" . $node_param;
2199        $node->{'revert_user_url'} = $script_name . "?action=revert_user" .
2200                        ";username=".$node->{metadata}->{username}->[0];
2201
2202        # Filter
2203        if($node->{'name'} =~ /^Category /) {
2204            $node->{'page_name'} = $node->{'name'};
2205            $node->{'name'} =~ s/^Category //;
2206            push @categories, $node;
2207        } elsif($node->{'name'} =~ /^Locale /) {
2208            $node->{'page_name'} = $node->{'name'};
2209            $node->{'name'} =~ s/^Locale //;
2210            push @locales, $node;
2211        } else {
2212            push @nodes, $node;
2213        }
2214    }
2215
2216    # Handle completed notice for actions
2217    my $completed_action = "";
2218    if($args{moderation_completed}) {
2219        if($args{moderation_completed} eq "moderation") {
2220            $completed_action = "Version moderated";
2221        }
2222        if($args{moderation_completed} eq "changed") {
2223            $completed_action = "Node moderation flag changed";
2224        }
2225        if($args{moderation_completed} eq "unknown_node") {
2226            $completed_action = "Node moderation flag not changed, node not known";
2227        }
2228    }
2229
2230    # Render in a template
2231    my %tt_vars = (
2232                      not_editable  => 1,
2233                      not_deletable => 1,
2234                      deter_robots  => 1,
2235                      nodes      => \@nodes,
2236                      categories => \@categories,
2237                      locales    => \@locales,
2238                      completed_action => $completed_action
2239                  );
2240    return %tt_vars if $return_tt_vars;
2241    my $output = $self->process_template(
2242                                           id       => "",
2243                                           template => "admin_home.tt",
2244                                           tt_vars  => \%tt_vars,
2245                                        );
2246    return $output if $return_output;
2247    print $output;
2248}
2249
2250sub process_template {
2251    my ($self, %args) = @_;
2252    my %output_conf = (
2253                          wiki     => $self->wiki,
2254                          config   => $self->config,
2255                          node     => $args{id},
2256                          template => $args{template},
2257                          vars     => $args{tt_vars},
2258                          cookies  => $args{cookies},
2259                      );
2260    if ( $args{content_type} ) {
2261        $output_conf{content_type} = $args{content_type};
2262    }
2263    return OpenGuides::Template->output( %output_conf );
2264}
2265
2266sub redirect_to_node {
2267    my ($self, $node, $redirected_from) = @_;
2268   
2269    my $script_url = $self->config->script_url;
2270    my $script_name = $self->config->script_name;
2271    my $formatter = $self->wiki->formatter;
2272
2273    my $id = $formatter->node_name_to_node_param( $node );
2274    my $oldid;
2275    $oldid = $formatter->node_name_to_node_param( $redirected_from ) if $redirected_from;
2276
2277    my $redir_param = "$script_url$script_name?";
2278    $redir_param .= 'id=' if $oldid;
2279    $redir_param .= $id;
2280    $redir_param .= ";oldid=$oldid" if $oldid;
2281   
2282    my $q = CGI->new;
2283    return $q->redirect( $redir_param );
2284}
2285
2286sub get_cookie {
2287    my $self = shift;
2288    my $config = $self->config;
2289    my $pref_name = shift or return "";
2290    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
2291    return $cookie_data{$pref_name};
2292}
2293
2294
2295=head1 BUGS AND CAVEATS
2296
2297UTF8 data are currently not handled correctly throughout.
2298
2299Other bugs are documented at
2300L<http://dev.openguides.org/>
2301
2302=head1 SEE ALSO
2303
2304=over 4
2305
2306=item * The Open Guide to London, at L<http://london.openguides.org/>, is the first and biggest OpenGuides site.
2307
2308=item * A list of live OpenGuides installs is available at L<http://openguides.org/>.
2309
2310=item * L<Wiki::Toolkit>, the Wiki toolkit which does the heavy lifting for OpenGuides.
2311
2312=back
2313
2314=head1 FEEDBACK
2315
2316If you have a question, a bug report, or a patch, or you're interested
2317in joining the development team, please contact openguides-dev@lists.openguides.org
2318(moderated mailing list, will reach all current developers but you'll have
2319to wait for your post to be approved) or file a bug report at
2320L<http://dev.openguides.org/>
2321
2322=head1 AUTHOR
2323
2324The OpenGuides Project (openguides-dev@lists.openguides.org)
2325
2326=head1 COPYRIGHT
2327
2328     Copyright (C) 2003-2008 The OpenGuides Project.  All Rights Reserved.
2329
2330The OpenGuides distribution is free software; you can redistribute it
2331and/or modify it under the same terms as Perl itself.
2332
2333=head1 CREDITS
2334
2335Programming by Dominic Hargreaves, Earle Martin, Kake Pugh, and Ivor
2336Williams.  Testing and bug reporting by Billy Abbott, Jody Belka,
2337Kerry Bosworth, Simon Cozens, Cal Henderson, Steve Jolly, and Bob
2338Walker (among others).  Much of the Module::Build stuff copied from
2339the Siesta project L<http://siesta.unixbeard.net/>
2340
2341=cut
2342
23431;
Note: See TracBrowser for help on using the repository browser.