source: trunk/lib/OpenGuides.pm @ 372

Last change on this file since 372 was 372, checked in by kake, 18 years ago

Move find_within_distance stuff into OpenGuides.pm

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 12.7 KB
Line 
1package OpenGuides;
2use strict;
3
4use CGI;
5use CGI::Wiki::Plugin::Diff;
6use CGI::Wiki::Plugin::Locator::UK;
7use OpenGuides::Template;
8use OpenGuides::Utils;
9
10use vars qw( $VERSION );
11
12$VERSION = '0.33_02';
13
14=head1 NAME
15
16OpenGuides - A complete web application for managing a collaboratively-written guide to a city or town.
17
18=head1 DESCRIPTION
19
20The OpenGuides software provides the framework for a collaboratively-written
21city guide.  It is similar to a wiki but provides somewhat more structured
22data storage allowing you to annotate wiki pages with information such as
23category, location, and much more.  It provides searching facilities
24including "find me everything within a certain distance of this place".
25Every page includes a link to a machine-readable (RDF) version of the page.
26
27=head1 METHODS
28
29=over
30
31=item B<new>
32
33  my $guide = OpenGuides->new( config => $config );
34
35=cut
36
37sub new {
38    my ($class, %args) = @_;
39    my $self = {};
40    bless $self, $class;
41    my $wiki = OpenGuides::Utils->make_wiki_object( config => $args{config} );
42    $self->{wiki} = $wiki;
43    $self->{config} = $args{config};
44    my $locator = CGI::Wiki::Plugin::Locator::UK->new;
45    $wiki->register_plugin( plugin => $locator );
46    $self->{locator} = $locator;
47    my $differ = CGI::Wiki::Plugin::Diff->new;
48    $wiki->register_plugin( plugin => $differ );
49    $self->{differ} = $differ;
50    return $self;
51}
52
53=item B<wiki>
54
55An accessor, returns the underlying L<CGI::Wiki> object.
56
57=cut
58
59sub wiki {
60    my $self = shift;
61    return $self->{wiki};
62}
63
64=item B<config>
65
66An accessor, returns the underlying L<Config::Tiny> object.
67
68=cut
69
70sub config {
71    my $self = shift;
72    return $self->{config};
73}
74
75=item B<locator>
76
77An accessor, returns the underlying L<CGI::Wiki::Plugin::Locator::UK> object.
78
79=cut
80
81sub locator {
82    my $self = shift;
83    return $self->{locator};
84}
85
86=item B<differ>
87
88An accessor, returns the underlying L<CGI::Wiki::Plugin::Diff> object.
89
90=cut
91
92sub differ {
93    my $self = shift;
94    return $self->{differ};
95}
96
97=item B<display_node>
98
99  # Print node to STDOUT.
100  $guide->display_node(
101                        id      => "Calthorpe Arms",
102                        version => 2,
103                      );
104
105  # Or return output as a string (useful for writing tests).
106  $guide->display_node(
107                        id            => "Calthorpe Arms",
108                        return_output => 1,
109                      );
110
111If C<version> is omitted then the latest version will be displayed.
112
113=cut
114
115sub display_node {
116    my ($self, %args) = @_;
117    my $return_output = $args{return_output} || 0;
118    my $version = $args{version};
119    my $id = $args{id} || "Home";
120    my $wiki = $self->wiki;
121    my $config = $self->config;
122
123    my %tt_vars;
124
125    if ( $id =~ /^(Category|Locale) (.*)$/ ) {
126        my $type = $1;
127        $tt_vars{is_indexable_node} = 1;
128        $tt_vars{index_type} = lc($type);
129        $tt_vars{index_value} = $2;
130    }
131
132    my %current_data = $wiki->retrieve_node( $id );
133    my $current_version = $current_data{version};
134    undef $version if ($version && $version == $current_version);
135    my %criteria = ( name => $id );
136    $criteria{version} = $version if $version;#retrieve_node default is current
137
138    my %node_data = $wiki->retrieve_node( %criteria );
139    my $raw = $node_data{content};
140    if ( $raw =~ /^#REDIRECT\s+(.+?)\s*$/ ) {
141        my $redirect = $1;
142        # Strip off enclosing [[ ]] in case this is an extended link.
143        $redirect =~ s/^\[\[//;
144        $redirect =~ s/\]\]\s*$//;
145        # See if this is a valid node, if not then just show the page as-is.
146        if ( $wiki->node_exists($redirect) ) {
147            redirect_to_node($redirect);
148        }
149    }
150    my $content    = $wiki->format($raw);
151    my $modified   = $node_data{last_modified};
152    my %metadata   = %{$node_data{metadata}};
153
154    my %metadata_vars = OpenGuides::Template->extract_metadata_vars(
155                            wiki     => $wiki,
156                            config   => $config,
157                            metadata => $node_data{metadata} );
158
159    %tt_vars = (
160                 %tt_vars,
161                 %metadata_vars,
162                 content       => $content,
163                 geocache_link => $self->make_geocache_link($id),
164                 last_modified => $modified,
165                 version       => $node_data{version},
166                 node_name     => CGI->escapeHTML($id),
167                 node_param    => CGI->escape($id),
168                 language      => $config->{_}->{default_language},
169               );
170
171
172    # We've undef'ed $version above if this is the current version.
173    $tt_vars{current} = 1 unless $version;
174
175    if ($id eq "RecentChanges") {
176        my $minor_edits = $self->get_cookie( "show_minor_edits_in_rc" );
177        my %criteria = ( days => 7 );
178        $criteria{metadata_was} = { edit_type => "Normal edit" }
179          unless $minor_edits;
180        my @recent = $wiki->list_recent_changes( %criteria );
181        @recent = map { {name          => CGI->escapeHTML($_->{name}),
182                         last_modified => CGI->escapeHTML($_->{last_modified}),
183                         comment       => CGI->escapeHTML($_->{metadata}{comment}[0]),
184                         username      => CGI->escapeHTML($_->{metadata}{username}[0]),
185                         host          => CGI->escapeHTML($_->{metadata}{host}[0]),
186                         username_param => CGI->escape($_->{metadata}{username}[0]),
187                         edit_type     => CGI->escapeHTML($_->{metadata}{edit_type}[0]),
188                         url           => "$config->{_}->{script_name}?"
189          . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name})) }
190                       } @recent;
191        $tt_vars{recent_changes} = \@recent;
192        $tt_vars{days} = 7;
193        my $output = $self->process_template(
194                                          id            => $id,
195                                          template      => "recent_changes.tt",
196                                          tt_vars       => \%tt_vars,
197                                            );
198        return $output if $return_output;
199        print $output;
200    } elsif ($id eq "Home") {
201        my @recent = $wiki->list_recent_changes(
202            last_n_changes => 10,
203            metadata_was   => { edit_type => "Normal edit" },
204        );
205        @recent = map { {name          => CGI->escapeHTML($_->{name}),
206                         last_modified => CGI->escapeHTML($_->{last_modified}),
207                         comment       => CGI->escapeHTML($_->{metadata}{comment}[0]),
208                         username      => CGI->escapeHTML($_->{metadata}{username}[0]),
209                         url           => "$config->{_}->{script_name}?"
210          . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name})) }
211                       } @recent;
212        $tt_vars{recent_changes} = \@recent;
213        my $output = $self->process_template(
214                                              id            => $id,
215                                              template      => "home_node.tt",
216                                              tt_vars       => \%tt_vars,
217                                            );
218        return $output if $return_output;
219        print $output;
220    } else {
221        my $output = $self->process_template(
222                                              id            => $id,
223                                              template      => "node.tt",
224                                              tt_vars       => \%tt_vars,
225                                            );
226        return $output if $return_output;
227        print $output;
228    }
229}
230
231=item B<display_diffs>
232
233  $guide->display_diffs(
234                         id            => "Home Page",
235                         version       => 6,
236                         other_version => 5,
237                       );
238
239=cut
240
241sub display_diffs {
242    my ($self, %args) = @_;
243    my %diff_vars = $self->differ->differences(
244                                        node          => $args{id},
245                                        left_version  => $args{version},
246                                        right_version => $args{other_version},
247                                              );
248    print $self->process_template(
249                                   id       => $args{id},
250                                   template => "differences.tt",
251                                   vars     => \%diff_vars
252                                 );
253}
254
255=item B<find_within_distance>
256
257  $guide->find_within_distance(
258                                id => $node,
259                                metres => $q->param("distance_in_metres")
260                              );
261
262=cut
263
264sub find_within_distance {
265    my ($self, %args) = @_;
266    my $node = $args{node};
267    my $metres = $args{metres};
268    my $formatter = $self->wiki->formatter;
269
270    my @finds = $self->locator->find_within_distance(
271                                                      node   => $node,
272                                                      metres => $metres,
273                                                    );
274    my @nodes;
275    foreach my $find ( @finds ) {
276        my $distance = $self->locator->distance(
277                                                 from_node => $node,
278                                                 to_node   => $find,
279                                                 unit      => "metres"
280                                               );
281        push @nodes, {
282                       name     => $find,
283                       param    => $formatter->node_name_to_node_param($find),
284                       distance => $distance,
285                     };
286    }
287    @nodes = sort { $a->{distance} <=> $b->{distance} } @nodes;
288
289    my %tt_vars = (
290                    nodes        => \@nodes,
291                    origin       => $node,
292                    origin_param => $formatter->node_name_to_node_param($node),
293                    limit        => "$metres metres",
294                  );
295
296    $self->process_template(
297                             id       => "index", # KLUDGE
298                             template => "site_index.tt",
299                             vars     => \%tt_vars,
300                           );
301}
302
303sub process_template {
304    my ($self, %args) = @_;
305    my %output_conf = ( wiki     => $self->wiki,
306                        config   => $self->config,
307                        node     => $args{id},
308                        template => $args{template},
309                        vars     => $args{tt_vars},
310    );
311    return OpenGuides::Template->output( %output_conf );
312}
313
314sub get_cookie {
315    my $self = shift;
316    my $config = $self->config;
317    my $pref_name = shift or return "";
318    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
319    return $cookie_data{$pref_name};
320}
321
322sub make_geocache_link {
323    my $self = shift;
324    my $wiki = $self->wiki;
325    my $config = $self->config;
326    return "" unless $self->get_cookie( "include_geocache_link" );
327    my $node = shift || $config->{_}->{home_name};
328    my %current_data = $wiki->retrieve_node( $node );
329    my %criteria     = ( name => $node );
330    my %node_data    = $wiki->retrieve_node( %criteria );
331    my %metadata     = %{$node_data{metadata}};
332    my $latitude     = $metadata{latitude}[0];
333    my $longitude    = $metadata{longitude}[0];
334    my $geocache     = CGI::Wiki::Plugin::GeoCache->new();
335    my $link_text    = "Look for nearby geocaches";
336
337    if ($latitude && $longitude) {
338        my $cache_url    = $geocache->make_link(
339                                        latitude  => $latitude,
340                                        longitude => $longitude,
341                                        link_text => $link_text
342                                );
343        return $cache_url;
344    }
345    else {
346        return "";
347    }
348}
349
350=back
351
352=head1 BUGS AND CAVEATS
353
354At the moment, the location data uses a United-Kingdom-specific module,
355so the location features might not work so well outside the UK.
356
357=head1 SEE ALSO
358
359=over 4
360
361=item * L<http://london.openguides.org/|The Open Guide to London>, the first and biggest OpenGuides site.
362
363=item * L<http://openguides.org/|The OpenGuides website>, with a list of all live OpenGuides installs.
364
365=item * L<CGI::Wiki>, the Wiki toolkit which does the heavy lifting for OpenGuides
366
367=back
368
369=head1 FEEDBACK
370
371If you have a question, a bug report, or a patch, or you're interested
372in joining the development team, please contact openguides-dev@openguides.org
373(moderated mailing list, will reach all current developers but you'll have
374to wait for your post to be approved) or kake@earth.li (a real person who
375may take a little while to reply to your mail if she's busy).
376
377=head1 AUTHOR
378
379The OpenGuides Project (openguides-dev@openguides.org)
380
381=head1 COPYRIGHT
382
383     Copyright (C) 2003-4 The OpenGuides Project.  All Rights Reserved.
384
385The OpenGuides distribution is free software; you can redistribute it
386and/or modify it under the same terms as Perl itself.
387
388=head1 CREDITS
389
390Programming by Earle Martin, Kake Pugh, Ivor Williams.  Testing and
391bug reporting by Cal Henderson, Bob Walker, Kerry Bosworth, Dominic
392Hargreaves, Simon Cozens, among others.  Much of the Module::Build
393stuff copied from the Siesta project L<http://siesta.unixbeard.net/>
394
395=cut
396
3971;
Note: See TracBrowser for help on using the repository browser.