source: trunk/lib/OpenGuides.pm @ 806

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

Go for a real release

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