source: trunk/lib/OpenGuides.pm @ 1044

Last change on this file since 1044 was 1044, checked in by kake, 15 years ago

Fix uninitialized value warning in test 53 (fixes #168).

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