source: trunk/lib/OpenGuides.pm @ 1037

Last change on this file since 1037 was 1037, checked in by kake, 14 years ago

Added experimental support for local spam detection modules.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 74.2 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 = $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    $tt_vars{recent_changes} = \%recent_changes;
632    my %processing_args = (
633                            id            => $id,
634                            template      => "recent_changes.tt",
635                            tt_vars       => \%tt_vars,
636                           );
637    if ( !$since && $self->get_cookie("track_recent_changes_views") ) {
638    my $cookie =
639           OpenGuides::CGI->make_recent_changes_cookie(config => $config );
640        $processing_args{cookies} = $cookie;
641        $tt_vars{last_viewed} = OpenGuides::CGI->get_last_recent_changes_visit_from_cookie( config => $config );
642    }
643    return %tt_vars if $args{return_tt_vars};
644    my $output = $self->process_template( %processing_args );
645    return $output if $return_output;
646    print $output;
647}
648
649=item B<display_diffs>
650
651  $guide->display_diffs(
652                           id            => "Home Page",
653                           version       => 6,
654                           other_version => 5,
655                       );
656
657  # Or return output as a string (useful for writing tests).
658  my $output = $guide->display_diffs(
659                                        id            => "Home Page",
660                                        version       => 6,
661                                        other_version => 5,
662                                        return_output => 1,
663                                    );
664
665  # Or return the hash of variables that will be passed to the template
666  # (not including those set additionally by OpenGuides::Template).
667  my %vars = $guide->display_diffs(
668                                      id             => "Home Page",
669                                      version        => 6,
670                                      other_version  => 5,
671                                      return_tt_vars => 1,
672                                  );
673
674=cut
675
676sub display_diffs {
677    my ($self, %args) = @_;
678    my %diff_vars = $self->differ->differences(
679                                                  node          => $args{id},
680                                                  left_version  => $args{version},
681                                                  right_version => $args{other_version},
682                                              );
683    $diff_vars{not_deletable} = 1;
684    $diff_vars{not_editable}  = 1;
685    $diff_vars{deter_robots}  = 1;
686    return %diff_vars if $args{return_tt_vars};
687    my $output = $self->process_template(
688                                            id       => $args{id},
689                                            template => "differences.tt",
690                                            tt_vars  => \%diff_vars
691                                        );
692    return $output if $args{return_output};
693    print $output;
694}
695
696=item B<find_within_distance>
697
698  $guide->find_within_distance(
699                                  id => $node,
700                                  metres => $q->param("distance_in_metres")
701                              );
702
703=cut
704
705sub find_within_distance {
706    my ($self, %args) = @_;
707    my $node = $args{id};
708    my $metres = $args{metres};
709    my %data = $self->wiki->retrieve_node( $node );
710    my $lat = $data{metadata}{latitude}[0];
711    my $long = $data{metadata}{longitude}[0];
712    my $script_url = $self->config->script_url;
713    my $q = CGI->new;
714    print $q->redirect( $script_url . "search.cgi?lat=$lat;long=$long;distance_in_metres=$metres" );
715}
716
717=item B<show_backlinks>
718
719  $guide->show_backlinks( id => "Calthorpe Arms" );
720
721As with other methods, parameters C<return_tt_vars> and
722C<return_output> can be used to return these things instead of
723printing the output to STDOUT.
724
725=cut
726
727sub show_backlinks {
728    my ($self, %args) = @_;
729    my $wiki = $self->wiki;
730    my $formatter = $wiki->formatter;
731
732    my @backlinks = $wiki->list_backlinks( node => $args{id} );
733    my @results = map {
734                          {
735                              url   => CGI->escape($formatter->node_name_to_node_param($_)),
736                              title => CGI->escapeHTML($_)
737                          }
738                      } sort @backlinks;
739    my %tt_vars = ( results       => \@results,
740                    num_results   => scalar @results,
741                    not_deletable => 1,
742                    deter_robots  => 1,
743                    not_editable  => 1 );
744    return %tt_vars if $args{return_tt_vars};
745    my $output = OpenGuides::Template->output(
746                                                 node    => $args{id},
747                                                 wiki    => $wiki,
748                                                 config  => $self->config,
749                                                 template=>"backlink_results.tt",
750                                                 vars    => \%tt_vars,
751                                             );
752    return $output if $args{return_output};
753    print $output;
754}
755
756=item B<show_index>
757
758  $guide->show_index(
759                        type   => "category",
760                        value  => "pubs",
761                    );
762
763  # RDF version.
764  $guide->show_index(
765                        type   => "locale",
766                        value  => "Holborn",
767                        format => "rdf",
768                    );
769
770  # RSS / Atom version (recent changes style).
771  $guide->show_index(
772                        type   => "locale",
773                        value  => "Holborn",
774                        format => "rss",
775                    );
776
777  # Or return output as a string (useful for writing tests).
778  $guide->show_index(
779                        type          => "category",
780                        value         => "pubs",
781                        return_output => 1,
782                    );
783
784=cut
785
786sub show_index {
787    my ($self, %args) = @_;
788    my $wiki = $self->wiki;
789    my $formatter = $wiki->formatter;
790    my %tt_vars;
791    my @selnodes;
792
793    if ( $args{type} and $args{value} ) {
794        if ( $args{type} eq "fuzzy_title_match" ) {
795            my %finds = $wiki->fuzzy_title_match( $args{value} );
796            @selnodes = sort { $finds{$a} <=> $finds{$b} } keys %finds;
797            $tt_vars{criterion} = {
798                type  => $args{type},  # for RDF version
799                value => $args{value}, # for RDF version
800                name  => CGI->escapeHTML("Fuzzy Title Match on '$args{value}'")
801            };
802            $tt_vars{not_editable} = 1;
803        } else {
804            @selnodes = $wiki->list_nodes_by_metadata(
805                metadata_type  => $args{type},
806                metadata_value => $args{value},
807                ignore_case    => 1
808            );
809            my $name = ucfirst($args{type}) . " $args{value}";
810            my $url = $self->config->script_name
811                      . "?"
812                      . ucfirst( $args{type} )
813                      . "_"
814                      . uri_escape(
815                                      $formatter->node_name_to_node_param($args{value})
816                                  );
817            $tt_vars{criterion} = {
818                type  => $args{type},
819                value => $args{value}, # for RDF version
820                name  => CGI->escapeHTML( $name ),
821                url   => $url
822            };
823            $tt_vars{not_editable} = 1;
824        }
825    } else {
826        @selnodes = $wiki->list_all_nodes();
827    }
828
829    my @nodes = map {
830                        {
831                            name      => $_,
832                            node_data => { $wiki->retrieve_node( name => $_ ) },
833                            param     => $formatter->node_name_to_node_param($_) }
834                        } sort @selnodes;
835
836    # Convert the lat+long to WGS84 as required
837    for(my $i=0; $i<scalar @nodes;$i++) {
838        my $node = $nodes[$i];
839        if($node) {
840            my %metadata = %{$node->{node_data}->{metadata}};
841            my ($wgs84_long, $wgs84_lat);
842            eval {
843                ($wgs84_long, $wgs84_lat) = OpenGuides::Utils->get_wgs84_coords(
844                                      longitude => $metadata{longitude}[0],
845                                      latitude => $metadata{latitude}[0],
846                                      config => $self->config);
847            };
848            warn $@." on ".$metadata{latitude}[0]." ".$metadata{longitude}[0] if $@;
849
850            push @{$nodes[$i]->{node_data}->{metadata}->{wgs84_long}}, $wgs84_long;
851            push @{$nodes[$i]->{node_data}->{metadata}->{wgs84_lat}},  $wgs84_lat;
852        }
853    }
854
855    $tt_vars{nodes} = \@nodes;
856
857    my ($template, %conf);
858
859    if ( $args{format} ) {
860        if ( $args{format} eq "rdf" ) {
861            $template = "rdf_index.tt";
862            $conf{content_type} = "application/rdf+xml";
863        }
864        elsif ( $args{format} eq "plain" ) {
865            $template = "plain_index.tt";
866            $conf{content_type} = "text/plain";
867        } elsif ( $args{format} eq "map" ) {
868            my $q = CGI->new;
869            $tt_vars{zoom} = $q->param('zoom') || '';
870            $tt_vars{lat} = $q->param('lat') || '';
871            $tt_vars{long} = $q->param('long') || '';
872            $tt_vars{map_type} = $q->param('map_type') || '';
873            $tt_vars{centre_long} = $self->config->centre_long;
874            $tt_vars{centre_lat} = $self->config->centre_lat;
875            $tt_vars{default_gmaps_zoom} = $self->config->default_gmaps_zoom;
876            $tt_vars{enable_gmaps} = 1;
877            $tt_vars{display_google_maps} = 1; # override for this page
878            $template = "map_index.tt";
879           
880        } elsif( $args{format} eq "rss" || $args{format} eq "atom") {
881            # They really wanted a recent changes style rss/atom feed
882            my $feed_type = $args{format};
883            my ($feed,$content_type) = $self->get_feed_and_content_type($feed_type);
884            $feed->set_feed_name_and_url_params(
885                        "Index of $args{type} $args{value}",
886                        "action=index;index_type=$args{type};index_value=$args{value}"
887            );
888
889            # Grab the actual node data out of @nodes
890            my @node_data;
891            foreach my $node (@nodes) {
892                $node->{node_data}->{name} = $node->{name};
893                push @node_data, $node->{node_data};
894            }
895
896            my $output = "Content-Type: ".$content_type."\n";
897            $output .= $feed->build_feed_for_nodes($feed_type, @node_data);
898
899            return $output if $args{return_output};
900            print $output;
901            return;
902        }
903    } else {
904        $template = "site_index.tt";
905    }
906
907    %conf = (
908                %conf,
909                node        => "$args{type} index", # KLUDGE
910                template    => $template,
911                tt_vars     => \%tt_vars,
912            );
913
914    my $output = $self->process_template( %conf );
915    return $output if $args{return_output};
916    print $output;
917}
918
919=item B<list_all_versions>
920
921  $guide->list_all_versions ( id => "Home Page" );
922
923  # Or return output as a string (useful for writing tests).
924  $guide->list_all_versions (
925                                id            => "Home Page",
926                                return_output => 1,
927                            );
928
929  # Or return the hash of variables that will be passed to the template
930  # (not including those set additionally by OpenGuides::Template).
931  $guide->list_all_versions (
932                                id             => "Home Page",
933                                return_tt_vars => 1,
934                            );
935
936=cut
937
938sub list_all_versions {
939    my ($self, %args) = @_;
940    my $return_output = $args{return_output} || 0;
941    my $node = $args{id};
942    my %curr_data = $self->wiki->retrieve_node($node);
943    my $curr_version = $curr_data{version};
944    my @history;
945    for my $version ( 1 .. $curr_version ) {
946        my %node_data = $self->wiki->retrieve_node( name    => $node,
947                                                    version => $version );
948        # $node_data{version} will be zero if this version was deleted.
949        push @history, {
950            version  => CGI->escapeHTML( $version ),
951            modified => CGI->escapeHTML( $node_data{last_modified} ),
952            username => CGI->escapeHTML( $node_data{metadata}{username}[0] ),
953            comment  => CGI->escapeHTML( $node_data{metadata}{comment}[0] ),
954                       } if $node_data{version};
955    }
956    @history = reverse @history;
957    my %tt_vars = (
958                      node          => $node,
959                      version       => $curr_version,
960                      not_deletable => 1,
961                      not_editable  => 1,
962                      deter_robots  => 1,
963                      history       => \@history
964                  );
965    return %tt_vars if $args{return_tt_vars};
966    my $output = $self->process_template(
967                                            id       => $node,
968                                            template => "node_history.tt",
969                                            tt_vars  => \%tt_vars,
970                                        );
971    return $output if $return_output;
972    print $output;
973}
974
975=item B<get_feed_and_content_type>
976
977Fetch the OpenGuides feed object, and the output content type, for the
978supplied feed type.
979
980Handles all the setup for the OpenGuides feed object.
981
982=cut
983
984sub get_feed_and_content_type {
985    my ($self, $feed_type) = @_;
986
987    my $feed = OpenGuides::Feed->new(
988                                        wiki       => $self->wiki,
989                                        config     => $self->config,
990                                        og_version => $VERSION,
991                                    );
992
993    my $content_type = $feed->default_content_type($feed_type);
994
995    return ($feed, $content_type);
996}
997
998=item B<display_feed>
999
1000  # Last ten non-minor edits to Hammersmith pages in RSS 1.0 format
1001  $guide->display_feed(
1002                         feed_type          => 'rss',
1003                         feed_listing       => 'recent_changes',
1004                         items              => 10,
1005                         ignore_minor_edits => 1,
1006                         locale             => "Hammersmith",
1007                     );
1008
1009  # All edits bob has made to pub pages in the last week in Atom format
1010  $guide->display_feed(
1011                         feed_type    => 'atom',
1012                         feed_listing => 'recent_changes',
1013                         days         => 7,
1014                         username     => "bob",
1015                         category     => "Pubs",
1016                     );
1017
1018C<feed_type> is a mandatory parameter. Supported values at present are
1019"rss" and "atom".
1020
1021C<feed_listing> is a mandatory parameter. Supported values at present
1022are "recent_changes". (More values are coming soon though!)
1023
1024As with other methods, the C<return_output> parameter can be used to
1025return the output instead of printing it to STDOUT.
1026
1027=cut
1028
1029sub display_feed {
1030    my ($self, %args) = @_;
1031
1032    my $feed_type = $args{feed_type};
1033    croak "No feed type given" unless $feed_type;
1034
1035    my $feed_listing = $args{feed_listing};
1036    croak "No feed listing given" unless $feed_listing;
1037   
1038    my $return_output = $args{return_output} ? 1 : 0;
1039
1040    # Basic criteria, whatever the feed listing type is
1041    my %criteria = (
1042                       feed_type             => $feed_type,
1043                       feed_listing          => $feed_listing,
1044                       also_return_timestamp => 1,
1045                   );
1046
1047    # Feed listing specific criteria
1048    if($feed_listing eq "recent_changes") {
1049        $criteria{items} = $args{items} || "";
1050        $criteria{days}  = $args{days}  || "";
1051        $criteria{ignore_minor_edits} = $args{ignore_minor_edits} ? 1 : 0;
1052
1053        my $username = $args{username} || "";
1054        my $category = $args{category} || "";
1055        my $locale   = $args{locale}   || "";
1056
1057        my %filter;
1058        $filter{username} = $username if $username;
1059        $filter{category} = $category if $category;
1060        $filter{locale}   = $locale   if $locale;
1061        if ( scalar keys %filter ) {
1062            $criteria{filter_on_metadata} = \%filter;
1063        }
1064    }
1065    elsif($feed_listing eq "node_all_versions") {
1066        $criteria{name} = $args{name};
1067    }
1068
1069
1070    # Get the feed object, and the content type
1071    my ($feed,$content_type) = $self->get_feed_and_content_type($feed_type);
1072
1073    my $output = "Content-Type: ".$content_type;
1074    if($self->config->http_charset) {
1075        $output .= "; charset=".$self->config->http_charset;
1076    }
1077    $output .= "\n";
1078   
1079    # Get the feed, and the timestamp, in one go
1080    my ($feed_output, $feed_timestamp) = 
1081        $feed->make_feed( %criteria );
1082    my $maker = $feed->fetch_maker($feed_type);
1083 
1084    $output .= "Last-Modified: " . ($maker->parse_feed_timestamp($feed_timestamp))->strftime('%a, %d %b %Y %H:%M:%S +0000') . "\n\n";
1085    $output .= $feed_output;
1086
1087    return $output if $return_output;
1088    print $output;
1089}
1090
1091sub display_about {
1092    my ($self, %args) = @_;
1093
1094    my $output;
1095
1096    if ($args{format} && $args{format} =~ /^rdf$/i) {
1097        $output = qq{Content-Type: application/rdf+xml
1098
1099<?xml version="1.0" encoding="UTF-8"?>
1100<rdf:RDF xmlns      = "http://usefulinc.com/ns/doap#"
1101         xmlns:rdf  = "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
1102         xmlns:foaf = "http://xmlns.com/foaf/0.1/">
1103<Project rdf:ID="OpenGuides">
1104  <name>OpenGuides</name>
1105
1106  <created>2003-04-29</created>
1107 
1108  <shortdesc xml:lang="en">
1109    A wiki engine for collaborative description of places with specialised
1110    geodata metadata features.
1111  </shortdesc>
1112
1113  <description xml:lang="en">
1114    OpenGuides is a collaborative wiki environment, written in Perl, for
1115    building guides and sharing information, as both human-readable text
1116    and RDF. The engine contains a number of geodata-specific metadata
1117    mechanisms such as locale search, node classification and integration
1118    with Google Maps.
1119  </description>
1120
1121  <homepage rdf:resource="http://openguides.org/" />
1122  <mailing-list rdf:resource="http://openguides.org/mm/listinfo/openguides-dev/" />
1123  <mailing-list rdf:resource="http://urchin.earth.li/mailman/listinfo/openguides-commits/" />
1124
1125  <maintainer>
1126    <foaf:Person rdf:ID="OpenGuidesMaintainer">
1127      <foaf:name>Dominic Hargreaves</foaf:name>
1128      <foaf:homepage rdf:resource="http://www.larted.org.uk/~dom/" />
1129    </foaf:Person>
1130  </maintainer>
1131
1132  <repository>
1133    <SVNRepository rdf:ID="OpenGuidesSVN">
1134      <location rdf:resource="https://urchin.earth.li/svn/openguides/" />
1135      <browse rdf:resource="http://dev.openguides.org/browser" />
1136    </SVNRepository>
1137  </repository>
1138
1139  <release>
1140    <Version rdf:ID="OpenGuidesVersion">
1141      <revision>$VERSION</revision>
1142    </Version>
1143  </release>
1144
1145  <download-page rdf:resource="http://search.cpan.org/dist/OpenGuides/" />
1146 
1147  <!-- Freshmeat category: Internet :: WWW/HTTP :: Dynamic Content -->
1148  <category rdf:resource="http://freshmeat.net/browse/92/" />
1149 
1150  <license rdf:resource="http://www.opensource.org/licenses/gpl-license.php" />
1151  <license rdf:resource="http://www.opensource.org/licenses/artistic-license.php" />
1152
1153</Project>
1154
1155</rdf:RDF>};
1156    }
1157    else {
1158        my $site_name  = $self->config->{site_name};
1159        my $script_name = $self->config->{script_name};
1160        $output = qq{Content-Type: text/html; charset=utf-8
1161
1162<html>
1163<head>
1164  <title>About $site_name</title>
1165<style type="text/css">
1166body        { margin: 0px; }
1167#content    { padding: 50px; margin: auto; width: 50%; }
1168h1          { margin-bottom: 0px; font-style: italic; }
1169h2          { margin-top: 0px; }
1170#logo       { text-align: center; }
1171#about      { margin: 0em 0em 1em 0em; border-top: 1px solid #ddd; border-bottom: 1px solid #ddd; }
1172#meta       { font-size: small; text-align: center;}
1173</style>
1174<link rel="alternate"
1175  type="application/rdf+xml"
1176  title="DOAP (Description Of A Project) profile for this site's software"
1177  href="$script_name?action=about;format=rdf" />
1178</head>
1179<body>
1180<div id="content">
1181<div id="logo">
1182<a href="http://openguides.org/"><img
1183src="http://openguides.org/img/logo.png" alt="OpenGuides"></a>
1184<h1><a href="$script_name">$site_name</a></h1>
1185<h2>is powered by <a href="http://openguides.org/">OpenGuides</a> -<br>
1186the guides made by you.</h2>
1187<h3>version <a href="http://search.cpan.org/~dom/OpenGuides-$VERSION">$VERSION</a></h3>
1188</div>
1189<div id="about">
1190<p>
1191<a href="http://www.w3.org/RDF/"><img
1192src="http://openguides.org/img/rdf_icon.png" width="44" height="48"
1193style="float: right; margin-left: 10px; border: 0px"></a> OpenGuides is a
1194web-based collaborative <a href="http://wiki.org/wiki.cgi?WhatIsWiki">wiki</a>
1195environment for building guides and sharing information, as both
1196human-readable text and <a href="http://www.w3.org/RDF/"><acronym
1197title="Resource Description Framework">RDF</acronym></a>. The engine contains
1198a number of geodata-specific metadata mechanisms such as locale search, node
1199classification and integration with <a href="http://maps.google.com/">Google
1200Maps</a>.
1201</p>
1202<p>
1203OpenGuides is written in <a href="http://www.perl.org/">Perl</a>, and is
1204made available under the same license as Perl itself (dual <a
1205href="http://dev.perl.org/licenses/artistic.html" title='The "Artistic Licence"'>Artistic</a> and <a
1206href="http://www.opensource.org/licenses/gpl-license.php"><acronym
1207title="GNU Public Licence">GPL</acronym></a>). Developer information for the
1208project is available from the <a href="http://dev.openguides.org/">OpenGuides
1209development site</a>.
1210</p>
1211<p>
1212Copyright &copy;2003-2007, <a href="http://openguides.org/">The OpenGuides
1213Project</a>. "OpenGuides", "[The] Open Guide To..." and "The guides made by
1214you" are trademarks of The OpenGuides Project. Any uses on this site are made
1215with permission.
1216</p>
1217</div>
1218<div id="meta">
1219<a href="$script_name?action=about;format=rdf"><acronym
1220title="Description Of A Project">DOAP</acronym> RDF version of this
1221information</a>
1222</div>
1223</div>
1224</body>
1225</html>};
1226    }
1227   
1228    return $output if $args{return_output};
1229    print $output;
1230}
1231
1232=item B<commit_node>
1233
1234  $guide->commit_node(
1235                         id      => $node,
1236                         cgi_obj => $q,
1237                     );
1238
1239As with other methods, parameters C<return_tt_vars> and
1240C<return_output> can be used to return these things instead of
1241printing the output to STDOUT.
1242
1243If you have specified the C<spam_detector_module> option in your
1244C<wiki.conf>, this method will attempt to call the <looks_like_spam>
1245method of that module to determine whether the edit is spam.  If this
1246method returns true, then the C<spam_detected.tt> template will be
1247used to display an error message.
1248
1249The C<looks_like_spam> method will be passed a datastructure containing
1250content and metadata.
1251
1252The geographical data that you should provide in the L<CGI> object
1253depends on the handler you chose in C<wiki.conf>.
1254
1255=over
1256
1257=item *
1258
1259B<British National Grid> - provide either C<os_x> and C<os_y> or
1260C<latitude> and C<longitude>; whichever set of data you give, it will
1261be converted to the other and both sets will be stored.
1262
1263=item *
1264
1265B<Irish National Grid> - provide either C<osie_x> and C<osie_y> or
1266C<latitude> and C<longitude>; whichever set of data you give, it will
1267be converted to the other and both sets will be stored.
1268
1269=item *
1270
1271B<UTM ellipsoid> - provide C<latitude> and C<longitude>; these will be
1272converted to easting and northing and both sets of data will be stored.
1273
1274=back
1275
1276=cut
1277
1278sub commit_node {
1279    my ($self, %args) = @_;
1280    my $node = $args{id};
1281    my $q = $args{cgi_obj};
1282    my $return_output = $args{return_output};
1283    my $wiki = $self->wiki;
1284    my $config = $self->config;
1285
1286    my $content  = $q->param("content");
1287    $content =~ s/\r\n/\n/gs;
1288    my $checksum = $q->param("checksum");
1289
1290    my %new_metadata = OpenGuides::Template->extract_metadata_vars(
1291        wiki    => $wiki,
1292        config  => $config,
1293        cgi_obj => $q
1294    );
1295
1296    delete $new_metadata{website} if $new_metadata{website} eq 'http://';
1297
1298    $new_metadata{opening_hours_text} = $q->param("hours_text") || "";
1299
1300    # Pick out the unmunged versions of lat/long if they're set.
1301    # (If they're not, it means they weren't munged in the first place.)
1302    $new_metadata{latitude} = delete $new_metadata{latitude_unmunged}
1303        if $new_metadata{latitude_unmunged};
1304    $new_metadata{longitude} = delete $new_metadata{longitude_unmunged}
1305        if $new_metadata{longitude_unmunged};
1306
1307    foreach my $var ( qw( summary username comment edit_type ) ) {
1308        $new_metadata{$var} = $q->param($var) || "";
1309    }
1310    $new_metadata{host} = $ENV{REMOTE_ADDR};
1311
1312    # Wiki::Toolkit::Plugin::RSS::ModWiki wants "major_change" to be set.
1313    $new_metadata{major_change} = ( $new_metadata{edit_type} eq "Normal edit" )
1314                                    ? 1
1315                                    : 0;
1316
1317    # If we can, check to see if this edit looks like spam.
1318    my $spam_detector = $config->spam_detector_module;
1319    my $is_spam;
1320    if ( $spam_detector ) {
1321        eval {
1322            eval "require $spam_detector";
1323            $is_spam = $spam_detector->looks_like_spam(
1324                node    => $node,
1325                content => $content,
1326                metadata => \%new_metadata,
1327            );
1328        };
1329    }
1330
1331    if ( $is_spam ) {
1332        my $output = OpenGuides::Template->output(
1333            wiki     => $self->wiki,
1334            config   => $config,
1335            template => "spam_detected.tt",
1336            vars     => {
1337                          not_editable => 1,
1338                        },
1339        );
1340        return $output if $return_output;
1341        print $output;
1342        return;
1343    }
1344
1345    # Check to make sure all the indexable nodes are created
1346    # Skip this for nodes needing moderation - this occurs for them once
1347    #  they've been moderated
1348    unless($wiki->node_required_moderation($node)) {
1349        $self->_autoCreateCategoryLocale(
1350                                          id       => $node,
1351                                          metadata => \%new_metadata
1352        );
1353    }
1354   
1355    my $written = $wiki->write_node( $node, $content, $checksum,
1356                                     \%new_metadata );
1357
1358    if ($written) {
1359        my $output = $self->redirect_to_node($node);
1360        return $output if $return_output;
1361        print $output;
1362    } else {
1363        return $self->_handle_edit_conflict(
1364                                             id            => $node,
1365                                             content       => $content,
1366                                             new_metadata  => \%new_metadata,
1367                                             return_output => $return_output,
1368                                           );
1369    }
1370}
1371
1372sub _handle_edit_conflict {
1373    my ($self, %args) = @_;
1374    my $return_output = $args{return_output} || 0;
1375    my $config = $self->config;
1376    my $wiki = $self->wiki;
1377    my $node = $args{id};
1378    my $content = $args{content};
1379    my %new_metadata = %{$args{new_metadata}};
1380
1381    my %node_data = $wiki->retrieve_node($node);
1382    my %tt_vars = ( checksum       => $node_data{checksum},
1383                    new_content    => $content,
1384                    content        => $node_data{content} );
1385    my %old_metadata = OpenGuides::Template->extract_metadata_vars(
1386                                           wiki     => $wiki,
1387                                           config   => $config,
1388                                           metadata => $node_data{metadata} );
1389    # Make sure we look at all variables.
1390    my @tmp = (keys %new_metadata, keys %old_metadata );
1391    my %tmp_hash = map { $_ => 1; } @tmp;
1392    my @all_vars = keys %tmp_hash;
1393
1394    foreach my $mdvar ( keys %new_metadata ) {
1395        if ($mdvar eq "locales") {
1396            $tt_vars{$mdvar} = $old_metadata{locales};
1397            $tt_vars{"new_$mdvar"} = $new_metadata{locale};
1398        } elsif ($mdvar eq "categories") {
1399            $tt_vars{$mdvar} = $old_metadata{categories};
1400            $tt_vars{"new_$mdvar"} = $new_metadata{category};
1401        } elsif ($mdvar eq "username" or $mdvar eq "comment"
1402                  or $mdvar eq "edit_type" ) {
1403            $tt_vars{$mdvar} = $new_metadata{$mdvar};
1404        } else {
1405            $tt_vars{$mdvar} = $old_metadata{$mdvar};
1406            $tt_vars{"new_$mdvar"} = $new_metadata{$mdvar};
1407        }
1408    }
1409
1410    $tt_vars{coord_field_1} = $old_metadata{coord_field_1};
1411    $tt_vars{coord_field_2} = $old_metadata{coord_field_2};
1412    $tt_vars{coord_field_1_value} = $old_metadata{coord_field_1_value};
1413    $tt_vars{coord_field_2_value} = $old_metadata{coord_field_2_value};
1414    $tt_vars{"new_coord_field_1_value"}
1415                                = $new_metadata{$old_metadata{coord_field_1}};
1416    $tt_vars{"new_coord_field_2_value"}
1417                                = $new_metadata{$old_metadata{coord_field_2}};
1418
1419    $tt_vars{conflict} = 1;
1420    return %tt_vars if $args{return_tt_vars};
1421    my $output = $self->process_template(
1422                                          id       => $node,
1423                                          template => "edit_form.tt",
1424                                          tt_vars  => \%tt_vars,
1425                                        );
1426    return $output if $args{return_output};
1427    print $output;
1428}
1429
1430=item B<_autoCreateCategoryLocale>
1431
1432  $guide->_autoCreateCategoryLocale(
1433                         id       => "FAQ",
1434                         metadata => \%metadata,
1435                     );
1436
1437When a new node is added, or a previously un-moderated node is moderated,
1438identifies if any of its Categories or Locales are missing, and creates them.
1439
1440Guide admins can control the text that gets put into the content field of the
1441autocreated node by putting it in custom_autocreate_content.tt in their custom
1442templates directory.  The following TT variables will be available to the
1443template:
1444
1445=over
1446
1447=item * index_type (e.g. C<Category>)
1448
1449=item * index_value (e.g. C<Vegan-friendly>)
1450
1451=item * node_name (e.g. C<Category Vegan-Friendly>)
1452
1453=back
1454
1455(Note capitalisation - index_value is what they typed in to the form, and
1456node_name is the fully free-upper-ed name of the autocreated node.)
1457
1458For nodes not requiring moderation, should be called on writing the node
1459For nodes requiring moderation, should only be called on moderation
1460
1461=cut
1462
1463sub _autoCreateCategoryLocale {
1464    my ($self, %args) = @_;
1465
1466    my $wiki = $self->wiki;
1467    my $id = $args{'id'};
1468    my %metadata = %{$args{'metadata'}};
1469
1470    # Check to make sure all the indexable nodes are created
1471    my $config = $self->config;
1472    my $template_path = $config->template_path;
1473    my $custom_template_path = $config->custom_template_path || "";
1474    my $tt = Template->new( { INCLUDE_PATH =>
1475                                  "$custom_template_path:$template_path" } );
1476
1477    foreach my $type (qw(Category Locale)) {
1478        my $lctype = lc($type);
1479        foreach my $index (@{$metadata{$lctype}}) {
1480            $index =~ s/(.*)/\u$1/;
1481            my $node = $type . " " . $index;
1482            # Uppercase the node name before checking for existence
1483            $node = $wiki->formatter->_do_freeupper( $node );
1484            unless ( $wiki->node_exists($node) ) {
1485                my $category = $type eq "Category" ? "Category" : "Locales";
1486                # Try to get the autocreated content from a custom template;
1487                # if we fail, use some default text.
1488                my $blurb;
1489                my %tt_vars = (
1490                                index_type  => $type,
1491                                index_value => $index,
1492                                node_name   => $node,
1493                              );
1494                my $ok = $tt->process( "custom_autocreate_content.tt",
1495                                       \%tt_vars, \$blurb );
1496                if ( !$ok ) {
1497                    $blurb = "\@INDEX_LINK [[$node]]";
1498                }
1499                $wiki->write_node(
1500                                     $node,
1501                                     $blurb,
1502                                     undef,
1503                                     {
1504                                         username => "Auto Create",
1505                                         comment  => "Auto created $lctype stub page",
1506                                         category => $category
1507                                     }
1508                );
1509            }
1510        }
1511    }
1512}
1513
1514
1515=item B<delete_node>
1516
1517  $guide->delete_node(
1518                         id       => "FAQ",
1519                         version  => 15,
1520                         password => "beer",
1521                     );
1522
1523C<version> is optional - if it isn't supplied then all versions of the
1524node will be deleted; in other words the node will be entirely
1525removed.
1526
1527If C<password> is not supplied then a form for entering the password
1528will be displayed.
1529
1530As with other methods, parameters C<return_tt_vars> and
1531C<return_output> can be used to return these things instead of
1532printing the output to STDOUT.
1533
1534=cut
1535
1536sub delete_node {
1537    my ($self, %args) = @_;
1538    my $node = $args{id} or croak "No node ID supplied for deletion";
1539    my $return_tt_vars = $args{return_tt_vars} || 0;
1540    my $return_output = $args{return_output} || 0;
1541
1542    my %tt_vars = (
1543                      not_editable  => 1,
1544                      not_deletable => 1,
1545                      deter_robots  => 1,
1546                  );
1547    $tt_vars{delete_version} = $args{version} || "";
1548
1549    my $password = $args{password};
1550
1551    if ($password) {
1552        if ($password ne $self->config->admin_pass) {
1553            return %tt_vars if $return_tt_vars;
1554            my $output = $self->process_template(
1555                                                    id       => $node,
1556                                                    template => "delete_password_wrong.tt",
1557                                                    tt_vars  => \%tt_vars,
1558                                                );
1559            return $output if $return_output;
1560            print $output;
1561        } else {
1562            $self->wiki->delete_node(
1563                                        name    => $node,
1564                                        version => $args{version},
1565                                    );
1566            # Check whether any versions of this node remain.
1567            my %check = $self->wiki->retrieve_node( name => $node );
1568            $tt_vars{other_versions_remain} = 1 if $check{version};
1569            return %tt_vars if $return_tt_vars;
1570            my $output = $self->process_template(
1571                                                    id       => $node,
1572                                                    template => "delete_done.tt",
1573                                                    tt_vars  => \%tt_vars,
1574                                                );
1575            return $output if $return_output;
1576            print $output;
1577        }
1578    } else {
1579        return %tt_vars if $return_tt_vars;
1580        my $output = $self->process_template(
1581                                                id       => $node,
1582                                                template => "delete_confirm.tt",
1583                                                tt_vars  => \%tt_vars,
1584                                            );
1585        return $output if $return_output;
1586        print $output;
1587    }
1588}
1589
1590=item B<set_node_moderation>
1591
1592  $guide->set_node_moderation(
1593                         id       => "FAQ",
1594                         password => "beer",
1595                         moderation_flag => 1,
1596                     );
1597
1598Sets the moderation needed flag on a node, either on or off.
1599
1600If C<password> is not supplied then a form for entering the password
1601will be displayed.
1602
1603=cut
1604
1605sub set_node_moderation {
1606    my ($self, %args) = @_;
1607    my $node = $args{id} or croak "No node ID supplied for node moderation";
1608    my $return_tt_vars = $args{return_tt_vars} || 0;
1609    my $return_output = $args{return_output} || 0;
1610
1611    # Get the moderation flag into something sane
1612    if($args{moderation_flag} eq "1" || $args{moderation_flag} eq "yes" ||
1613       $args{moderation_flag} eq "on" || $args{moderation_flag} eq "true") {
1614        $args{moderation_flag} = 1;
1615    } else {
1616        $args{moderation_flag} = 0;
1617    }
1618
1619    # Set up the TT variables
1620    my %tt_vars = (
1621                      not_editable  => 1,
1622                      not_deletable => 1,
1623                      deter_robots  => 1,
1624                      moderation_action => 'set_moderation',
1625                      moderation_flag   => $args{moderation_flag},
1626                      moderation_url_args => 'action=set_moderation;moderation_flag='.$args{moderation_flag},
1627                  );
1628
1629    my $password = $args{password};
1630
1631    if ($password) {
1632        if ($password ne $self->config->admin_pass) {
1633            return %tt_vars if $return_tt_vars;
1634            my $output = $self->process_template(
1635                                                    id       => $node,
1636                                                    template => "moderate_password_wrong.tt",
1637                                                    tt_vars  => \%tt_vars,
1638                                                );
1639            return $output if $return_output;
1640            print $output;
1641        } else {
1642            my $worked = $self->wiki->set_node_moderation(
1643                                        name    => $node,
1644                                        required => $args{moderation_flag},
1645                         );
1646            my $moderation_flag = "changed";
1647            unless($worked) {
1648                $moderation_flag = "unknown_node";
1649                warn("Tried to set moderation status on node '$node', which doesn't exist");
1650            }
1651
1652            # Send back to the admin interface
1653            my $script_url = $self->config->script_url;
1654            my $script_name = $self->config->script_name;
1655            my $q = CGI->new;
1656            my $output = $q->redirect( $script_url.$script_name."?action=admin;moderation=".$moderation_flag );
1657            return $output if $return_output;
1658            print $output;
1659        }
1660    } else {
1661        return %tt_vars if $return_tt_vars;
1662        my $output = $self->process_template(
1663                                                id       => $node,
1664                                                template => "moderate_confirm.tt",
1665                                                tt_vars  => \%tt_vars,
1666                                            );
1667        return $output if $return_output;
1668        print $output;
1669    }
1670}
1671
1672=item B<moderate_node>
1673
1674  $guide->moderate_node(
1675                         id       => "FAQ",
1676                         version  => 12,
1677                         password => "beer",
1678                     );
1679
1680Marks a version of a node as moderated. Will also auto-create and Locales
1681and Categories for the newly moderated version.
1682
1683If C<password> is not supplied then a form for entering the password
1684will be displayed.
1685
1686=cut
1687
1688sub moderate_node {
1689    my ($self, %args) = @_;
1690    my $node = $args{id} or croak "No node ID supplied for node moderation";
1691    my $version = $args{version} or croak "No node version supplied for node moderation";
1692    my $return_tt_vars = $args{return_tt_vars} || 0;
1693    my $return_output = $args{return_output} || 0;
1694
1695    # Set up the TT variables
1696    my %tt_vars = (
1697                      not_editable  => 1,
1698                      not_deletable => 1,
1699                      deter_robots  => 1,
1700                      version       => $version,
1701                      moderation_action => 'moderate',
1702                      moderation_url_args => 'action=moderate;version='.$version
1703                  );
1704
1705    my $password = $args{password};
1706    unless($self->config->moderation_requires_password) {
1707        $password = $self->config->admin_pass;
1708    }
1709
1710    if ($password) {
1711        if ($password ne $self->config->admin_pass) {
1712            return %tt_vars if $return_tt_vars;
1713            my $output = $self->process_template(
1714                                                    id       => $node,
1715                                                    template => "moderate_password_wrong.tt",
1716                                                    tt_vars  => \%tt_vars,
1717                                                );
1718            return $output if $return_output;
1719            print $output;
1720        } else {
1721            $self->wiki->moderate_node(
1722                                        name    => $node,
1723                                        version => $version
1724                                    );
1725
1726            # Create any categories or locales for it
1727            my %details = $self->wiki->retrieve_node(
1728                                        name    => $node,
1729                                        version => $version
1730                                    );
1731            $self->_autoCreateCategoryLocale(
1732                                          id       => $node,
1733                                          metadata => $details{'metadata'}
1734            );
1735
1736            # Send back to the admin interface
1737            my $script_url = $self->config->script_url;
1738            my $script_name = $self->config->script_name;
1739            my $q = CGI->new;
1740            my $output = $q->redirect( $script_url.$script_name."?action=admin;moderation=moderated" );
1741            return $output if $return_output;
1742            print $output;
1743        }
1744    } else {
1745        return %tt_vars if $return_tt_vars;
1746        my $output = $self->process_template(
1747                                                id       => $node,
1748                                                template => "moderate_confirm.tt",
1749                                                tt_vars  => \%tt_vars,
1750                                            );
1751        return $output if $return_output;
1752        print $output;
1753    }
1754}
1755
1756=item B<show_missing_metadata>
1757
1758Search for nodes which don't have a certain kind of metadata. Optionally
1759also excludes Locales and Categories
1760
1761=cut
1762
1763sub show_missing_metadata {
1764    my ($self, %args) = @_;
1765    my $return_tt_vars = $args{return_tt_vars} || 0;
1766    my $return_output = $args{return_output} || 0;
1767
1768    my $wiki = $self->wiki;
1769    my $formatter = $self->wiki->formatter;
1770    my $script_name = $self->config->script_name;
1771
1772    my ($metadata_type, $metadata_value, $exclude_locales, $exclude_categories)
1773        = @args{ qw( metadata_type metadata_value exclude_locales exclude_categories ) };
1774
1775    my @nodes;
1776    my $done_search = 0;
1777
1778    # Only search if they supplied at least a metadata type
1779    if($metadata_type) {
1780        $done_search = 1;
1781        @nodes = $wiki->list_nodes_by_missing_metadata(
1782                            metadata_type => $metadata_type,
1783                            metadata_value => $metadata_value,
1784                            ignore_case    => 1,
1785        );
1786
1787        # Do we need to filter some nodes out?
1788        if($exclude_locales || $exclude_categories) {
1789            my @all_nodes = @nodes;
1790            @nodes = ();
1791
1792            foreach my $node (@all_nodes) {
1793                if($exclude_locales && $node =~ /^Locale /) { next; }
1794                if($exclude_categories && $node =~ /^Category /) { next; }
1795                push @nodes, $node;
1796            }
1797        }
1798    }
1799
1800    # Build nice edit etc links for our nodes
1801    my @tt_nodes;
1802    for my $node (@nodes) {
1803        my %n;
1804
1805        # Make the URLs
1806        my $node_param = uri_escape( $formatter->node_name_to_node_param( $node ) );
1807
1808        # Save into the hash
1809        $n{'name'} = $node;
1810        $n{'view_url'} = $script_name . "?id=" . $node_param;
1811        $n{'edit_url'} = $script_name . "?id=" . $node_param . ";action=edit";
1812        push @tt_nodes, \%n;
1813    }
1814
1815    # Set up our TT variables, including the search parameters
1816    my %tt_vars = (
1817                      not_editable  => 1,
1818                      not_deletable => 1,
1819                      deter_robots  => 1,
1820
1821                      nodes => \@tt_nodes,
1822                      done_search    => $done_search,
1823                      metadata_type  => $metadata_type,
1824                      metadata_value => $metadata_value,
1825                      exclude_locales => $exclude_locales,
1826                      exclude_categories => $exclude_categories,
1827
1828                      script_name => $script_name
1829                  );
1830    return %tt_vars if $return_tt_vars;
1831
1832    # Render to the page
1833    my $output = $self->process_template(
1834                                           id       => "",
1835                                           template => "missing_metadata.tt",
1836                                           tt_vars  => \%tt_vars,
1837                                        );
1838    return $output if $return_output;
1839    print $output;
1840}
1841
1842=item B<revert_user_interface>
1843
1844If C<password> is not supplied then a form for entering the password
1845will be displayed, along with a list of all the edits the user made.
1846
1847If the password is given, will delete all of these versions.
1848=cut
1849sub revert_user_interface {
1850    my ($self, %args) = @_;
1851
1852    my $password = $args{password} || '';
1853    my $return_tt_vars = $args{return_tt_vars} || 0;
1854    my $return_output = $args{return_output} || 0;
1855
1856    my $wiki = $self->wiki;
1857    my $formatter = $self->wiki->formatter;
1858    my $script_name = $self->config->script_name;
1859
1860    my ($type,$value);
1861    if($args{'username'}) {
1862        ($type,$value) = ('username', $args{'username'});
1863    }
1864    if($args{'host'}) {
1865        ($type,$value) = ('host', $args{'host'});
1866    }
1867    unless($type && $value) {
1868        croak("One of username or host must be given");
1869    }
1870
1871    # Grab everything they've touched, ever
1872    my @user_edits = $self->wiki->list_recent_changes(
1873                            since => 1,
1874                            metadata_was => { $type => $value },
1875    );
1876
1877    if ($password) {
1878        if ($password ne $self->config->admin_pass) {
1879            croak("Bad password supplied");
1880        } else {
1881            # Delete all these versions
1882            foreach my $edit (@user_edits) {
1883                $self->wiki->delete_node(
1884                                name => $edit->{name},
1885                                version => $edit->{version},
1886                );
1887            }
1888
1889            # Grab new list
1890            @user_edits = $self->wiki->list_recent_changes(
1891                            since => 1,
1892                            metadata_was => { $type => $value },
1893            );
1894        }
1895    } else {
1896        # Don't do anything
1897    }
1898
1899    # Set up our TT variables, including the search parameters
1900    my %tt_vars = (
1901                      not_editable  => 1,
1902                      not_deletable => 1,
1903                      deter_robots  => 1,
1904
1905                      edits          => \@user_edits,
1906                      username       => $args{username},
1907                      host           => $args{host},
1908                      by_type        => $type,
1909                      by             => $value,
1910
1911                      script_name => $script_name
1912                  );
1913    return %tt_vars if $return_tt_vars;
1914
1915    # Render to the page
1916    my $output = $self->process_template(
1917                                           id       => "",
1918                                           template => "admin_revert_user.tt",
1919                                           tt_vars  => \%tt_vars,
1920                                        );
1921    return $output if $return_output;
1922    print $output;
1923}
1924
1925=item B<display_admin_interface>
1926
1927Fetch everything we need to display the admin interface, and passes it off
1928 to the template
1929
1930=cut
1931
1932sub display_admin_interface {
1933    my ($self, %args) = @_;
1934    my $return_tt_vars = $args{return_tt_vars} || 0;
1935    my $return_output = $args{return_output} || 0;
1936
1937    my $wiki = $self->wiki;
1938    my $formatter = $self->wiki->formatter;
1939    my $script_name = $self->config->script_name;
1940
1941    # Grab all the recent nodes
1942    my @all_nodes = $wiki->list_recent_changes(last_n_changes => 100);
1943
1944    # Split into nodes, Locales and Categories
1945    my @nodes;
1946    my @categories;
1947    my @locales;
1948    for my $node (@all_nodes) {
1949        # Add moderation status
1950        $node->{'moderate'} = $wiki->node_required_moderation($node->{'name'});
1951
1952        # Make the URLs
1953        my $node_param = uri_escape( $formatter->node_name_to_node_param( $node->{'name'} ) );
1954        $node->{'view_url'} = $script_name . "?id=" . $node_param;
1955        $node->{'versions_url'} = $script_name .
1956                        "?action=list_all_versions;id=" . $node_param;
1957        $node->{'moderation_url'} = $script_name .
1958                        "?action=set_moderation;id=" . $node_param;
1959        $node->{'revert_user_url'} = $script_name . "?action=revert_user" .
1960                        ";username=".$node->{metadata}->{username}->[0];
1961
1962        # Filter
1963        if($node->{'name'} =~ /^Category /) {
1964            $node->{'page_name'} = $node->{'name'};
1965            $node->{'name'} =~ s/^Category //;
1966            push @categories, $node;
1967        } elsif($node->{'name'} =~ /^Locale /) {
1968            $node->{'page_name'} = $node->{'name'};
1969            $node->{'name'} =~ s/^Locale //;
1970            push @locales, $node;
1971        } else {
1972            push @nodes, $node;
1973        }
1974    }
1975
1976    # Handle completed notice for actions
1977    my $completed_action = "";
1978    if($args{moderation_completed}) {
1979        if($args{moderation_completed} eq "moderation") {
1980            $completed_action = "Version moderated";
1981        }
1982        if($args{moderation_completed} eq "changed") {
1983            $completed_action = "Node moderation flag changed";
1984        }
1985        if($args{moderation_completed} eq "unknown_node") {
1986            $completed_action = "Node moderation flag not changed, node not known";
1987        }
1988    }
1989
1990    # Render in a template
1991    my %tt_vars = (
1992                      not_editable  => 1,
1993                      not_deletable => 1,
1994                      deter_robots  => 1,
1995                      nodes      => \@nodes,
1996                      categories => \@categories,
1997                      locales    => \@locales,
1998                      completed_action => $completed_action
1999                  );
2000    return %tt_vars if $return_tt_vars;
2001    my $output = $self->process_template(
2002                                           id       => "",
2003                                           template => "admin_home.tt",
2004                                           tt_vars  => \%tt_vars,
2005                                        );
2006    return $output if $return_output;
2007    print $output;
2008}
2009
2010sub process_template {
2011    my ($self, %args) = @_;
2012    my %output_conf = (
2013                          wiki     => $self->wiki,
2014                          config   => $self->config,
2015                          node     => $args{id},
2016                          template => $args{template},
2017                          vars     => $args{tt_vars},
2018                          cookies  => $args{cookies},
2019                      );
2020    if ( $args{content_type} ) {
2021        $output_conf{content_type} = $args{content_type};
2022    }
2023    return OpenGuides::Template->output( %output_conf );
2024}
2025
2026sub redirect_to_node {
2027    my ($self, $node, $redirected_from) = @_;
2028   
2029    my $script_url = $self->config->script_url;
2030    my $script_name = $self->config->script_name;
2031    my $formatter = $self->wiki->formatter;
2032
2033    my $id = $formatter->node_name_to_node_param( $node );
2034    my $oldid;
2035    $oldid = $formatter->node_name_to_node_param( $redirected_from ) if $redirected_from;
2036
2037    my $redir_param = "$script_url$script_name?";
2038    $redir_param .= 'id=' if $oldid;
2039    $redir_param .= $id;
2040    $redir_param .= ";oldid=$oldid" if $oldid;
2041   
2042    my $q = CGI->new;
2043    return $q->redirect( $redir_param );
2044}
2045
2046sub get_cookie {
2047    my $self = shift;
2048    my $config = $self->config;
2049    my $pref_name = shift or return "";
2050    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
2051    return $cookie_data{$pref_name};
2052}
2053
2054
2055=head1 BUGS AND CAVEATS
2056
2057UTF8 data are currently not handled correctly throughout.
2058
2059Other bugs are documented at
2060L<http://dev.openguides.org/>
2061
2062=head1 SEE ALSO
2063
2064=over 4
2065
2066=item * L<http://london.openguides.org/|The Open Guide to London>, the first and biggest OpenGuides site.
2067
2068=item * L<http://openguides.org/|The OpenGuides website>, with a list of all live OpenGuides installs.
2069
2070=item * L<Wiki::Toolkit>, the Wiki toolkit which does the heavy lifting for OpenGuides
2071
2072=back
2073
2074=head1 FEEDBACK
2075
2076If you have a question, a bug report, or a patch, or you're interested
2077in joining the development team, please contact openguides-dev@lists.openguides.org
2078(moderated mailing list, will reach all current developers but you'll have
2079to wait for your post to be approved) or file a bug report at
2080L<http://dev.openguides.org/>
2081
2082=head1 AUTHOR
2083
2084The OpenGuides Project (openguides-dev@lists.openguides.org)
2085
2086=head1 COPYRIGHT
2087
2088     Copyright (C) 2003-2007 The OpenGuides Project.  All Rights Reserved.
2089
2090The OpenGuides distribution is free software; you can redistribute it
2091and/or modify it under the same terms as Perl itself.
2092
2093=head1 CREDITS
2094
2095Programming by Dominic Hargreaves, Earle Martin, Kake Pugh, and Ivor
2096Williams.  Testing and bug reporting by Billy Abbott, Jody Belka,
2097Kerry Bosworth, Simon Cozens, Cal Henderson, Steve Jolly, and Bob
2098Walker (among others).  Much of the Module::Build stuff copied from
2099the Siesta project L<http://siesta.unixbeard.net/>
2100
2101=cut
2102
21031;
Note: See TracBrowser for help on using the repository browser.