source: trunk/lib/OpenGuides.pm @ 974

Last change on this file since 974 was 974, checked in by Dominic Hargreaves, 15 years ago

Bump version number

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