source: trunk/lib/OpenGuides.pm @ 1027

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

Added category and locale parameters to action=random and made a new macro to go with it.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 73.1 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.59';
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-2006, <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
1243The geographical data that you should provide in the L<CGI> object
1244depends on the handler you chose in C<wiki.conf>.
1245
1246=over
1247
1248=item *
1249
1250B<British National Grid> - provide either C<os_x> and C<os_y> or
1251C<latitude> and C<longitude>; whichever set of data you give, it will
1252be converted to the other and both sets will be stored.
1253
1254=item *
1255
1256B<Irish National Grid> - provide either C<osie_x> and C<osie_y> or
1257C<latitude> and C<longitude>; whichever set of data you give, it will
1258be converted to the other and both sets will be stored.
1259
1260=item *
1261
1262B<UTM ellipsoid> - provide C<latitude> and C<longitude>; these will be
1263converted to easting and northing and both sets of data will be stored.
1264
1265=back
1266
1267=cut
1268
1269sub commit_node {
1270    my ($self, %args) = @_;
1271    my $node = $args{id};
1272    my $q = $args{cgi_obj};
1273    my $return_output = $args{return_output};
1274    my $wiki = $self->wiki;
1275    my $config = $self->config;
1276
1277    my $content  = $q->param("content");
1278    $content =~ s/\r\n/\n/gs;
1279    my $checksum = $q->param("checksum");
1280
1281    my %new_metadata = OpenGuides::Template->extract_metadata_vars(
1282        wiki    => $wiki,
1283        config  => $config,
1284        cgi_obj => $q
1285    );
1286
1287    delete $new_metadata{website} if $new_metadata{website} eq 'http://';
1288
1289    $new_metadata{opening_hours_text} = $q->param("hours_text") || "";
1290
1291    # Pick out the unmunged versions of lat/long if they're set.
1292    # (If they're not, it means they weren't munged in the first place.)
1293    $new_metadata{latitude} = delete $new_metadata{latitude_unmunged}
1294        if $new_metadata{latitude_unmunged};
1295    $new_metadata{longitude} = delete $new_metadata{longitude_unmunged}
1296        if $new_metadata{longitude_unmunged};
1297
1298    # Check to make sure all the indexable nodes are created
1299    # Skip this for nodes needing moderation - this occurs for them once
1300    #  they've been moderated
1301    unless($wiki->node_required_moderation($node)) {
1302        $self->_autoCreateCategoryLocale(
1303                                          id       => $node,
1304                                          metadata => \%new_metadata
1305        );
1306    }
1307   
1308    foreach my $var ( qw( summary username comment edit_type ) ) {
1309        $new_metadata{$var} = $q->param($var) || "";
1310    }
1311    $new_metadata{host} = $ENV{REMOTE_ADDR};
1312
1313    # Wiki::Toolkit::Plugin::RSS::ModWiki wants "major_change" to be set.
1314    $new_metadata{major_change} = ( $new_metadata{edit_type} eq "Normal edit" )
1315                                    ? 1
1316                                    : 0;
1317
1318    my $written = $wiki->write_node( $node, $content, $checksum,
1319                                     \%new_metadata );
1320
1321    if ($written) {
1322        my $output = $self->redirect_to_node($node);
1323        return $output if $return_output;
1324        print $output;
1325    } else {
1326        return $self->_handle_edit_conflict(
1327                                             id            => $node,
1328                                             content       => $content,
1329                                             new_metadata  => \%new_metadata,
1330                                             return_output => $return_output,
1331                                           );
1332    }
1333}
1334
1335sub _handle_edit_conflict {
1336    my ($self, %args) = @_;
1337    my $return_output = $args{return_output} || 0;
1338    my $config = $self->config;
1339    my $wiki = $self->wiki;
1340    my $node = $args{id};
1341    my $content = $args{content};
1342    my %new_metadata = %{$args{new_metadata}};
1343
1344    my %node_data = $wiki->retrieve_node($node);
1345    my %tt_vars = ( checksum       => $node_data{checksum},
1346                    new_content    => $content,
1347                    content        => $node_data{content} );
1348    my %old_metadata = OpenGuides::Template->extract_metadata_vars(
1349                                           wiki     => $wiki,
1350                                           config   => $config,
1351                                           metadata => $node_data{metadata} );
1352    # Make sure we look at all variables.
1353    my @tmp = (keys %new_metadata, keys %old_metadata );
1354    my %tmp_hash = map { $_ => 1; } @tmp;
1355    my @all_vars = keys %tmp_hash;
1356
1357    foreach my $mdvar ( keys %new_metadata ) {
1358        if ($mdvar eq "locales") {
1359            $tt_vars{$mdvar} = $old_metadata{locales};
1360            $tt_vars{"new_$mdvar"} = $new_metadata{locale};
1361        } elsif ($mdvar eq "categories") {
1362            $tt_vars{$mdvar} = $old_metadata{categories};
1363            $tt_vars{"new_$mdvar"} = $new_metadata{category};
1364        } elsif ($mdvar eq "username" or $mdvar eq "comment"
1365                  or $mdvar eq "edit_type" ) {
1366            $tt_vars{$mdvar} = $new_metadata{$mdvar};
1367        } else {
1368            $tt_vars{$mdvar} = $old_metadata{$mdvar};
1369            $tt_vars{"new_$mdvar"} = $new_metadata{$mdvar};
1370        }
1371    }
1372
1373    $tt_vars{coord_field_1} = $old_metadata{coord_field_1};
1374    $tt_vars{coord_field_2} = $old_metadata{coord_field_2};
1375    $tt_vars{coord_field_1_value} = $old_metadata{coord_field_1_value};
1376    $tt_vars{coord_field_2_value} = $old_metadata{coord_field_2_value};
1377    $tt_vars{"new_coord_field_1_value"}
1378                                = $new_metadata{$old_metadata{coord_field_1}};
1379    $tt_vars{"new_coord_field_2_value"}
1380                                = $new_metadata{$old_metadata{coord_field_2}};
1381
1382    $tt_vars{conflict} = 1;
1383    return %tt_vars if $args{return_tt_vars};
1384    my $output = $self->process_template(
1385                                          id       => $node,
1386                                          template => "edit_form.tt",
1387                                          tt_vars  => \%tt_vars,
1388                                        );
1389    return $output if $args{return_output};
1390    print $output;
1391}
1392
1393=item B<_autoCreateCategoryLocale>
1394
1395  $guide->_autoCreateCategoryLocale(
1396                         id       => "FAQ",
1397                         metadata => \%metadata,
1398                     );
1399
1400When a new node is added, or a previously un-moderated node is moderated,
1401identifies if any of its Categories or Locales are missing, and creates them.
1402
1403Guide admins can control the text that gets put into the content field of the
1404autocreated node by putting it in custom_autocreate_content.tt in their custom
1405templates directory.  The following TT variables will be available to the
1406template:
1407
1408=over
1409
1410=item * index_type (e.g. C<Category>)
1411
1412=item * index_value (e.g. C<Vegan-friendly>)
1413
1414=item * node_name (e.g. C<Category Vegan-Friendly>)
1415
1416=back
1417
1418(Note capitalisation - index_value is what they typed in to the form, and
1419node_name is the fully free-upper-ed name of the autocreated node.)
1420
1421For nodes not requiring moderation, should be called on writing the node
1422For nodes requiring moderation, should only be called on moderation
1423
1424=cut
1425
1426sub _autoCreateCategoryLocale {
1427    my ($self, %args) = @_;
1428
1429    my $wiki = $self->wiki;
1430    my $id = $args{'id'};
1431    my %metadata = %{$args{'metadata'}};
1432
1433    # Check to make sure all the indexable nodes are created
1434    my $config = $self->config;
1435    my $template_path = $config->template_path;
1436    my $custom_template_path = $config->custom_template_path || "";
1437    my $tt = Template->new( { INCLUDE_PATH =>
1438                                  "$custom_template_path:$template_path" } );
1439
1440    foreach my $type (qw(Category Locale)) {
1441        my $lctype = lc($type);
1442        foreach my $index (@{$metadata{$lctype}}) {
1443            $index =~ s/(.*)/\u$1/;
1444            my $node = $type . " " . $index;
1445            # Uppercase the node name before checking for existence
1446            $node = $wiki->formatter->_do_freeupper( $node );
1447            unless ( $wiki->node_exists($node) ) {
1448                my $category = $type eq "Category" ? "Category" : "Locales";
1449                # Try to get the autocreated content from a custom template;
1450                # if we fail, use some default text.
1451                my $blurb;
1452                my %tt_vars = (
1453                                index_type  => $type,
1454                                index_value => $index,
1455                                node_name   => $node,
1456                              );
1457                my $ok = $tt->process( "custom_autocreate_content.tt",
1458                                       \%tt_vars, \$blurb );
1459                if ( !$ok ) {
1460                    $blurb = "\@INDEX_LINK [[$node]]";
1461                }
1462                $wiki->write_node(
1463                                     $node,
1464                                     $blurb,
1465                                     undef,
1466                                     {
1467                                         username => "Auto Create",
1468                                         comment  => "Auto created $lctype stub page",
1469                                         category => $category
1470                                     }
1471                );
1472            }
1473        }
1474    }
1475}
1476
1477
1478=item B<delete_node>
1479
1480  $guide->delete_node(
1481                         id       => "FAQ",
1482                         version  => 15,
1483                         password => "beer",
1484                     );
1485
1486C<version> is optional - if it isn't supplied then all versions of the
1487node will be deleted; in other words the node will be entirely
1488removed.
1489
1490If C<password> is not supplied then a form for entering the password
1491will be displayed.
1492
1493As with other methods, parameters C<return_tt_vars> and
1494C<return_output> can be used to return these things instead of
1495printing the output to STDOUT.
1496
1497=cut
1498
1499sub delete_node {
1500    my ($self, %args) = @_;
1501    my $node = $args{id} or croak "No node ID supplied for deletion";
1502    my $return_tt_vars = $args{return_tt_vars} || 0;
1503    my $return_output = $args{return_output} || 0;
1504
1505    my %tt_vars = (
1506                      not_editable  => 1,
1507                      not_deletable => 1,
1508                      deter_robots  => 1,
1509                  );
1510    $tt_vars{delete_version} = $args{version} || "";
1511
1512    my $password = $args{password};
1513
1514    if ($password) {
1515        if ($password ne $self->config->admin_pass) {
1516            return %tt_vars if $return_tt_vars;
1517            my $output = $self->process_template(
1518                                                    id       => $node,
1519                                                    template => "delete_password_wrong.tt",
1520                                                    tt_vars  => \%tt_vars,
1521                                                );
1522            return $output if $return_output;
1523            print $output;
1524        } else {
1525            $self->wiki->delete_node(
1526                                        name    => $node,
1527                                        version => $args{version},
1528                                    );
1529            # Check whether any versions of this node remain.
1530            my %check = $self->wiki->retrieve_node( name => $node );
1531            $tt_vars{other_versions_remain} = 1 if $check{version};
1532            return %tt_vars if $return_tt_vars;
1533            my $output = $self->process_template(
1534                                                    id       => $node,
1535                                                    template => "delete_done.tt",
1536                                                    tt_vars  => \%tt_vars,
1537                                                );
1538            return $output if $return_output;
1539            print $output;
1540        }
1541    } else {
1542        return %tt_vars if $return_tt_vars;
1543        my $output = $self->process_template(
1544                                                id       => $node,
1545                                                template => "delete_confirm.tt",
1546                                                tt_vars  => \%tt_vars,
1547                                            );
1548        return $output if $return_output;
1549        print $output;
1550    }
1551}
1552
1553=item B<set_node_moderation>
1554
1555  $guide->set_node_moderation(
1556                         id       => "FAQ",
1557                         password => "beer",
1558                         moderation_flag => 1,
1559                     );
1560
1561Sets the moderation needed flag on a node, either on or off.
1562
1563If C<password> is not supplied then a form for entering the password
1564will be displayed.
1565
1566=cut
1567
1568sub set_node_moderation {
1569    my ($self, %args) = @_;
1570    my $node = $args{id} or croak "No node ID supplied for node moderation";
1571    my $return_tt_vars = $args{return_tt_vars} || 0;
1572    my $return_output = $args{return_output} || 0;
1573
1574    # Get the moderation flag into something sane
1575    if($args{moderation_flag} eq "1" || $args{moderation_flag} eq "yes" ||
1576       $args{moderation_flag} eq "on" || $args{moderation_flag} eq "true") {
1577        $args{moderation_flag} = 1;
1578    } else {
1579        $args{moderation_flag} = 0;
1580    }
1581
1582    # Set up the TT variables
1583    my %tt_vars = (
1584                      not_editable  => 1,
1585                      not_deletable => 1,
1586                      deter_robots  => 1,
1587                      moderation_action => 'set_moderation',
1588                      moderation_flag   => $args{moderation_flag},
1589                      moderation_url_args => 'action=set_moderation;moderation_flag='.$args{moderation_flag},
1590                  );
1591
1592    my $password = $args{password};
1593
1594    if ($password) {
1595        if ($password ne $self->config->admin_pass) {
1596            return %tt_vars if $return_tt_vars;
1597            my $output = $self->process_template(
1598                                                    id       => $node,
1599                                                    template => "moderate_password_wrong.tt",
1600                                                    tt_vars  => \%tt_vars,
1601                                                );
1602            return $output if $return_output;
1603            print $output;
1604        } else {
1605            my $worked = $self->wiki->set_node_moderation(
1606                                        name    => $node,
1607                                        required => $args{moderation_flag},
1608                         );
1609            my $moderation_flag = "changed";
1610            unless($worked) {
1611                $moderation_flag = "unknown_node";
1612                warn("Tried to set moderation status on node '$node', which doesn't exist");
1613            }
1614
1615            # Send back to the admin interface
1616            my $script_url = $self->config->script_url;
1617            my $script_name = $self->config->script_name;
1618            my $q = CGI->new;
1619            my $output = $q->redirect( $script_url.$script_name."?action=admin;moderation=".$moderation_flag );
1620            return $output if $return_output;
1621            print $output;
1622        }
1623    } else {
1624        return %tt_vars if $return_tt_vars;
1625        my $output = $self->process_template(
1626                                                id       => $node,
1627                                                template => "moderate_confirm.tt",
1628                                                tt_vars  => \%tt_vars,
1629                                            );
1630        return $output if $return_output;
1631        print $output;
1632    }
1633}
1634
1635=item B<moderate_node>
1636
1637  $guide->moderate_node(
1638                         id       => "FAQ",
1639                         version  => 12,
1640                         password => "beer",
1641                     );
1642
1643Marks a version of a node as moderated. Will also auto-create and Locales
1644and Categories for the newly moderated version.
1645
1646If C<password> is not supplied then a form for entering the password
1647will be displayed.
1648
1649=cut
1650
1651sub moderate_node {
1652    my ($self, %args) = @_;
1653    my $node = $args{id} or croak "No node ID supplied for node moderation";
1654    my $version = $args{version} or croak "No node version supplied for node moderation";
1655    my $return_tt_vars = $args{return_tt_vars} || 0;
1656    my $return_output = $args{return_output} || 0;
1657
1658    # Set up the TT variables
1659    my %tt_vars = (
1660                      not_editable  => 1,
1661                      not_deletable => 1,
1662                      deter_robots  => 1,
1663                      version       => $version,
1664                      moderation_action => 'moderate',
1665                      moderation_url_args => 'action=moderate;version='.$version
1666                  );
1667
1668    my $password = $args{password};
1669    unless($self->config->moderation_requires_password) {
1670        $password = $self->config->admin_pass;
1671    }
1672
1673    if ($password) {
1674        if ($password ne $self->config->admin_pass) {
1675            return %tt_vars if $return_tt_vars;
1676            my $output = $self->process_template(
1677                                                    id       => $node,
1678                                                    template => "moderate_password_wrong.tt",
1679                                                    tt_vars  => \%tt_vars,
1680                                                );
1681            return $output if $return_output;
1682            print $output;
1683        } else {
1684            $self->wiki->moderate_node(
1685                                        name    => $node,
1686                                        version => $version
1687                                    );
1688
1689            # Create any categories or locales for it
1690            my %details = $self->wiki->retrieve_node(
1691                                        name    => $node,
1692                                        version => $version
1693                                    );
1694            $self->_autoCreateCategoryLocale(
1695                                          id       => $node,
1696                                          metadata => $details{'metadata'}
1697            );
1698
1699            # Send back to the admin interface
1700            my $script_url = $self->config->script_url;
1701            my $script_name = $self->config->script_name;
1702            my $q = CGI->new;
1703            my $output = $q->redirect( $script_url.$script_name."?action=admin;moderation=moderated" );
1704            return $output if $return_output;
1705            print $output;
1706        }
1707    } else {
1708        return %tt_vars if $return_tt_vars;
1709        my $output = $self->process_template(
1710                                                id       => $node,
1711                                                template => "moderate_confirm.tt",
1712                                                tt_vars  => \%tt_vars,
1713                                            );
1714        return $output if $return_output;
1715        print $output;
1716    }
1717}
1718
1719=item B<show_missing_metadata>
1720
1721Search for nodes which don't have a certain kind of metadata. Optionally
1722also excludes Locales and Categories
1723
1724=cut
1725
1726sub show_missing_metadata {
1727    my ($self, %args) = @_;
1728    my $return_tt_vars = $args{return_tt_vars} || 0;
1729    my $return_output = $args{return_output} || 0;
1730
1731    my $wiki = $self->wiki;
1732    my $formatter = $self->wiki->formatter;
1733    my $script_name = $self->config->script_name;
1734
1735    my ($metadata_type, $metadata_value, $exclude_locales, $exclude_categories)
1736        = @args{ qw( metadata_type metadata_value exclude_locales exclude_categories ) };
1737
1738    my @nodes;
1739    my $done_search = 0;
1740
1741    # Only search if they supplied at least a metadata type
1742    if($metadata_type) {
1743        $done_search = 1;
1744        @nodes = $wiki->list_nodes_by_missing_metadata(
1745                            metadata_type => $metadata_type,
1746                            metadata_value => $metadata_value,
1747                            ignore_case    => 1,
1748        );
1749
1750        # Do we need to filter some nodes out?
1751        if($exclude_locales || $exclude_categories) {
1752            my @all_nodes = @nodes;
1753            @nodes = ();
1754
1755            foreach my $node (@all_nodes) {
1756                if($exclude_locales && $node =~ /^Locale /) { next; }
1757                if($exclude_categories && $node =~ /^Category /) { next; }
1758                push @nodes, $node;
1759            }
1760        }
1761    }
1762
1763    # Build nice edit etc links for our nodes
1764    my @tt_nodes;
1765    for my $node (@nodes) {
1766        my %n;
1767
1768        # Make the URLs
1769        my $node_param = uri_escape( $formatter->node_name_to_node_param( $node ) );
1770
1771        # Save into the hash
1772        $n{'name'} = $node;
1773        $n{'view_url'} = $script_name . "?id=" . $node_param;
1774        $n{'edit_url'} = $script_name . "?id=" . $node_param . ";action=edit";
1775        push @tt_nodes, \%n;
1776    }
1777
1778    # Set up our TT variables, including the search parameters
1779    my %tt_vars = (
1780                      not_editable  => 1,
1781                      not_deletable => 1,
1782                      deter_robots  => 1,
1783
1784                      nodes => \@tt_nodes,
1785                      done_search    => $done_search,
1786                      metadata_type  => $metadata_type,
1787                      metadata_value => $metadata_value,
1788                      exclude_locales => $exclude_locales,
1789                      exclude_categories => $exclude_categories,
1790
1791                      script_name => $script_name
1792                  );
1793    return %tt_vars if $return_tt_vars;
1794
1795    # Render to the page
1796    my $output = $self->process_template(
1797                                           id       => "",
1798                                           template => "missing_metadata.tt",
1799                                           tt_vars  => \%tt_vars,
1800                                        );
1801    return $output if $return_output;
1802    print $output;
1803}
1804
1805=item B<revert_user_interface>
1806
1807If C<password> is not supplied then a form for entering the password
1808will be displayed, along with a list of all the edits the user made.
1809
1810If the password is given, will delete all of these versions.
1811=cut
1812sub revert_user_interface {
1813    my ($self, %args) = @_;
1814
1815    my $password = $args{password} || '';
1816    my $return_tt_vars = $args{return_tt_vars} || 0;
1817    my $return_output = $args{return_output} || 0;
1818
1819    my $wiki = $self->wiki;
1820    my $formatter = $self->wiki->formatter;
1821    my $script_name = $self->config->script_name;
1822
1823    my ($type,$value);
1824    if($args{'username'}) {
1825        ($type,$value) = ('username', $args{'username'});
1826    }
1827    if($args{'host'}) {
1828        ($type,$value) = ('host', $args{'host'});
1829    }
1830    unless($type && $value) {
1831        croak("One of username or host must be given");
1832    }
1833
1834    # Grab everything they've touched, ever
1835    my @user_edits = $self->wiki->list_recent_changes(
1836                            since => 1,
1837                            metadata_was => { $type => $value },
1838    );
1839
1840    if ($password) {
1841        if ($password ne $self->config->admin_pass) {
1842            croak("Bad password supplied");
1843        } else {
1844            # Delete all these versions
1845            foreach my $edit (@user_edits) {
1846                $self->wiki->delete_node(
1847                                name => $edit->{name},
1848                                version => $edit->{version},
1849                );
1850            }
1851
1852            # Grab new list
1853            @user_edits = $self->wiki->list_recent_changes(
1854                            since => 1,
1855                            metadata_was => { $type => $value },
1856            );
1857        }
1858    } else {
1859        # Don't do anything
1860    }
1861
1862    # Set up our TT variables, including the search parameters
1863    my %tt_vars = (
1864                      not_editable  => 1,
1865                      not_deletable => 1,
1866                      deter_robots  => 1,
1867
1868                      edits          => \@user_edits,
1869                      username       => $args{username},
1870                      host           => $args{host},
1871                      by_type        => $type,
1872                      by             => $value,
1873
1874                      script_name => $script_name
1875                  );
1876    return %tt_vars if $return_tt_vars;
1877
1878    # Render to the page
1879    my $output = $self->process_template(
1880                                           id       => "",
1881                                           template => "admin_revert_user.tt",
1882                                           tt_vars  => \%tt_vars,
1883                                        );
1884    return $output if $return_output;
1885    print $output;
1886}
1887
1888=item B<display_admin_interface>
1889
1890Fetch everything we need to display the admin interface, and passes it off
1891 to the template
1892
1893=cut
1894
1895sub display_admin_interface {
1896    my ($self, %args) = @_;
1897    my $return_tt_vars = $args{return_tt_vars} || 0;
1898    my $return_output = $args{return_output} || 0;
1899
1900    my $wiki = $self->wiki;
1901    my $formatter = $self->wiki->formatter;
1902    my $script_name = $self->config->script_name;
1903
1904    # Grab all the recent nodes
1905    my @all_nodes = $wiki->list_recent_changes(last_n_changes => 100);
1906
1907    # Split into nodes, Locales and Categories
1908    my @nodes;
1909    my @categories;
1910    my @locales;
1911    for my $node (@all_nodes) {
1912        # Add moderation status
1913        $node->{'moderate'} = $wiki->node_required_moderation($node->{'name'});
1914
1915        # Make the URLs
1916        my $node_param = uri_escape( $formatter->node_name_to_node_param( $node->{'name'} ) );
1917        $node->{'view_url'} = $script_name . "?id=" . $node_param;
1918        $node->{'versions_url'} = $script_name .
1919                        "?action=list_all_versions;id=" . $node_param;
1920        $node->{'moderation_url'} = $script_name .
1921                        "?action=set_moderation;id=" . $node_param;
1922        $node->{'revert_user_url'} = $script_name . "?action=revert_user" .
1923                        ";username=".$node->{metadata}->{username}->[0];
1924
1925        # Filter
1926        if($node->{'name'} =~ /^Category /) {
1927            $node->{'page_name'} = $node->{'name'};
1928            $node->{'name'} =~ s/^Category //;
1929            push @categories, $node;
1930        } elsif($node->{'name'} =~ /^Locale /) {
1931            $node->{'page_name'} = $node->{'name'};
1932            $node->{'name'} =~ s/^Locale //;
1933            push @locales, $node;
1934        } else {
1935            push @nodes, $node;
1936        }
1937    }
1938
1939    # Handle completed notice for actions
1940    my $completed_action = "";
1941    if($args{moderation_completed}) {
1942        if($args{moderation_completed} eq "moderation") {
1943            $completed_action = "Version moderated";
1944        }
1945        if($args{moderation_completed} eq "changed") {
1946            $completed_action = "Node moderation flag changed";
1947        }
1948        if($args{moderation_completed} eq "unknown_node") {
1949            $completed_action = "Node moderation flag not changed, node not known";
1950        }
1951    }
1952
1953    # Render in a template
1954    my %tt_vars = (
1955                      not_editable  => 1,
1956                      not_deletable => 1,
1957                      deter_robots  => 1,
1958                      nodes      => \@nodes,
1959                      categories => \@categories,
1960                      locales    => \@locales,
1961                      completed_action => $completed_action
1962                  );
1963    return %tt_vars if $return_tt_vars;
1964    my $output = $self->process_template(
1965                                           id       => "",
1966                                           template => "admin_home.tt",
1967                                           tt_vars  => \%tt_vars,
1968                                        );
1969    return $output if $return_output;
1970    print $output;
1971}
1972
1973sub process_template {
1974    my ($self, %args) = @_;
1975    my %output_conf = (
1976                          wiki     => $self->wiki,
1977                          config   => $self->config,
1978                          node     => $args{id},
1979                          template => $args{template},
1980                          vars     => $args{tt_vars},
1981                          cookies  => $args{cookies},
1982                      );
1983    if ( $args{content_type} ) {
1984        $output_conf{content_type} = $args{content_type};
1985    }
1986    return OpenGuides::Template->output( %output_conf );
1987}
1988
1989sub redirect_to_node {
1990    my ($self, $node, $redirected_from) = @_;
1991   
1992    my $script_url = $self->config->script_url;
1993    my $script_name = $self->config->script_name;
1994    my $formatter = $self->wiki->formatter;
1995
1996    my $id = $formatter->node_name_to_node_param( $node );
1997    my $oldid;
1998    $oldid = $formatter->node_name_to_node_param( $redirected_from ) if $redirected_from;
1999
2000    my $redir_param = "$script_url$script_name?";
2001    $redir_param .= 'id=' if $oldid;
2002    $redir_param .= $id;
2003    $redir_param .= ";oldid=$oldid" if $oldid;
2004   
2005    my $q = CGI->new;
2006    return $q->redirect( $redir_param );
2007}
2008
2009sub get_cookie {
2010    my $self = shift;
2011    my $config = $self->config;
2012    my $pref_name = shift or return "";
2013    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
2014    return $cookie_data{$pref_name};
2015}
2016
2017
2018=head1 BUGS AND CAVEATS
2019
2020UTF8 data are currently not handled correctly throughout.
2021
2022Other bugs are documented at
2023L<http://dev.openguides.org/>
2024
2025=head1 SEE ALSO
2026
2027=over 4
2028
2029=item * L<http://london.openguides.org/|The Open Guide to London>, the first and biggest OpenGuides site.
2030
2031=item * L<http://openguides.org/|The OpenGuides website>, with a list of all live OpenGuides installs.
2032
2033=item * L<Wiki::Toolkit>, the Wiki toolkit which does the heavy lifting for OpenGuides
2034
2035=back
2036
2037=head1 FEEDBACK
2038
2039If you have a question, a bug report, or a patch, or you're interested
2040in joining the development team, please contact openguides-dev@lists.openguides.org
2041(moderated mailing list, will reach all current developers but you'll have
2042to wait for your post to be approved) or file a bug report at
2043L<http://dev.openguides.org/>
2044
2045=head1 AUTHOR
2046
2047The OpenGuides Project (openguides-dev@lists.openguides.org)
2048
2049=head1 COPYRIGHT
2050
2051     Copyright (C) 2003-2006 The OpenGuides Project.  All Rights Reserved.
2052
2053The OpenGuides distribution is free software; you can redistribute it
2054and/or modify it under the same terms as Perl itself.
2055
2056=head1 CREDITS
2057
2058Programming by Dominic Hargreaves, Earle Martin, Kake Pugh, and Ivor
2059Williams.  Testing and bug reporting by Billy Abbott, Jody Belka,
2060Kerry Bosworth, Simon Cozens, Cal Henderson, Steve Jolly, and Bob
2061Walker (among others).  Much of the Module::Build stuff copied from
2062the Siesta project L<http://siesta.unixbeard.net/>
2063
2064=cut
2065
20661;
Note: See TracBrowser for help on using the repository browser.