source: trunk/lib/OpenGuides.pm @ 376

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

Added alternative outputs to OpenGuides->display_diffs, fixed template bug that had versions not showing up in differences.tt

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