source: trunk/lib/OpenGuides.pm @ 874

Last change on this file since 874 was 874, checked in by nick, 15 years ago

Add ping support

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