source: trunk/lib/OpenGuides.pm @ 373

Last change on this file since 373 was 373, checked in by kake, 17 years ago

Move show_index stuff into OpenGuides.pm

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 15.2 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
303=item B<show_index>
304
305  $guide->show_index(
306                      type   => "category",
307                      value  => "pubs",
308                    );
309
310  # RDF version.
311  $guide->show_index(
312                      type   => "locale",
313                      value  => "Holborn",
314                      format => "rdf",
315                    );
316
317=cut
318
319sub show_index {
320    my ($self, %args) = @_;
321    my $wiki = $self->wiki;
322    my $formatter = $wiki->formatter;
323    my %tt_vars;
324    my @selnodes;
325
326    if ( $args{type} and $args{value} ) {
327        if ( $args{type} eq "fuzzy_title_match" ) {
328            my %finds = $wiki->fuzzy_title_match( $args{value} );
329            @selnodes = sort { $finds{$a} <=> $finds{$b} } keys %finds;
330            $tt_vars{criterion} = {
331                type  => $args{type},  # for RDF version
332                value => $args{value}, # for RDF version
333                name  => $CGI->escapeHTML("Fuzzy Title Match on '$args{value}')
334            };
335        } else {
336            @selnodes = $wiki->list_nodes_by_metadata(
337                metadata_type  => $args{type},
338                metadata_value => $args{value},
339                ignore_case    => 1,
340            );
341            my $name = ucfirst($args{type}) . " $args{value}" ;
342            my $url = $self->config->{_}->{script_name}
343                      . ucfirst( $args{type} )
344                      . "_"
345                      . uri_escape(
346                              $formatter->node_name_to_node_param($args{value})
347                                  );
348            $tt_vars{criterion} = {
349                type  => $args{type},
350                value => $args{value}, # for RDF version
351                name  => $CGI->escapeHTML( $name ),
352                url   => $url,
353            };
354        }
355    } else {
356        @selnodes = $wiki->list_all_nodes();
357    }
358
359    my @nodes = map { { name      => $_,
360                        node_data => { $wiki->retrieve_node( name => $_ ) },
361                        param     => $formatter->node_name_to_node_param($_) }
362                    } sort @selnodes;
363
364    $tt_vars{nodes} = \@nodes;
365
366    my ($template, %conf);
367
368    if ( $args{format} eq "rdf" ) {
369        $template = "rdf_index.tt";
370        $conf{content_type} = "text/plain";
371    } else {
372        $template = "site_index.tt";
373    }
374
375    %conf = (
376              %conf,
377              node        => "$args{type} index", # KLUDGE
378              template    => $template,
379              tt_vars     => \%tt_vars,
380    );
381
382    print $self->process_template( %conf );
383}
384
385
386
387sub process_template {
388    my ($self, %args) = @_;
389    my %output_conf = ( wiki     => $self->wiki,
390                        config   => $self->config,
391                        node     => $args{id},
392                        template => $args{template},
393                        vars     => $args{tt_vars},
394    );
395    $output_conf{content_type} = $args{content_type} if $args{content_type};
396    return OpenGuides::Template->output( %output_conf );
397}
398
399sub get_cookie {
400    my $self = shift;
401    my $config = $self->config;
402    my $pref_name = shift or return "";
403    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
404    return $cookie_data{$pref_name};
405}
406
407sub make_geocache_link {
408    my $self = shift;
409    my $wiki = $self->wiki;
410    my $config = $self->config;
411    return "" unless $self->get_cookie( "include_geocache_link" );
412    my $node = shift || $config->{_}->{home_name};
413    my %current_data = $wiki->retrieve_node( $node );
414    my %criteria     = ( name => $node );
415    my %node_data    = $wiki->retrieve_node( %criteria );
416    my %metadata     = %{$node_data{metadata}};
417    my $latitude     = $metadata{latitude}[0];
418    my $longitude    = $metadata{longitude}[0];
419    my $geocache     = CGI::Wiki::Plugin::GeoCache->new();
420    my $link_text    = "Look for nearby geocaches";
421
422    if ($latitude && $longitude) {
423        my $cache_url    = $geocache->make_link(
424                                        latitude  => $latitude,
425                                        longitude => $longitude,
426                                        link_text => $link_text
427                                );
428        return $cache_url;
429    }
430    else {
431        return "";
432    }
433}
434
435=back
436
437=head1 BUGS AND CAVEATS
438
439At the moment, the location data uses a United-Kingdom-specific module,
440so the location features might not work so well outside the UK.
441
442=head1 SEE ALSO
443
444=over 4
445
446=item * L<http://london.openguides.org/|The Open Guide to London>, the first and biggest OpenGuides site.
447
448=item * L<http://openguides.org/|The OpenGuides website>, with a list of all live OpenGuides installs.
449
450=item * L<CGI::Wiki>, the Wiki toolkit which does the heavy lifting for OpenGuides
451
452=back
453
454=head1 FEEDBACK
455
456If you have a question, a bug report, or a patch, or you're interested
457in joining the development team, please contact openguides-dev@openguides.org
458(moderated mailing list, will reach all current developers but you'll have
459to wait for your post to be approved) or kake@earth.li (a real person who
460may take a little while to reply to your mail if she's busy).
461
462=head1 AUTHOR
463
464The OpenGuides Project (openguides-dev@openguides.org)
465
466=head1 COPYRIGHT
467
468     Copyright (C) 2003-4 The OpenGuides Project.  All Rights Reserved.
469
470The OpenGuides distribution is free software; you can redistribute it
471and/or modify it under the same terms as Perl itself.
472
473=head1 CREDITS
474
475Programming by Earle Martin, Kake Pugh, Ivor Williams.  Testing and
476bug reporting by Cal Henderson, Bob Walker, Kerry Bosworth, Dominic
477Hargreaves, Simon Cozens, among others.  Much of the Module::Build
478stuff copied from the Siesta project L<http://siesta.unixbeard.net/>
479
480=cut
481
4821;
Note: See TracBrowser for help on using the repository browser.