source: trunk/lib/OpenGuides.pm @ 1056

Last change on this file since 1056 was 1056, checked in by Dagfinn Ilmari Mannsåker, 14 years ago

Check for definedness of redirect parameter before defaulting to 1 (closes #104).

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