source: trunk/lib/OpenGuides.pm @ 385

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

Remove hardcoding of home node name from ->display_node, write tests.

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