source: trunk/lib/OpenGuides.pm @ 1227

Last change on this file since 1227 was 1227, checked in by nick, 13 years ago

Start to support metadata discovery stuff

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