source: trunk/lib/OpenGuides.pm @ 820

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

Make it possible for a feed to override the default feed title and self url, and have the feeds do so

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 43.2 KB
Line 
1package OpenGuides;
2use strict;
3
4use Carp "croak";
5use CGI;
6use Wiki::Toolkit::Plugin::Diff;
7use Wiki::Toolkit::Plugin::Locator::Grid;
8use OpenGuides::CGI;
9use OpenGuides::Feed;
10use OpenGuides::Template;
11use OpenGuides::Utils;
12use Time::Piece;
13use URI::Escape;
14
15use vars qw( $VERSION );
16
17$VERSION = '0.56';
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    my $geo_handler = $self->config->geo_handler;
51    my $locator;
52    if ( $geo_handler == 1 ) {
53        $locator = Wiki::Toolkit::Plugin::Locator::Grid->new(
54                                             x => "os_x",    y => "os_y" );
55    } elsif ( $geo_handler == 2 ) {
56        $locator = Wiki::Toolkit::Plugin::Locator::Grid->new(
57                                             x => "osie_x",  y => "osie_y" );
58    } else {
59        $locator = Wiki::Toolkit::Plugin::Locator::Grid->new(
60                                             x => "easting", y => "northing" );
61    }
62    $wiki->register_plugin( plugin => $locator );
63    $self->{locator} = $locator;
64    my $differ = Wiki::Toolkit::Plugin::Diff->new;
65    $wiki->register_plugin( plugin => $differ );
66    $self->{differ} = $differ;
67    return $self;
68}
69
70=item B<wiki>
71
72An accessor, returns the underlying L<Wiki::Toolkit> object.
73
74=cut
75
76sub wiki {
77    my $self = shift;
78    return $self->{wiki};
79}
80
81=item B<config>
82
83An accessor, returns the underlying L<OpenGuides::Config> object.
84
85=cut
86
87sub config {
88    my $self = shift;
89    return $self->{config};
90}
91
92=item B<locator>
93
94An accessor, returns the underlying L<Wiki::Toolkit::Plugin::Locator::UK> object.
95
96=cut
97
98sub locator {
99    my $self = shift;
100    return $self->{locator};
101}
102
103=item B<differ>
104
105An accessor, returns the underlying L<Wiki::Toolkit::Plugin::Diff> object.
106
107=cut
108
109sub differ {
110    my $self = shift;
111    return $self->{differ};
112}
113
114=item B<display_node>
115
116  # Print node to STDOUT.
117  $guide->display_node(
118                          id      => "Calthorpe Arms",
119                          version => 2,
120                      );
121
122  # Or return output as a string (useful for writing tests).
123  $guide->display_node(
124                          id            => "Calthorpe Arms",
125                          return_output => 1,
126                      );
127
128  # Or return the hash of variables that will be passed to the template
129  # (not including those set additionally by OpenGuides::Template).
130  $guide->display_node(
131                          id             => "Calthorpe Arms",
132                          return_tt_vars => 1,
133                      );
134
135If C<version> is omitted then the latest version will be displayed.
136
137=cut
138
139sub display_node {
140    my ($self, %args) = @_;
141    my $return_output = $args{return_output} || 0;
142    my $version = $args{version};
143    my $id = $args{id} || $self->config->home_name;
144    my $wiki = $self->wiki;
145    my $config = $self->config;
146    my $oldid = $args{oldid} || '';
147    my $do_redirect = $args{redirect} || 1;
148
149    my %tt_vars;
150
151    if ( $id =~ /^(Category|Locale) (.*)$/ ) {
152        my $type = $1;
153        $tt_vars{is_indexable_node} = 1;
154        $tt_vars{index_type} = lc($type);
155        $tt_vars{index_value} = $2;
156        $tt_vars{"rss_".lc($type)."_url"} =
157                           $config->script_name . "?action=rc;format=rss;"
158                           . lc($type) . "=" . lc(CGI->escape($2));
159        $tt_vars{"atom_".lc($type)."_url"} =
160                           $config->script_name . "?action=rc;format=atom;"
161                           . lc($type) . "=" . lc(CGI->escape($2));
162    }
163
164    my %current_data = $wiki->retrieve_node( $id );
165    my $current_version = $current_data{version};
166    undef $version if ($version && $version == $current_version);
167    my %criteria = ( name => $id );
168    $criteria{version} = $version if $version; # retrieve_node default is current
169
170    my %node_data = $wiki->retrieve_node( %criteria );
171
172    # Fixes passing undefined values to Text::Wikiformat if node doesn't exist.
173    my $raw        = $node_data{content} || " ";
174    my $content    = $wiki->format($raw);
175    my $modified   = $node_data{last_modified};
176    my %metadata   = %{$node_data{metadata}};
177
178    my ($wgs84_long, $wgs84_lat) = OpenGuides::Utils->get_wgs84_coords(
179                                        longitude => $metadata{longitude}[0],
180                                        latitude => $metadata{latitude}[0],
181                                        config => $config);
182    if ($args{format} && $args{format} eq 'raw') {
183      print "Content-Type: text/plain\n\n";
184      print $raw;
185      return 0;
186    }
187   
188    my %metadata_vars = OpenGuides::Template->extract_metadata_vars(
189                            wiki     => $wiki,
190                            config   => $config,
191                            metadata => $node_data{metadata}
192                        );
193
194    %tt_vars = (
195                   %tt_vars,
196                   %metadata_vars,
197                   content       => $content,
198                   last_modified => $modified,
199                   version       => $node_data{version},
200                   node          => $id,
201                   language      => $config->default_language,
202                   oldid         => $oldid,
203                   enable_gmaps  => 1,
204                   display_google_maps => $self->get_cookie("display_google_maps"),
205                   wgs84_long    => $wgs84_long,
206                   wgs84_lat     => $wgs84_lat
207               );
208
209    if ( $raw =~ /^#REDIRECT\s+(.+?)\s*$/ ) {
210        my $redirect = $1;
211        # Strip off enclosing [[ ]] in case this is an extended link.
212        $redirect =~ s/^\[\[//;
213        $redirect =~ s/\]\]\s*$//;
214
215        # Don't redirect if the parameter "redirect" is given as 0.
216        if ($do_redirect == 0) {
217            return %tt_vars if $args{return_tt_vars};
218            $tt_vars{current} = 1;
219            my $output = $self->process_template(
220                                                  id            => $id,
221                                                  template      => "node.tt",
222                                                  tt_vars       => \%tt_vars,
223                                                );
224            return $output if $return_output;
225            print $output;
226        } elsif ( $wiki->node_exists($redirect) && $redirect ne $id && $redirect ne $oldid ) {
227            # Avoid loops by not generating redirects to the same node or the previous node.
228            my $output = $self->redirect_to_node($redirect, $id);
229            return $output if $return_output;
230            print $output;
231            return 0;
232        }
233    }
234
235    # We've undef'ed $version above if this is the current version.
236    $tt_vars{current} = 1 unless $version;
237
238    if ($id eq "RecentChanges") {
239        $self->display_recent_changes(%args);
240    } elsif ( $id eq $self->config->home_name ) {
241        my @recent = $wiki->list_recent_changes(
242            last_n_changes => 10,
243            metadata_was   => { edit_type => "Normal edit" },
244        );
245        @recent = map {
246                          {
247                              name          => CGI->escapeHTML($_->{name}),
248                              last_modified => CGI->escapeHTML($_->{last_modified}),
249                              version       => CGI->escapeHTML($_->{version}),
250                              comment       => CGI->escapeHTML($_->{metadata}{comment}[0]),
251                              username      => CGI->escapeHTML($_->{metadata}{username}[0]),
252                              url           => $config->script_name . "?"
253                                               . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name}))
254                          }
255                      } @recent;
256        $tt_vars{recent_changes} = \@recent;
257        return %tt_vars if $args{return_tt_vars};
258        my $output = $self->process_template(
259                                                id            => $id,
260                                                template      => "home_node.tt",
261                                                tt_vars       => \%tt_vars,
262                                            );
263        return $output if $return_output;
264        print $output;
265    } else {
266        return %tt_vars if $args{return_tt_vars};
267        my $output = $self->process_template(
268                                                id            => $id,
269                                                template      => "node.tt",
270                                                tt_vars       => \%tt_vars,
271                                            );
272        return $output if $return_output;
273        print $output;
274    }
275}
276
277=item B<display_recent_changes> 
278
279  $guide->display_recent_changes;
280
281As with other methods, the C<return_output> parameter can be used to
282return the output instead of printing it to STDOUT.
283
284=cut
285
286sub display_recent_changes {
287    my ($self, %args) = @_;
288    my $config = $self->config;
289    my $wiki = $self->wiki;
290    my $minor_edits = $self->get_cookie( "show_minor_edits_in_rc" );
291    my $id = $args{id} || $self->config->home_name;
292    my $return_output = $args{return_output} || 0;
293    my (%tt_vars, %recent_changes);
294    my $q = CGI->new;
295    my $since = $q->param("since");
296    if ( $since ) {
297        $tt_vars{since} = $since;
298        my $t = localtime($since); # overloaded by Time::Piece
299        $tt_vars{since_string} = $t->strftime;
300        my %criteria = ( since => $since );   
301        $criteria{metadata_was} = { edit_type => "Normal edit" }
302          unless $minor_edits;
303        my @rc = $self->{wiki}->list_recent_changes( %criteria );
304 
305        @rc = map {
306            {
307              name        => CGI->escapeHTML($_->{name}),
308              last_modified => CGI->escapeHTML($_->{last_modified}),
309              version     => CGI->escapeHTML($_->{version}),
310              comment     => CGI->escapeHTML($_->{metadata}{comment}[0]),
311              username    => CGI->escapeHTML($_->{metadata}{username}[0]),
312              host        => CGI->escapeHTML($_->{metadata}{host}[0]),
313              username_param => CGI->escape($_->{metadata}{username}[0]),
314              edit_type   => CGI->escapeHTML($_->{metadata}{edit_type}[0]),
315              url         => $config->script_name . "?"
316      . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name})),
317        }
318                   } @rc;
319        if ( scalar @rc ) {
320            $recent_changes{since} = \@rc; 
321        }
322    } else {
323        for my $days ( [0, 1], [1, 7], [7, 14], [14, 30] ) {
324            my %criteria = ( between_days => $days );
325            $criteria{metadata_was} = { edit_type => "Normal edit" }
326              unless $minor_edits;
327            my @rc = $self->{wiki}->list_recent_changes( %criteria );
328
329            @rc = map {
330            {
331              name        => CGI->escapeHTML($_->{name}),
332              last_modified => CGI->escapeHTML($_->{last_modified}),
333              version     => CGI->escapeHTML($_->{version}),
334              comment     => CGI->escapeHTML($_->{metadata}{comment}[0]),
335              username    => CGI->escapeHTML($_->{metadata}{username}[0]),
336              host        => CGI->escapeHTML($_->{metadata}{host}[0]),
337              username_param => CGI->escape($_->{metadata}{username}[0]),
338              edit_type   => CGI->escapeHTML($_->{metadata}{edit_type}[0]),
339              url         => $config->script_name . "?"
340      . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name})),
341        }
342                       } @rc;
343            if ( scalar @rc ) {
344                $recent_changes{$days->[1]} = \@rc;
345        }
346        }
347    }
348    $tt_vars{recent_changes} = \%recent_changes;
349    my %processing_args = (
350                            id            => $id,
351                            template      => "recent_changes.tt",
352                            tt_vars       => \%tt_vars,
353                           );
354    if ( !$since && $self->get_cookie("track_recent_changes_views") ) {
355    my $cookie =
356           OpenGuides::CGI->make_recent_changes_cookie(config => $config );
357        $processing_args{cookies} = $cookie;
358        $tt_vars{last_viewed} = OpenGuides::CGI->get_last_recent_changes_visit_from_cookie( config => $config );
359    }
360    return %tt_vars if $args{return_tt_vars};
361    my $output = $self->process_template( %processing_args );
362    return $output if $return_output;
363    print $output;
364}
365
366=item B<display_diffs>
367
368  $guide->display_diffs(
369                           id            => "Home Page",
370                           version       => 6,
371                           other_version => 5,
372                       );
373
374  # Or return output as a string (useful for writing tests).
375  my $output = $guide->display_diffs(
376                                        id            => "Home Page",
377                                        version       => 6,
378                                        other_version => 5,
379                                        return_output => 1,
380                                    );
381
382  # Or return the hash of variables that will be passed to the template
383  # (not including those set additionally by OpenGuides::Template).
384  my %vars = $guide->display_diffs(
385                                      id             => "Home Page",
386                                      version        => 6,
387                                      other_version  => 5,
388                                      return_tt_vars => 1,
389                                  );
390
391=cut
392
393sub display_diffs {
394    my ($self, %args) = @_;
395    my %diff_vars = $self->differ->differences(
396                                                  node          => $args{id},
397                                                  left_version  => $args{version},
398                                                  right_version => $args{other_version},
399                                              );
400    $diff_vars{not_deletable} = 1;
401    $diff_vars{not_editable}  = 1;
402    $diff_vars{deter_robots}  = 1;
403    return %diff_vars if $args{return_tt_vars};
404    my $output = $self->process_template(
405                                            id       => $args{id},
406                                            template => "differences.tt",
407                                            tt_vars  => \%diff_vars
408                                        );
409    return $output if $args{return_output};
410    print $output;
411}
412
413=item B<find_within_distance>
414
415  $guide->find_within_distance(
416                                  id => $node,
417                                  metres => $q->param("distance_in_metres")
418                              );
419
420=cut
421
422sub find_within_distance {
423    my ($self, %args) = @_;
424    my $node = $args{id};
425    my $metres = $args{metres};
426    my %data = $self->wiki->retrieve_node( $node );
427    my $lat = $data{metadata}{latitude}[0];
428    my $long = $data{metadata}{longitude}[0];
429    my $script_url = $self->config->script_url;
430    my $q = CGI->new;
431    print $q->redirect( $script_url . "search.cgi?lat=$lat;long=$long;distance_in_metres=$metres" );
432}
433
434=item B<show_backlinks>
435
436  $guide->show_backlinks( id => "Calthorpe Arms" );
437
438As with other methods, parameters C<return_tt_vars> and
439C<return_output> can be used to return these things instead of
440printing the output to STDOUT.
441
442=cut
443
444sub show_backlinks {
445    my ($self, %args) = @_;
446    my $wiki = $self->wiki;
447    my $formatter = $wiki->formatter;
448
449    my @backlinks = $wiki->list_backlinks( node => $args{id} );
450    my @results = map {
451                          {
452                              url   => CGI->escape($formatter->node_name_to_node_param($_)),
453                              title => CGI->escapeHTML($_)
454                          }
455                      } sort @backlinks;
456    my %tt_vars = ( results       => \@results,
457                    num_results   => scalar @results,
458                    not_deletable => 1,
459                    deter_robots  => 1,
460                    not_editable  => 1 );
461    return %tt_vars if $args{return_tt_vars};
462    my $output = OpenGuides::Template->output(
463                                                 node    => $args{id},
464                                                 wiki    => $wiki,
465                                                 config  => $self->config,
466                                                 template=>"backlink_results.tt",
467                                                 vars    => \%tt_vars,
468                                             );
469    return $output if $args{return_output};
470    print $output;
471}
472
473=item B<show_index>
474
475  $guide->show_index(
476                        type   => "category",
477                        value  => "pubs",
478                    );
479
480  # RDF version.
481  $guide->show_index(
482                        type   => "locale",
483                        value  => "Holborn",
484                        format => "rdf",
485                    );
486
487  # RSS / Atom version (recent changes style).
488  $guide->show_index(
489                        type   => "locale",
490                        value  => "Holborn",
491                        format => "rss",
492                    );
493
494  # Or return output as a string (useful for writing tests).
495  $guide->show_index(
496                        type          => "category",
497                        value         => "pubs",
498                        return_output => 1,
499                    );
500
501=cut
502
503sub show_index {
504    my ($self, %args) = @_;
505    my $wiki = $self->wiki;
506    my $formatter = $wiki->formatter;
507    my %tt_vars;
508    my @selnodes;
509
510    if ( $args{type} and $args{value} ) {
511        if ( $args{type} eq "fuzzy_title_match" ) {
512            my %finds = $wiki->fuzzy_title_match( $args{value} );
513            @selnodes = sort { $finds{$a} <=> $finds{$b} } keys %finds;
514            $tt_vars{criterion} = {
515                type  => $args{type},  # for RDF version
516                value => $args{value}, # for RDF version
517                name  => CGI->escapeHTML("Fuzzy Title Match on '$args{value}'")
518            };
519            $tt_vars{not_editable} = 1;
520        } else {
521            @selnodes = $wiki->list_nodes_by_metadata(
522                metadata_type  => $args{type},
523                metadata_value => $args{value},
524                ignore_case    => 1
525            );
526            my $name = ucfirst($args{type}) . " $args{value}";
527            my $url = $self->config->script_name
528                      . "?"
529                      . ucfirst( $args{type} )
530                      . "_"
531                      . uri_escape(
532                                      $formatter->node_name_to_node_param($args{value})
533                                  );
534            $tt_vars{criterion} = {
535                type  => $args{type},
536                value => $args{value}, # for RDF version
537                name  => CGI->escapeHTML( $name ),
538                url   => $url
539            };
540            $tt_vars{not_editable} = 1;
541        }
542    } else {
543        @selnodes = $wiki->list_all_nodes();
544    }
545
546    my @nodes = map {
547                        {
548                            name      => $_,
549                            node_data => { $wiki->retrieve_node( name => $_ ) },
550                            param     => $formatter->node_name_to_node_param($_) }
551                        } sort @selnodes;
552
553    $tt_vars{nodes} = \@nodes;
554
555    my ($template, %conf);
556
557    if ( $args{format} ) {
558        if ( $args{format} eq "rdf" ) {
559            $template = "rdf_index.tt";
560            $conf{content_type} = "application/rdf+xml";
561        }
562        elsif ( $args{format} eq "plain" ) {
563            $template = "plain_index.tt";
564            $conf{content_type} = "text/plain";
565        } elsif ( $args{format} eq "map" ) {
566            my $q = CGI->new;
567            $tt_vars{zoom} = $q->param('zoom') || '';
568            $tt_vars{lat} = $q->param('lat') || '';
569            $tt_vars{long} = $q->param('long') || '';
570            $tt_vars{centre_long} = $self->config->centre_long;
571            $tt_vars{centre_lat} = $self->config->centre_lat;
572            $tt_vars{default_gmaps_zoom} = $self->config->default_gmaps_zoom;
573            $tt_vars{enable_gmaps} = 1;
574            $tt_vars{display_google_maps} = 1; # override for this page
575            $template = "map_index.tt";
576           
577        } elsif( $args{format} eq "rss" || $args{format} eq "atom") {
578            # They really wanted a recent changes style rss/atom feed
579            my $feed_type = $args{format};
580            my ($feed,$content_type) = $self->get_feed_and_content_type($feed_type);
581            $feed->set_feed_name_and_url_params(
582                        "Index of $args{type} $args{value}",
583                        "action=index;index_type=$args{type};index_value=$args{value}"
584            );
585
586            # Grab the actual node data out of @nodes
587            my @node_data;
588            foreach my $node (@nodes) {
589                $node->{node_data}->{name} = $node->{name};
590                push @node_data, $node->{node_data};
591            }
592
593            my $output = "Content-Type: ".$content_type."\n";
594            $output .= $feed->build_feed_for_nodes($feed_type, @node_data);
595
596            return $output if $args{return_output};
597            print $output;
598            return;
599        }
600    } else {
601        $template = "site_index.tt";
602    }
603
604    %conf = (
605                %conf,
606                node        => "$args{type} index", # KLUDGE
607                template    => $template,
608                tt_vars     => \%tt_vars,
609            );
610
611    my $output = $self->process_template( %conf );
612    return $output if $args{return_output};
613    print $output;
614}
615
616=item B<list_all_versions>
617
618  $guide->list_all_versions ( id => "Home Page" );
619
620  # Or return output as a string (useful for writing tests).
621  $guide->list_all_versions (
622                                id            => "Home Page",
623                                return_output => 1,
624                            );
625
626  # Or return the hash of variables that will be passed to the template
627  # (not including those set additionally by OpenGuides::Template).
628  $guide->list_all_versions (
629                                id             => "Home Page",
630                                return_tt_vars => 1,
631                            );
632
633=cut
634
635sub list_all_versions {
636    my ($self, %args) = @_;
637    my $return_output = $args{return_output} || 0;
638    my $node = $args{id};
639    my %curr_data = $self->wiki->retrieve_node($node);
640    my $curr_version = $curr_data{version};
641    my @history;
642    for my $version ( 1 .. $curr_version ) {
643        my %node_data = $self->wiki->retrieve_node( name    => $node,
644                                                    version => $version );
645        # $node_data{version} will be zero if this version was deleted.
646        push @history, {
647            version  => CGI->escapeHTML( $version ),
648            modified => CGI->escapeHTML( $node_data{last_modified} ),
649            username => CGI->escapeHTML( $node_data{metadata}{username}[0] ),
650            comment  => CGI->escapeHTML( $node_data{metadata}{comment}[0] ),
651                       } if $node_data{version};
652    }
653    @history = reverse @history;
654    my %tt_vars = (
655                      node          => $node,
656                      version       => $curr_version,
657                      not_deletable => 1,
658                      not_editable  => 1,
659                      deter_robots  => 1,
660                      history       => \@history
661                  );
662    return %tt_vars if $args{return_tt_vars};
663    my $output = $self->process_template(
664                                            id       => $node,
665                                            template => "node_history.tt",
666                                            tt_vars  => \%tt_vars,
667                                        );
668    return $output if $return_output;
669    print $output;
670}
671
672=item B<get_feed_and_content_type>
673
674Fetch the OpenGuides feed object, and the output content type, for the
675supplied feed type.
676
677Handles all the setup for the OpenGuides feed object.
678=cut
679sub get_feed_and_content_type {
680    my ($self, $feed_type) = @_;
681
682    my $feed = OpenGuides::Feed->new(
683                                        wiki       => $self->wiki,
684                                        config     => $self->config,
685                                        og_version => $VERSION,
686                                    );
687
688    my $content_type = $feed->default_content_type($feed_type);
689
690    return ($feed, $content_type);
691}
692
693=item B<display_feed>
694
695  # Last ten non-minor edits to Hammersmith pages in RSS 1.0 format
696  $guide->display_feed(
697                         feed_type          => 'rss',
698                         feed_listing       => 'recent_changes',
699                         items              => 10,
700                         ignore_minor_edits => 1,
701                         locale             => "Hammersmith",
702                     );
703
704  # All edits bob has made to pub pages in the last week in Atom format
705  $guide->display_feed(
706                         feed_type    => 'atom',
707                         feed_listing => 'recent_changes',
708                         days         => 7,
709                         username     => "bob",
710                         category     => "Pubs",
711                     );
712
713C<feed_type> is a mandatory parameter. Supported values at present are
714"rss" and "atom".
715
716C<feed_listing> is a mandatory parameter. Supported values at present
717are "recent_changes". (More values are coming soon though!)
718
719As with other methods, the C<return_output> parameter can be used to
720return the output instead of printing it to STDOUT.
721
722=cut
723
724sub display_feed {
725    my ($self, %args) = @_;
726
727    my $feed_type = $args{feed_type};
728    croak "No feed type given" unless $feed_type;
729
730    my $feed_listing = $args{feed_listing};
731    croak "No feed listing given" unless $feed_listing;
732   
733    my $return_output = $args{return_output} ? 1 : 0;
734
735    # Basic criteria, whatever the feed listing type is
736    my %criteria = (
737                       feed_type             => $feed_type,
738                       feed_listing          => $feed_listing,
739                       also_return_timestamp => 1,
740                   );
741
742    # Feed listing specific criteria
743    if($feed_listing eq "recent_changes") {
744        $criteria{items} = $args{items} || "";
745        $criteria{days}  = $args{days}  || "";
746        $criteria{ignore_minor_edits} = $args{ignore_minor_edits} ? 1 : 0;
747
748        my $username = $args{username} || "";
749        my $category = $args{category} || "";
750        my $locale   = $args{locale}   || "";
751
752        my %filter;
753        $filter{username} = $username if $username;
754        $filter{category} = $category if $category;
755        $filter{locale}   = $locale   if $locale;
756        if ( scalar keys %filter ) {
757            $criteria{filter_on_metadata} = \%filter;
758        }
759    }
760    elsif($feed_listing eq "node_all_versions") {
761        $criteria{name} = $args{name};
762    }
763
764
765    # Get the feed object, and the content type
766    my ($feed,$content_type) = $self->get_feed_and_content_type($feed_type);
767
768    my $output = "Content-Type: ".$content_type."\n";
769   
770    # Get the feed, and the timestamp, in one go
771    my ($feed_output, $feed_timestamp) = 
772        $feed->make_feed( %criteria );
773
774    $output .= "Last-Modified: " . $feed_timestamp . "\n\n";
775    $output .= $feed_output;
776
777    return $output if $return_output;
778    print $output;
779}
780
781sub display_about {
782    my ($self, %args) = @_;
783
784    my $output;
785
786    if ($args{format} && $args{format} =~ /^rdf$/i) {
787        $output = qq{Content-Type: application/rdf+xml
788
789<?xml version="1.0" encoding="UTF-8"?>
790<rdf:RDF xmlns      = "http://usefulinc.com/ns/doap#"
791         xmlns:rdf  = "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
792         xmlns:foaf = "http://xmlns.com/foaf/0.1/">
793<Project rdf:ID="OpenGuides">
794  <name>OpenGuides</name>
795
796  <created>2003-04-29</created>
797 
798  <shortdesc xml:lang="en">
799    A wiki engine for collaborative description of places with specialised
800    geodata metadata features.
801  </shortdesc>
802
803  <description xml:lang="en">
804    OpenGuides is a collaborative wiki environment, written in Perl, for
805    building guides and sharing information, as both human-readable text
806    and RDF. The engine contains a number of geodata-specific metadata
807    mechanisms such as locale search, node classification and integration
808    with Google Maps.
809  </description>
810
811  <homepage rdf:resource="http://openguides.org/" />
812  <mailing-list rdf:resource="http://openguides.org/mm/listinfo/openguides-dev/" />
813  <mailing-list rdf:resource="http://urchin.earth.li/mailman/listinfo/openguides-commits/" />
814
815  <maintainer>
816    <foaf:Person rdf:ID="OpenGuidesMaintainer">
817      <foaf:name>Dominic Hargreaves</foaf:name>
818      <foaf:homepage rdf:resource="http://www.larted.org.uk/~dom/" />
819    </foaf:Person>
820  </maintainer>
821
822  <repository>
823    <SVNRepository rdf:ID="OpenGuidesSVN">
824      <location rdf:resource="https://urchin.earth.li/svn/openguides/" />
825      <browse rdf:resource="http://dev.openguides.org/browser" />
826    </SVNRepository>
827  </repository>
828
829  <release>
830    <Version rdf:ID="OpenGuidesVersion">
831      <revision>$VERSION</revision>
832    </Version>
833  </release>
834
835  <download-page rdf:resource="http://search.cpan.org/dist/OpenGuides/" />
836 
837  <!-- Freshmeat category: Internet :: WWW/HTTP :: Dynamic Content -->
838  <category rdf:resource="http://freshmeat.net/browse/92/" />
839 
840  <license rdf:resource="http://www.opensource.org/licenses/gpl-license.php" />
841  <license rdf:resource="http://www.opensource.org/licenses/artistic-license.php" />
842
843</Project>
844
845</rdf:RDF>};
846    }
847    else {
848        my $site_name  = $self->config->{site_name};
849        my $script_name = $self->config->{script_name};
850        $output = qq{Content-Type: text/html; charset=utf-8
851
852<html>
853<head>
854  <title>About $site_name</title>
855<style type="text/css">
856body        { margin: 0px; }
857#content    { padding: 50px; margin: auto; width: 50%; }
858h1          { margin-bottom: 0px; font-style: italic; }
859h2          { margin-top: 0px; }
860#logo       { text-align: center; }
861#about      { margin: 0em 0em 1em 0em; border-top: 1px solid #ddd; border-bottom: 1px solid #ddd; }
862#meta       { font-size: small; text-align: center;}
863</style>
864<link rel="alternate"
865  type="application/rdf+xml"
866  title="DOAP (Description Of A Project) profile for this site's software"
867  href="$script_name?action=about;format=rdf" />
868</head>
869<body>
870<div id="content">
871<div id="logo">
872<a href="http://openguides.org/"><img
873src="http://openguides.org/img/logo.png" alt="OpenGuides"></a>
874<h1><a href="$script_name">$site_name</a></h1>
875<h2>is powered by <a href="http://openguides.org/">OpenGuides</a> -<br>
876the guides made by you.</h2>
877<h3>version <a href="http://search.cpan.org/~dom/OpenGuides-$VERSION">$VERSION</a></h3>
878</div>
879<div id="about">
880<p>
881<a href="http://www.w3.org/RDF/"><img
882src="http://openguides.org/img/rdf_icon.png" width="44" height="48"
883style="float: right; margin-left: 10px; border: 0px"></a> OpenGuides is a
884web-based collaborative <a href="http://wiki.org/wiki.cgi?WhatIsWiki">wiki</a>
885environment for building guides and sharing information, as both
886human-readable text and <a href="http://www.w3.org/RDF/"><acronym
887title="Resource Description Framework">RDF</acronym></a>. The engine contains
888a number of geodata-specific metadata mechanisms such as locale search, node
889classification and integration with <a href="http://maps.google.com/">Google
890Maps</a>.
891</p>
892<p>
893OpenGuides is written in <a href="http://www.perl.org/">Perl</a>, and is
894made available under the same license as Perl itself (dual <a
895href="http://dev.perl.org/licenses/artistic.html" title='The "Artistic Licence"'>Artistic</a> and <a
896href="http://www.opensource.org/licenses/gpl-license.php"><acronym
897title="GNU Public Licence">GPL</acronym></a>). Developer information for the
898project is available from the <a href="http://dev.openguides.org/">OpenGuides
899development site</a>.
900</p>
901<p>
902Copyright &copy;2003-2006, <a href="http://openguides.org/">The OpenGuides
903Project</a>. "OpenGuides", "[The] Open Guide To..." and "The guides made by
904you" are trademarks of The OpenGuides Project. Any uses on this site are made
905with permission.
906</p>
907</div>
908<div id="meta">
909<a href="$script_name?action=about;format=rdf"><acronym
910title="Description Of A Project">DOAP</acronym> RDF version of this
911information</a>
912</div>
913</div>
914</body>
915</html>};
916    }
917   
918    return $output if $args{return_output};
919    print $output;
920}
921
922=item B<commit_node>
923
924  $guide->commit_node(
925                         id      => $node,
926                         cgi_obj => $q,
927                     );
928
929As with other methods, parameters C<return_tt_vars> and
930C<return_output> can be used to return these things instead of
931printing the output to STDOUT.
932
933The geographical data that you should provide in the L<CGI> object
934depends on the handler you chose in C<wiki.conf>.
935
936=over
937
938=item *
939
940B<British National Grid> - provide either C<os_x> and C<os_y> or
941C<latitude> and C<longitude>; whichever set of data you give, it will
942be converted to the other and both sets will be stored.
943
944=item *
945
946B<Irish National Grid> - provide either C<osie_x> and C<osie_y> or
947C<latitude> and C<longitude>; whichever set of data you give, it will
948be converted to the other and both sets will be stored.
949
950=item *
951
952B<UTM ellipsoid> - provide C<latitude> and C<longitude>; these will be
953converted to easting and northing and both sets of data will be stored.
954
955=back
956
957=cut
958
959sub commit_node {
960    my ($self, %args) = @_;
961    my $node = $args{id};
962    my $q = $args{cgi_obj};
963    my $return_output = $args{return_output};
964    my $wiki = $self->wiki;
965    my $config = $self->config;
966
967    my $content  = $q->param("content");
968    $content =~ s/\r\n/\n/gs;
969    my $checksum = $q->param("checksum");
970
971    my %metadata = OpenGuides::Template->extract_metadata_vars(
972        wiki    => $wiki,
973        config  => $config,
974    cgi_obj => $q
975    );
976
977    delete $metadata{website} if $metadata{website} eq 'http://';
978
979    $metadata{opening_hours_text} = $q->param("hours_text") || "";
980
981    # Pick out the unmunged versions of lat/long if they're set.
982    # (If they're not, it means they weren't munged in the first place.)
983    $metadata{latitude} = delete $metadata{latitude_unmunged}
984        if $metadata{latitude_unmunged};
985    $metadata{longitude} = delete $metadata{longitude_unmunged}
986        if $metadata{longitude_unmunged};
987
988    # Check to make sure all the indexable nodes are created
989    foreach my $type (qw(Category Locale)) {
990        my $lctype = lc($type);
991        foreach my $index (@{$metadata{$lctype}}) {
992            $index =~ s/(.*)/\u$1/;
993            my $node = $type . " " . $index;
994            # Uppercase the node name before checking for existence
995            $node =~ s/ (\S+)/ \u$1/g;
996            unless ( $wiki->node_exists($node) ) {
997                my $category = $type eq "Category" ? "Category" : "Locales";
998                $wiki->write_node(
999                                     $node,
1000                                     "\@INDEX_LINK [[$node]]",
1001                                     undef,
1002                                     {
1003                                         username => "Auto Create",
1004                                         comment  => "Auto created $lctype stub page",
1005                                         category => $category
1006                                     }
1007                                 );
1008            }
1009        }
1010    }
1011   
1012    foreach my $var ( qw( summary username comment edit_type ) ) {
1013        $metadata{$var} = $q->param($var) || "";
1014    }
1015    $metadata{host} = $ENV{REMOTE_ADDR};
1016
1017    # Wiki::Toolkit::Plugin::RSS::ModWiki wants "major_change" to be set.
1018    $metadata{major_change} = ( $metadata{edit_type} eq "Normal edit" )
1019                            ? 1
1020                            : 0;
1021
1022    my $written = $wiki->write_node($node, $content, $checksum, \%metadata );
1023
1024    if ($written) {
1025        my $output = $self->redirect_to_node($node);
1026        return $output if $return_output;
1027        print $output;
1028    } else {
1029        my %node_data = $wiki->retrieve_node($node);
1030        my %tt_vars = ( checksum       => $node_data{checksum},
1031                        new_content    => $content,
1032                        stored_content => $node_data{content} );
1033        foreach my $mdvar ( keys %metadata ) {
1034            if ($mdvar eq "locales") {
1035                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{locale};
1036                $tt_vars{"new_$mdvar"}    = $metadata{locale};
1037            } elsif ($mdvar eq "categories") {
1038                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{category};
1039                $tt_vars{"new_$mdvar"}    = $metadata{category};
1040            } elsif ($mdvar eq "username" or $mdvar eq "comment"
1041                      or $mdvar eq "edit_type" ) {
1042                $tt_vars{$mdvar} = $metadata{$mdvar};
1043            } else {
1044                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{$mdvar}[0];
1045                $tt_vars{"new_$mdvar"}    = $metadata{$mdvar};
1046            }
1047        }
1048        return %tt_vars if $args{return_tt_vars};
1049        my $output = $self->process_template(
1050                                              id       => $node,
1051                                              template => "edit_conflict.tt",
1052                                              tt_vars  => \%tt_vars,
1053                                            );
1054        return $output if $args{return_output};
1055        print $output;
1056    }
1057}
1058
1059
1060=item B<delete_node>
1061
1062  $guide->delete_node(
1063                         id       => "FAQ",
1064                         version  => 15,
1065                         password => "beer",
1066                     );
1067
1068C<version> is optional - if it isn't supplied then all versions of the
1069node will be deleted; in other words the node will be entirely
1070removed.
1071
1072If C<password> is not supplied then a form for entering the password
1073will be displayed.
1074
1075As with other methods, parameters C<return_tt_vars> and
1076C<return_output> can be used to return these things instead of
1077printing the output to STDOUT.
1078
1079=cut
1080
1081sub delete_node {
1082    my ($self, %args) = @_;
1083    my $node = $args{id} or croak "No node ID supplied for deletion";
1084    my $return_tt_vars = $args{return_tt_vars} || 0;
1085    my $return_output = $args{return_output} || 0;
1086
1087    my %tt_vars = (
1088                      not_editable  => 1,
1089                      not_deletable => 1,
1090                      deter_robots  => 1,
1091                  );
1092    $tt_vars{delete_version} = $args{version} || "";
1093
1094    my $password = $args{password};
1095
1096    if ($password) {
1097        if ($password ne $self->config->admin_pass) {
1098            return %tt_vars if $return_tt_vars;
1099            my $output = $self->process_template(
1100                                                    id       => $node,
1101                                                    template => "delete_password_wrong.tt",
1102                                                    tt_vars  => \%tt_vars,
1103                                                );
1104            return $output if $return_output;
1105            print $output;
1106        } else {
1107            $self->wiki->delete_node(
1108                                        name    => $node,
1109                                        version => $args{version},
1110                                    );
1111            # Check whether any versions of this node remain.
1112            my %check = $self->wiki->retrieve_node( name => $node );
1113            $tt_vars{other_versions_remain} = 1 if $check{version};
1114            return %tt_vars if $return_tt_vars;
1115            my $output = $self->process_template(
1116                                                    id       => $node,
1117                                                    template => "delete_done.tt",
1118                                                    tt_vars  => \%tt_vars,
1119                                                );
1120            return $output if $return_output;
1121            print $output;
1122        }
1123    } else {
1124        return %tt_vars if $return_tt_vars;
1125        my $output = $self->process_template(
1126                                                id       => $node,
1127                                                template => "delete_confirm.tt",
1128                                                tt_vars  => \%tt_vars,
1129                                            );
1130        return $output if $return_output;
1131        print $output;
1132    }
1133}
1134
1135sub process_template {
1136    my ($self, %args) = @_;
1137    my %output_conf = (
1138                          wiki     => $self->wiki,
1139                          config   => $self->config,
1140                          node     => $args{id},
1141                          template => $args{template},
1142                          vars     => $args{tt_vars},
1143                          cookies  => $args{cookies},
1144                      );
1145    if ( $args{content_type} ) {
1146        $output_conf{content_type} = $args{content_type};
1147    }
1148    return OpenGuides::Template->output( %output_conf );
1149}
1150
1151sub redirect_to_node {
1152    my ($self, $node, $redirected_from) = @_;
1153   
1154    my $script_url = $self->config->script_url;
1155    my $script_name = $self->config->script_name;
1156    my $formatter = $self->wiki->formatter;
1157
1158    my $id = $formatter->node_name_to_node_param( $node );
1159    my $oldid;
1160    $oldid = $formatter->node_name_to_node_param( $redirected_from ) if $redirected_from;
1161
1162    my $redir_param = "$script_url$script_name?";
1163    $redir_param .= 'id=' if $oldid;
1164    $redir_param .= $id;
1165    $redir_param .= ";oldid=$oldid" if $oldid;
1166   
1167    my $q = CGI->new;
1168    return $q->redirect( $redir_param );
1169}
1170
1171sub get_cookie {
1172    my $self = shift;
1173    my $config = $self->config;
1174    my $pref_name = shift or return "";
1175    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
1176    return $cookie_data{$pref_name};
1177}
1178
1179
1180=head1 BUGS AND CAVEATS
1181
1182UTF8 data are currently not handled correctly throughout.
1183
1184Other bugs are documented at
1185L<http://dev.openguides.org/>
1186
1187=head1 SEE ALSO
1188
1189=over 4
1190
1191=item * L<http://london.openguides.org/|The Open Guide to London>, the first and biggest OpenGuides site.
1192
1193=item * L<http://openguides.org/|The OpenGuides website>, with a list of all live OpenGuides installs.
1194
1195=item * L<Wiki::Toolkit>, the Wiki toolkit which does the heavy lifting for OpenGuides
1196
1197=back
1198
1199=head1 FEEDBACK
1200
1201If you have a question, a bug report, or a patch, or you're interested
1202in joining the development team, please contact openguides-dev@openguides.org
1203(moderated mailing list, will reach all current developers but you'll have
1204to wait for your post to be approved) or file a bug report at
1205L<http://dev.openguides.org/>
1206
1207=head1 AUTHOR
1208
1209The OpenGuides Project (openguides-dev@openguides.org)
1210
1211=head1 COPYRIGHT
1212
1213     Copyright (C) 2003-2006 The OpenGuides Project.  All Rights Reserved.
1214
1215The OpenGuides distribution is free software; you can redistribute it
1216and/or modify it under the same terms as Perl itself.
1217
1218=head1 CREDITS
1219
1220Programming by Dominic Hargreaves, Earle Martin, Kake Pugh, and Ivor
1221Williams.  Testing and bug reporting by Billy Abbott, Jody Belka,
1222Kerry Bosworth, Simon Cozens, Cal Henderson, Steve Jolly, and Bob
1223Walker (among others).  Much of the Module::Build stuff copied from
1224the Siesta project L<http://siesta.unixbeard.net/>
1225
1226=cut
1227
12281;
Note: See TracBrowser for help on using the repository browser.