source: trunk/lib/OpenGuides.pm @ 393

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

Fix bugs with URLs and <title> in category/locale index.

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