source: trunk/lib/OpenGuides.pm @ 791

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

Explicitly request the feed timestamp at the same time as the feed, to avoid Wiki::Toolkit having to do the node fetch twice. The feed_timestamp method on OpenGuides::Feed should no longer be used, as it requires another fetch, and only makes sense if you only ever deal with recent changes

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 41.7 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.54_01';
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  # Or return output as a string (useful for writing tests).
488  $guide->show_index(
489                        type          => "category",
490                        value         => "pubs",
491                        return_output => 1,
492                    );
493
494=cut
495
496sub show_index {
497    my ($self, %args) = @_;
498    my $wiki = $self->wiki;
499    my $formatter = $wiki->formatter;
500    my %tt_vars;
501    my @selnodes;
502
503    if ( $args{type} and $args{value} ) {
504        if ( $args{type} eq "fuzzy_title_match" ) {
505            my %finds = $wiki->fuzzy_title_match( $args{value} );
506            @selnodes = sort { $finds{$a} <=> $finds{$b} } keys %finds;
507            $tt_vars{criterion} = {
508                type  => $args{type},  # for RDF version
509                value => $args{value}, # for RDF version
510                name  => CGI->escapeHTML("Fuzzy Title Match on '$args{value}'")
511            };
512            $tt_vars{not_editable} = 1;
513        } else {
514            @selnodes = $wiki->list_nodes_by_metadata(
515                metadata_type  => $args{type},
516                metadata_value => $args{value},
517                ignore_case    => 1
518            );
519            my $name = ucfirst($args{type}) . " $args{value}";
520            my $url = $self->config->script_name
521                      . "?"
522                      . ucfirst( $args{type} )
523                      . "_"
524                      . uri_escape(
525                                      $formatter->node_name_to_node_param($args{value})
526                                  );
527            $tt_vars{criterion} = {
528                type  => $args{type},
529                value => $args{value}, # for RDF version
530                name  => CGI->escapeHTML( $name ),
531                url   => $url
532            };
533            $tt_vars{not_editable} = 1;
534        }
535    } else {
536        @selnodes = $wiki->list_all_nodes();
537    }
538
539    my @nodes = map {
540                        {
541                            name      => $_,
542                            node_data => { $wiki->retrieve_node( name => $_ ) },
543                            param     => $formatter->node_name_to_node_param($_) }
544                        } sort @selnodes;
545
546    $tt_vars{nodes} = \@nodes;
547
548    my ($template, %conf);
549
550    if ( $args{format} ) {
551        if ( $args{format} eq "rdf" ) {
552            $template = "rdf_index.tt";
553            $conf{content_type} = "application/rdf+xml";
554        }
555        elsif ( $args{format} eq "plain" ) {
556            $template = "plain_index.tt";
557            $conf{content_type} = "text/plain";
558        } elsif ( $args{format} eq "map" ) {
559            my $q = CGI->new;
560            $tt_vars{zoom} = $q->param('zoom') || '';
561            $tt_vars{lat} = $q->param('lat') || '';
562            $tt_vars{long} = $q->param('long') || '';
563            $tt_vars{centre_long} = $self->config->centre_long;
564            $tt_vars{centre_lat} = $self->config->centre_lat;
565            $tt_vars{default_gmaps_zoom} = $self->config->default_gmaps_zoom;
566            $tt_vars{enable_gmaps} = 1;
567            $tt_vars{display_google_maps} = 1; # override for this page
568            $template = "map_index.tt";
569           
570        }
571    } else {
572        $template = "site_index.tt";
573    }
574
575    %conf = (
576                %conf,
577                node        => "$args{type} index", # KLUDGE
578                template    => $template,
579                tt_vars     => \%tt_vars,
580            );
581
582    my $output = $self->process_template( %conf );
583    return $output if $args{return_output};
584    print $output;
585}
586
587=item B<list_all_versions>
588
589  $guide->list_all_versions ( id => "Home Page" );
590
591  # Or return output as a string (useful for writing tests).
592  $guide->list_all_versions (
593                                id            => "Home Page",
594                                return_output => 1,
595                            );
596
597  # Or return the hash of variables that will be passed to the template
598  # (not including those set additionally by OpenGuides::Template).
599  $guide->list_all_versions (
600                                id             => "Home Page",
601                                return_tt_vars => 1,
602                            );
603
604=cut
605
606sub list_all_versions {
607    my ($self, %args) = @_;
608    my $return_output = $args{return_output} || 0;
609    my $node = $args{id};
610    my %curr_data = $self->wiki->retrieve_node($node);
611    my $curr_version = $curr_data{version};
612    my @history;
613    for my $version ( 1 .. $curr_version ) {
614        my %node_data = $self->wiki->retrieve_node( name    => $node,
615                                                    version => $version );
616        # $node_data{version} will be zero if this version was deleted.
617        push @history, {
618            version  => CGI->escapeHTML( $version ),
619            modified => CGI->escapeHTML( $node_data{last_modified} ),
620            username => CGI->escapeHTML( $node_data{metadata}{username}[0] ),
621            comment  => CGI->escapeHTML( $node_data{metadata}{comment}[0] ),
622                       } if $node_data{version};
623    }
624    @history = reverse @history;
625    my %tt_vars = (
626                      node          => $node,
627                      version       => $curr_version,
628                      not_deletable => 1,
629                      not_editable  => 1,
630                      deter_robots  => 1,
631                      history       => \@history
632                  );
633    return %tt_vars if $args{return_tt_vars};
634    my $output = $self->process_template(
635                                            id       => $node,
636                                            template => "node_history.tt",
637                                            tt_vars  => \%tt_vars,
638                                        );
639    return $output if $return_output;
640    print $output;
641}
642
643=item B<display_feed>
644
645  # Last ten non-minor edits to Hammersmith pages in RSS 1.0 format
646  $guide->display_feed(
647                         feed_type          => 'rss',
648                         feed_listing       => 'recent_changes',
649                         items              => 10,
650                         ignore_minor_edits => 1,
651                         locale             => "Hammersmith",
652                     );
653
654  # All edits bob has made to pub pages in the last week in Atom format
655  $guide->display_feed(
656                         feed_type    => 'atom',
657                         feed_listing => 'recent_changes',
658                         days         => 7,
659                         username     => "bob",
660                         category     => "Pubs",
661                     );
662
663C<feed_type> is a mandatory parameter. Supported values at present are
664"rss" and "atom".
665
666C<feed_listing> is a mandatory parameter. Supported values at present
667are "recent_changes". (More values are coming soon though!)
668
669As with other methods, the C<return_output> parameter can be used to
670return the output instead of printing it to STDOUT.
671
672=cut
673
674sub display_feed {
675    my ($self, %args) = @_;
676
677    my $feed_type = $args{feed_type};
678    croak "No feed type given" unless $feed_type;
679
680    my $feed_listing = $args{feed_listing};
681    croak "No feed listing given" unless $feed_listing;
682   
683    my $return_output = $args{return_output} ? 1 : 0;
684
685    my $items = $args{items} || "";
686    my $days  = $args{days}  || "";
687    my $ignore_minor_edits = $args{ignore_minor_edits} ? 1 : 0;
688    my $username = $args{username} || "";
689    my $category = $args{category} || "";
690    my $locale   = $args{locale}   || "";
691    my %criteria = (
692                       items                 => $items,
693                       days                  => $days,
694                       ignore_minor_edits    => $ignore_minor_edits,
695                       feed_type             => $feed_type,
696                       feed_listing          => $feed_listing,
697                       also_return_timestamp => 1,
698                   );
699    my %filter;
700    $filter{username} = $username if $username;
701    $filter{category} = $category if $category;
702    $filter{locale}   = $locale   if $locale;
703    if ( scalar keys %filter ) {
704        $criteria{filter_on_metadata} = \%filter;
705    }
706
707    my $feed = OpenGuides::Feed->new(
708                                        wiki       => $self->wiki,
709                                        config     => $self->config,
710                                        og_version => $VERSION,
711                                    );
712
713    my $output;
714   
715    if ($feed_type eq 'rss') {
716        $output = "Content-Type: application/rdf+xml\n";
717    }
718    elsif ($feed_type eq 'atom') {
719        $output = "Content-Type: application/atom+xml\n";
720    }
721    else {
722        croak "Unknown feed type given: $feed_type";
723    }
724   
725    # Get the feed, and the timestamp, in one go
726    my ($feed_output, $feed_timestamp) = 
727        $feed->make_feed( %criteria );
728
729    $output .= "Last-Modified: " . $feed_timestamp . "\n\n";
730    $output .= $feed_output;
731
732    return $output if $return_output;
733    print $output;
734}
735
736sub display_about {
737    my ($self, %args) = @_;
738
739    my $output;
740
741    if ($args{format} && $args{format} =~ /^rdf$/i) {
742        $output = qq{Content-Type: application/rdf+xml
743
744<?xml version="1.0" encoding="UTF-8"?>
745<rdf:RDF xmlns      = "http://usefulinc.com/ns/doap#"
746         xmlns:rdf  = "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
747         xmlns:foaf = "http://xmlns.com/foaf/0.1/">
748<Project rdf:ID="OpenGuides">
749  <name>OpenGuides</name>
750
751  <created>2003-04-29</created>
752 
753  <shortdesc xml:lang="en">
754    A wiki engine for collaborative description of places with specialised
755    geodata metadata features.
756  </shortdesc>
757
758  <description xml:lang="en">
759    OpenGuides is a collaborative wiki environment, written in Perl, for
760    building guides and sharing information, as both human-readable text
761    and RDF. The engine contains a number of geodata-specific metadata
762    mechanisms such as locale search, node classification and integration
763    with Google Maps.
764  </description>
765
766  <homepage rdf:resource="http://openguides.org/" />
767  <mailing-list rdf:resource="http://openguides.org/mm/listinfo/openguides-dev/" />
768  <mailing-list rdf:resource="http://urchin.earth.li/mailman/listinfo/openguides-commits/" />
769
770  <maintainer>
771    <foaf:Person rdf:ID="OpenGuidesMaintainer">
772      <foaf:name>Dominic Hargreaves</foaf:name>
773      <foaf:homepage rdf:resource="http://www.larted.org.uk/~dom/" />
774    </foaf:Person>
775  </maintainer>
776
777  <repository>
778    <SVNRepository rdf:ID="OpenGuidesSVN">
779      <location rdf:resource="https://urchin.earth.li/svn/openguides/" />
780      <browse rdf:resource="http://dev.openguides.org/browser" />
781    </SVNRepository>
782  </repository>
783
784  <release>
785    <Version rdf:ID="OpenGuidesVersion">
786      <revision>$VERSION</revision>
787    </Version>
788  </release>
789
790  <download-page rdf:resource="http://search.cpan.org/dist/OpenGuides/" />
791 
792  <!-- Freshmeat category: Internet :: WWW/HTTP :: Dynamic Content -->
793  <category rdf:resource="http://freshmeat.net/browse/92/" />
794 
795  <license rdf:resource="http://www.opensource.org/licenses/gpl-license.php" />
796  <license rdf:resource="http://www.opensource.org/licenses/artistic-license.php" />
797
798</Project>
799
800</rdf:RDF>};
801    }
802    else {
803        my $site_name  = $self->config->{site_name};
804        my $script_name = $self->config->{script_name};
805        $output = qq{Content-Type: text/html; charset=utf-8
806
807<html>
808<head>
809  <title>About $site_name</title>
810<style type="text/css">
811body        { margin: 0px; }
812#content    { padding: 50px; margin: auto; width: 50%; }
813h1          { margin-bottom: 0px; font-style: italic; }
814h2          { margin-top: 0px; }
815#logo       { text-align: center; }
816#logo a img { border: 1px solid #000; }
817#about      { margin: 0em 0em 1em 0em; border-top: 1px solid #ddd; border-bottom: 1px solid #ddd; }
818#meta       { font-size: small; text-align: center;}
819</style>
820<link rel="alternate"
821  type="application/rdf+xml"
822  title="DOAP (Description Of A Project) profile for this site's software"
823  href="$script_name?action=about;format=rdf" />
824</head>
825<body>
826<div id="content">
827<div id="logo">
828<a href="http://openguides.org/"><img
829src="http://openguides.org/img/logo.jpg" alt="OpenGuides.org"></a>
830<h1><a href="$script_name">$site_name</a></h1>
831<h2>is powered by <a href="http://openguides.org/">OpenGuides</a> -<br>
832the guides built by you.</h2>
833<h3>version <a href="http://search.cpan.org/~dom/OpenGuides-$VERSION">$VERSION</a></h3>
834</div>
835<div id="about">
836<p>
837<a href="http://www.w3.org/RDF/"><img
838src="http://openguides.org/img/rdf_icon.png" width="44" height="48"
839style="float: right; margin-left: 10px; border: 0px"></a> OpenGuides is a
840web-based collaborative <a href="http://wiki.org/wiki.cgi?WhatIsWiki">wiki</a>
841environment for building guides and sharing information, as both
842human-readable text and <a href="http://www.w3.org/RDF/"><acronym
843title="Resource Description Framework">RDF</acronym></a>. The engine contains
844a number of geodata-specific metadata mechanisms such as locale search, node
845classification and integration with <a href="http://maps.google.com/">Google
846Maps</a>.
847</p>
848<p>
849OpenGuides is written in <a href="http://www.perl.org/">Perl</a>, and is
850made available under the same license as Perl itself (dual <a
851href="http://dev.perl.org/licenses/artistic.html" title='The "Artistic Licence"'>Artistic</a> and <a
852href="http://www.opensource.org/licenses/gpl-license.php"><acronym
853title="GNU Public Licence">GPL</acronym></a>). Developer information for the
854project is available from the <a href="http://dev.openguides.org/">OpenGuides
855development site</a>.
856</p>
857<p>
858Copyright &copy;2003-2006, <a href="http://openguides.org/">The OpenGuides
859Project</a>. "OpenGuides", "[The] Open Guide To..." and "The guides built by
860you" are trademarks of The OpenGuides Project. Any uses on this site are made
861with permission.
862</p>
863</div>
864<div id="meta">
865<a href="$script_name?action=about;format=rdf"><acronym
866title="Description Of A Project">DOAP</acronym> RDF version of this
867information</a>
868</div>
869</div>
870</body>
871</html>};
872    }
873   
874    return $output if $args{return_output};
875    print $output;
876}
877
878=item B<commit_node>
879
880  $guide->commit_node(
881                         id      => $node,
882                         cgi_obj => $q,
883                     );
884
885As with other methods, parameters C<return_tt_vars> and
886C<return_output> can be used to return these things instead of
887printing the output to STDOUT.
888
889The geographical data that you should provide in the L<CGI> object
890depends on the handler you chose in C<wiki.conf>.
891
892=over
893
894=item *
895
896B<British National Grid> - provide either C<os_x> and C<os_y> or
897C<latitude> and C<longitude>; whichever set of data you give, it will
898be converted to the other and both sets will be stored.
899
900=item *
901
902B<Irish National Grid> - provide either C<osie_x> and C<osie_y> or
903C<latitude> and C<longitude>; whichever set of data you give, it will
904be converted to the other and both sets will be stored.
905
906=item *
907
908B<UTM ellipsoid> - provide C<latitude> and C<longitude>; these will be
909converted to easting and northing and both sets of data will be stored.
910
911=back
912
913=cut
914
915sub commit_node {
916    my ($self, %args) = @_;
917    my $node = $args{id};
918    my $q = $args{cgi_obj};
919    my $return_output = $args{return_output};
920    my $wiki = $self->wiki;
921    my $config = $self->config;
922
923    my $content  = $q->param("content");
924    $content =~ s/\r\n/\n/gs;
925    my $checksum = $q->param("checksum");
926
927    my %metadata = OpenGuides::Template->extract_metadata_vars(
928        wiki    => $wiki,
929        config  => $config,
930    cgi_obj => $q
931    );
932
933    delete $metadata{website} if $metadata{website} eq 'http://';
934
935    $metadata{opening_hours_text} = $q->param("hours_text") || "";
936
937    # Pick out the unmunged versions of lat/long if they're set.
938    # (If they're not, it means they weren't munged in the first place.)
939    $metadata{latitude} = delete $metadata{latitude_unmunged}
940        if $metadata{latitude_unmunged};
941    $metadata{longitude} = delete $metadata{longitude_unmunged}
942        if $metadata{longitude_unmunged};
943
944    # Check to make sure all the indexable nodes are created
945    foreach my $type (qw(Category Locale)) {
946        my $lctype = lc($type);
947        foreach my $index (@{$metadata{$lctype}}) {
948            $index =~ s/(.*)/\u$1/;
949            my $node = $type . " " . $index;
950            # Uppercase the node name before checking for existence
951            $node =~ s/ (\S+)/ \u$1/g;
952            unless ( $wiki->node_exists($node) ) {
953                my $category = $type eq "Category" ? "Category" : "Locales";
954                $wiki->write_node(
955                                     $node,
956                                     "\@INDEX_LINK [[$node]]",
957                                     undef,
958                                     {
959                                         username => "Auto Create",
960                                         comment  => "Auto created $lctype stub page",
961                                         category => $category
962                                     }
963                                 );
964            }
965        }
966    }
967   
968    foreach my $var ( qw( summary username comment edit_type ) ) {
969        $metadata{$var} = $q->param($var) || "";
970    }
971    $metadata{host} = $ENV{REMOTE_ADDR};
972
973    # Wiki::Toolkit::Plugin::RSS::ModWiki wants "major_change" to be set.
974    $metadata{major_change} = ( $metadata{edit_type} eq "Normal edit" )
975                            ? 1
976                            : 0;
977
978    my $written = $wiki->write_node($node, $content, $checksum, \%metadata );
979
980    if ($written) {
981        my $output = $self->redirect_to_node($node);
982        return $output if $return_output;
983        print $output;
984    } else {
985        my %node_data = $wiki->retrieve_node($node);
986        my %tt_vars = ( checksum       => $node_data{checksum},
987                        new_content    => $content,
988                        stored_content => $node_data{content} );
989        foreach my $mdvar ( keys %metadata ) {
990            if ($mdvar eq "locales") {
991                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{locale};
992                $tt_vars{"new_$mdvar"}    = $metadata{locale};
993            } elsif ($mdvar eq "categories") {
994                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{category};
995                $tt_vars{"new_$mdvar"}    = $metadata{category};
996            } elsif ($mdvar eq "username" or $mdvar eq "comment"
997                      or $mdvar eq "edit_type" ) {
998                $tt_vars{$mdvar} = $metadata{$mdvar};
999            } else {
1000                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{$mdvar}[0];
1001                $tt_vars{"new_$mdvar"}    = $metadata{$mdvar};
1002            }
1003        }
1004        return %tt_vars if $args{return_tt_vars};
1005        my $output = $self->process_template(
1006                                              id       => $node,
1007                                              template => "edit_conflict.tt",
1008                                              tt_vars  => \%tt_vars,
1009                                            );
1010        return $output if $args{return_output};
1011        print $output;
1012    }
1013}
1014
1015
1016=item B<delete_node>
1017
1018  $guide->delete_node(
1019                         id       => "FAQ",
1020                         version  => 15,
1021                         password => "beer",
1022                     );
1023
1024C<version> is optional - if it isn't supplied then all versions of the
1025node will be deleted; in other words the node will be entirely
1026removed.
1027
1028If C<password> is not supplied then a form for entering the password
1029will be displayed.
1030
1031As with other methods, parameters C<return_tt_vars> and
1032C<return_output> can be used to return these things instead of
1033printing the output to STDOUT.
1034
1035=cut
1036
1037sub delete_node {
1038    my ($self, %args) = @_;
1039    my $node = $args{id} or croak "No node ID supplied for deletion";
1040    my $return_tt_vars = $args{return_tt_vars} || 0;
1041    my $return_output = $args{return_output} || 0;
1042
1043    my %tt_vars = (
1044                      not_editable  => 1,
1045                      not_deletable => 1,
1046                      deter_robots  => 1,
1047                  );
1048    $tt_vars{delete_version} = $args{version} || "";
1049
1050    my $password = $args{password};
1051
1052    if ($password) {
1053        if ($password ne $self->config->admin_pass) {
1054            return %tt_vars if $return_tt_vars;
1055            my $output = $self->process_template(
1056                                                    id       => $node,
1057                                                    template => "delete_password_wrong.tt",
1058                                                    tt_vars  => \%tt_vars,
1059                                                );
1060            return $output if $return_output;
1061            print $output;
1062        } else {
1063            $self->wiki->delete_node(
1064                                        name    => $node,
1065                                        version => $args{version},
1066                                    );
1067            # Check whether any versions of this node remain.
1068            my %check = $self->wiki->retrieve_node( name => $node );
1069            $tt_vars{other_versions_remain} = 1 if $check{version};
1070            return %tt_vars if $return_tt_vars;
1071            my $output = $self->process_template(
1072                                                    id       => $node,
1073                                                    template => "delete_done.tt",
1074                                                    tt_vars  => \%tt_vars,
1075                                                );
1076            return $output if $return_output;
1077            print $output;
1078        }
1079    } else {
1080        return %tt_vars if $return_tt_vars;
1081        my $output = $self->process_template(
1082                                                id       => $node,
1083                                                template => "delete_confirm.tt",
1084                                                tt_vars  => \%tt_vars,
1085                                            );
1086        return $output if $return_output;
1087        print $output;
1088    }
1089}
1090
1091sub process_template {
1092    my ($self, %args) = @_;
1093    my %output_conf = (
1094                          wiki     => $self->wiki,
1095                          config   => $self->config,
1096                          node     => $args{id},
1097                          template => $args{template},
1098                          vars     => $args{tt_vars},
1099                          cookies  => $args{cookies},
1100                      );
1101    if ( $args{content_type} ) {
1102        $output_conf{content_type} = $args{content_type};
1103    }
1104    return OpenGuides::Template->output( %output_conf );
1105}
1106
1107sub redirect_to_node {
1108    my ($self, $node, $redirected_from) = @_;
1109   
1110    my $script_url = $self->config->script_url;
1111    my $script_name = $self->config->script_name;
1112    my $formatter = $self->wiki->formatter;
1113
1114    my $id = $formatter->node_name_to_node_param( $node );
1115    my $oldid;
1116    $oldid = $formatter->node_name_to_node_param( $redirected_from ) if $redirected_from;
1117
1118    my $redir_param = "$script_url$script_name?";
1119    $redir_param .= 'id=' if $oldid;
1120    $redir_param .= $id;
1121    $redir_param .= ";oldid=$oldid" if $oldid;
1122   
1123    my $q = CGI->new;
1124    return $q->redirect( $redir_param );
1125}
1126
1127sub get_cookie {
1128    my $self = shift;
1129    my $config = $self->config;
1130    my $pref_name = shift or return "";
1131    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
1132    return $cookie_data{$pref_name};
1133}
1134
1135
1136=head1 BUGS AND CAVEATS
1137
1138UTF8 data are currently not handled correctly throughout.
1139
1140Other bugs are documented at
1141L<http://dev.openguides.org/>
1142
1143=head1 SEE ALSO
1144
1145=over 4
1146
1147=item * L<http://london.openguides.org/|The Open Guide to London>, the first and biggest OpenGuides site.
1148
1149=item * L<http://openguides.org/|The OpenGuides website>, with a list of all live OpenGuides installs.
1150
1151=item * L<Wiki::Toolkit>, the Wiki toolkit which does the heavy lifting for OpenGuides
1152
1153=back
1154
1155=head1 FEEDBACK
1156
1157If you have a question, a bug report, or a patch, or you're interested
1158in joining the development team, please contact openguides-dev@openguides.org
1159(moderated mailing list, will reach all current developers but you'll have
1160to wait for your post to be approved) or file a bug report at
1161L<http://dev.openguides.org/>
1162
1163=head1 AUTHOR
1164
1165The OpenGuides Project (openguides-dev@openguides.org)
1166
1167=head1 COPYRIGHT
1168
1169     Copyright (C) 2003-2006 The OpenGuides Project.  All Rights Reserved.
1170
1171The OpenGuides distribution is free software; you can redistribute it
1172and/or modify it under the same terms as Perl itself.
1173
1174=head1 CREDITS
1175
1176Programming by Dominic Hargreaves, Earle Martin, Kake Pugh, and Ivor
1177Williams.  Testing and bug reporting by Billy Abbott, Jody Belka,
1178Kerry Bosworth, Simon Cozens, Cal Henderson, Steve Jolly, and Bob
1179Walker (among others).  Much of the Module::Build stuff copied from
1180the Siesta project L<http://siesta.unixbeard.net/>
1181
1182=cut
1183
11841;
Note: See TracBrowser for help on using the repository browser.