source: trunk/lib/OpenGuides.pm @ 817

Last change on this file since 817 was 817, checked in by nick, 16 years ago

Shift the content type method
Add mini feed method
Start to do urls, names etc for feeds properly
New tests

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