source: trunk/lib/OpenGuides.pm @ 374

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

Move list_all_versions stuff into OpenGuides.pm

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 16.3 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    print $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=item B<list_all_versions>
386
387  $guide->list_all_versions ( id => "Home Page" );
388
389=cut
390
391sub list_all_versions {
392    my ($self, %args) = @_;
393    my $node = $args{id};
394    my %curr_data = $self->wiki->retrieve_node($node);
395    my $curr_version = $curr_data{version};
396    croak "This is the first version" unless $curr_version > 1;
397    my @history;
398    for my $version ( 1 .. $curr_version ) {
399        my %node_data = $self->wiki->retrieve_node( name    => $node,
400                                                    version => $version );
401        push @history, { version  => $version,
402                         modified => $node_data{last_modified},
403                         username => $node_data{metadata}{username}[0],
404                         comment  => $node_data{metadata}{comment}[0]   };
405    }
406    @history = reverse @history;
407    my %tt_vars = ( node    => $node,
408                    version => $curr_version,
409                    history => \@history );
410    print $self->process_template(
411                                   id       => $node,
412                                   template => "node_history.tt",
413                                   tt_vars  => \%tt_vars,
414                                 );
415}
416
417sub process_template {
418    my ($self, %args) = @_;
419    my %output_conf = ( wiki     => $self->wiki,
420                        config   => $self->config,
421                        node     => $args{id},
422                        template => $args{template},
423                        vars     => $args{tt_vars},
424    );
425    $output_conf{content_type} = $args{content_type} if $args{content_type};
426    return OpenGuides::Template->output( %output_conf );
427}
428
429sub get_cookie {
430    my $self = shift;
431    my $config = $self->config;
432    my $pref_name = shift or return "";
433    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
434    return $cookie_data{$pref_name};
435}
436
437sub make_geocache_link {
438    my $self = shift;
439    my $wiki = $self->wiki;
440    my $config = $self->config;
441    return "" unless $self->get_cookie( "include_geocache_link" );
442    my $node = shift || $config->{_}->{home_name};
443    my %current_data = $wiki->retrieve_node( $node );
444    my %criteria     = ( name => $node );
445    my %node_data    = $wiki->retrieve_node( %criteria );
446    my %metadata     = %{$node_data{metadata}};
447    my $latitude     = $metadata{latitude}[0];
448    my $longitude    = $metadata{longitude}[0];
449    my $geocache     = CGI::Wiki::Plugin::GeoCache->new();
450    my $link_text    = "Look for nearby geocaches";
451
452    if ($latitude && $longitude) {
453        my $cache_url    = $geocache->make_link(
454                                        latitude  => $latitude,
455                                        longitude => $longitude,
456                                        link_text => $link_text
457                                );
458        return $cache_url;
459    }
460    else {
461        return "";
462    }
463}
464
465=back
466
467=head1 BUGS AND CAVEATS
468
469At the moment, the location data uses a United-Kingdom-specific module,
470so the location features might not work so well outside the UK.
471
472=head1 SEE ALSO
473
474=over 4
475
476=item * L<http://london.openguides.org/|The Open Guide to London>, the first and biggest OpenGuides site.
477
478=item * L<http://openguides.org/|The OpenGuides website>, with a list of all live OpenGuides installs.
479
480=item * L<CGI::Wiki>, the Wiki toolkit which does the heavy lifting for OpenGuides
481
482=back
483
484=head1 FEEDBACK
485
486If you have a question, a bug report, or a patch, or you're interested
487in joining the development team, please contact openguides-dev@openguides.org
488(moderated mailing list, will reach all current developers but you'll have
489to wait for your post to be approved) or kake@earth.li (a real person who
490may take a little while to reply to your mail if she's busy).
491
492=head1 AUTHOR
493
494The OpenGuides Project (openguides-dev@openguides.org)
495
496=head1 COPYRIGHT
497
498     Copyright (C) 2003-4 The OpenGuides Project.  All Rights Reserved.
499
500The OpenGuides distribution is free software; you can redistribute it
501and/or modify it under the same terms as Perl itself.
502
503=head1 CREDITS
504
505Programming by Earle Martin, Kake Pugh, Ivor Williams.  Testing and
506bug reporting by Cal Henderson, Bob Walker, Kerry Bosworth, Dominic
507Hargreaves, Simon Cozens, among others.  Much of the Module::Build
508stuff copied from the Siesta project L<http://siesta.unixbeard.net/>
509
510=cut
511
5121;
Note: See TracBrowser for help on using the repository browser.