source: trunk/lib/OpenGuides.pm @ 1441

Last change on this file since 1441 was 1441, checked in by bob, 9 years ago

merge of release changes for 0.70

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