source: trunk/lib/OpenGuides.pm @ 391

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

Bump version number.

  • 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::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_04';
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            redirect_to_node($redirect);
158        }
159    }
160    my $content    = $wiki->format($raw);
161    my $modified   = $node_data{last_modified};
162    my %metadata   = %{$node_data{metadata}};
163
164    my %metadata_vars = OpenGuides::Template->extract_metadata_vars(
165                            wiki     => $wiki,
166                            config   => $config,
167                            metadata => $node_data{metadata} );
168
169    %tt_vars = (
170                 %tt_vars,
171                 %metadata_vars,
172                 content       => $content,
173                 geocache_link => $self->make_geocache_link($id),
174                 last_modified => $modified,
175                 version       => $node_data{version},
176                 node_name     => CGI->escapeHTML($id),
177                 node_param    => CGI->escape($id),
178                 language      => $config->{_}->{default_language},
179               );
180
181
182    # We've undef'ed $version above if this is the current version.
183    $tt_vars{current} = 1 unless $version;
184
185    if ($id eq "RecentChanges") {
186        my $minor_edits = $self->get_cookie( "show_minor_edits_in_rc" );
187        my %criteria = ( days => 7 );
188        $criteria{metadata_was} = { edit_type => "Normal edit" }
189          unless $minor_edits;
190        my @recent = $wiki->list_recent_changes( %criteria );
191        @recent = map { {name          => CGI->escapeHTML($_->{name}),
192                         last_modified => CGI->escapeHTML($_->{last_modified}),
193                         comment       => CGI->escapeHTML($_->{metadata}{comment}[0]),
194                         username      => CGI->escapeHTML($_->{metadata}{username}[0]),
195                         host          => CGI->escapeHTML($_->{metadata}{host}[0]),
196                         username_param => CGI->escape($_->{metadata}{username}[0]),
197                         edit_type     => CGI->escapeHTML($_->{metadata}{edit_type}[0]),
198                         url           => "$config->{_}->{script_name}?"
199          . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name})) }
200                       } @recent;
201        $tt_vars{recent_changes} = \@recent;
202        $tt_vars{days} = 7;
203        return %tt_vars if $args{return_tt_vars};
204        my $output = $self->process_template(
205                                          id            => $id,
206                                          template      => "recent_changes.tt",
207                                          tt_vars       => \%tt_vars,
208                                            );
209        return $output if $return_output;
210        print $output;
211    } elsif ( $id eq $self->config->{_}->{home_name} ) {
212        my @recent = $wiki->list_recent_changes(
213            last_n_changes => 10,
214            metadata_was   => { edit_type => "Normal edit" },
215        );
216        @recent = map { {name          => CGI->escapeHTML($_->{name}),
217                         last_modified => CGI->escapeHTML($_->{last_modified}),
218                         comment       => CGI->escapeHTML($_->{metadata}{comment}[0]),
219                         username      => CGI->escapeHTML($_->{metadata}{username}[0]),
220                         url           => "$config->{_}->{script_name}?"
221          . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name})) }
222                       } @recent;
223        $tt_vars{recent_changes} = \@recent;
224        return %tt_vars if $args{return_tt_vars};
225        my $output = $self->process_template(
226                                              id            => $id,
227                                              template      => "home_node.tt",
228                                              tt_vars       => \%tt_vars,
229                                            );
230        return $output if $return_output;
231        print $output;
232    } else {
233        return %tt_vars if $args{return_tt_vars};
234        my $output = $self->process_template(
235                                              id            => $id,
236                                              template      => "node.tt",
237                                              tt_vars       => \%tt_vars,
238                                            );
239        return $output if $return_output;
240        print $output;
241    }
242}
243
244=item B<display_diffs>
245
246  $guide->display_diffs(
247                         id            => "Home Page",
248                         version       => 6,
249                         other_version => 5,
250                       );
251
252  # Or return output as a string (useful for writing tests).
253  my $output = $guide->display_diffs(
254                                      id            => "Home Page",
255                                      version       => 6,
256                                      other_version => 5,
257                                      return_output => 1,
258                                    );
259
260  # Or return the hash of variables that will be passed to the template
261  # (not including those set additionally by OpenGuides::Template).
262  my %vars = $guide->display_diffs(
263                                    id             => "Home Page",
264                                    version        => 6,
265                                    other_version  => 5,
266                                    return_tt_vars => 1,
267                                  );
268
269=cut
270
271sub display_diffs {
272    my ($self, %args) = @_;
273    my %diff_vars = $self->differ->differences(
274                                        node          => $args{id},
275                                        left_version  => $args{version},
276                                        right_version => $args{other_version},
277                                              );
278    return %diff_vars if $args{return_tt_vars};
279    my $output = $self->process_template(
280                                          id       => $args{id},
281                                          template => "differences.tt",
282                                          tt_vars  => \%diff_vars
283                                        );
284    return $output if $args{return_output};
285    print $output;
286}
287
288=item B<find_within_distance>
289
290  $guide->find_within_distance(
291                                id => $node,
292                                metres => $q->param("distance_in_metres")
293                              );
294
295=cut
296
297sub find_within_distance {
298    my ($self, %args) = @_;
299    my $node = $args{node};
300    my $metres = $args{metres};
301    my $formatter = $self->wiki->formatter;
302
303    my @finds = $self->locator->find_within_distance(
304                                                      node   => $node,
305                                                      metres => $metres,
306                                                    );
307    my @nodes;
308    foreach my $find ( @finds ) {
309        my $distance = $self->locator->distance(
310                                                 from_node => $node,
311                                                 to_node   => $find,
312                                                 unit      => "metres"
313                                               );
314        push @nodes, {
315                       name     => $find,
316                       param    => $formatter->node_name_to_node_param($find),
317                       distance => $distance,
318                     };
319    }
320    @nodes = sort { $a->{distance} <=> $b->{distance} } @nodes;
321
322    my %tt_vars = (
323                    nodes        => \@nodes,
324                    origin       => $node,
325                    origin_param => $formatter->node_name_to_node_param($node),
326                    limit        => "$metres metres",
327                  );
328
329    print $self->process_template(
330                                   id       => "index", # KLUDGE
331                                   template => "site_index.tt",
332                                   vars     => \%tt_vars,
333                                 );
334}
335
336=item B<show_index>
337
338  $guide->show_index(
339                      type   => "category",
340                      value  => "pubs",
341                    );
342
343  # RDF version.
344  $guide->show_index(
345                      type   => "locale",
346                      value  => "Holborn",
347                      format => "rdf",
348                    );
349
350  # Or return output as a string (useful for writing tests).
351  $guide->show_index(
352                      type          => "category",
353                      value         => "pubs",
354                      return_output => 1,
355                    );
356
357=cut
358
359sub show_index {
360    my ($self, %args) = @_;
361    my $wiki = $self->wiki;
362    my $formatter = $wiki->formatter;
363    my %tt_vars;
364    my @selnodes;
365
366    if ( $args{type} and $args{value} ) {
367        if ( $args{type} eq "fuzzy_title_match" ) {
368            my %finds = $wiki->fuzzy_title_match( $args{value} );
369            @selnodes = sort { $finds{$a} <=> $finds{$b} } keys %finds;
370            $tt_vars{criterion} = {
371                type  => $args{type},  # for RDF version
372                value => $args{value}, # for RDF version
373                name  => CGI->escapeHTML("Fuzzy Title Match on '$args{value}'")
374            };
375        } else {
376            @selnodes = $wiki->list_nodes_by_metadata(
377                metadata_type  => $args{type},
378                metadata_value => $args{value},
379                ignore_case    => 1,
380            );
381            my $name = ucfirst($args{type}) . " $args{value}" ;
382            my $url = $self->config->{_}->{script_name}
383                      . ucfirst( $args{type} )
384                      . "_"
385                      . uri_escape(
386                              $formatter->node_name_to_node_param($args{value})
387                                  );
388            $tt_vars{criterion} = {
389                type  => $args{type},
390                value => $args{value}, # for RDF version
391                name  => CGI->escapeHTML( $name ),
392                url   => $url,
393            };
394        }
395    } else {
396        @selnodes = $wiki->list_all_nodes();
397    }
398
399    my @nodes = map { { name      => $_,
400                        node_data => { $wiki->retrieve_node( name => $_ ) },
401                        param     => $formatter->node_name_to_node_param($_) }
402                    } sort @selnodes;
403
404    $tt_vars{nodes} = \@nodes;
405
406    my ($template, %conf);
407
408    if ( $args{format} and $args{format} eq "rdf" ) {
409        $template = "rdf_index.tt";
410        $conf{content_type} = "text/plain";
411    } else {
412        $template = "site_index.tt";
413    }
414
415    %conf = (
416              %conf,
417              node        => "$args{type} index", # KLUDGE
418              template    => $template,
419              tt_vars     => \%tt_vars,
420    );
421
422    my $output = $self->process_template( %conf );
423    return $output if $args{return_output};
424    print $output;
425}
426
427=item B<list_all_versions>
428
429  $guide->list_all_versions ( id => "Home Page" );
430
431=cut
432
433sub list_all_versions {
434    my ($self, %args) = @_;
435    my $node = $args{id};
436    my %curr_data = $self->wiki->retrieve_node($node);
437    my $curr_version = $curr_data{version};
438    croak "This is the first version" unless $curr_version > 1;
439    my @history;
440    for my $version ( 1 .. $curr_version ) {
441        my %node_data = $self->wiki->retrieve_node( name    => $node,
442                                                    version => $version );
443        push @history, { version  => $version,
444                         modified => $node_data{last_modified},
445                         username => $node_data{metadata}{username}[0],
446                         comment  => $node_data{metadata}{comment}[0]   };
447    }
448    @history = reverse @history;
449    my %tt_vars = ( node    => $node,
450                    version => $curr_version,
451                    history => \@history );
452    print $self->process_template(
453                                   id       => $node,
454                                   template => "node_history.tt",
455                                   tt_vars  => \%tt_vars,
456                                 );
457}
458
459sub process_template {
460    my ($self, %args) = @_;
461    my %output_conf = ( wiki     => $self->wiki,
462                        config   => $self->config,
463                        node     => $args{id},
464                        template => $args{template},
465                        vars     => $args{tt_vars},
466    );
467    if ( $args{content_type} ) {
468        $output_conf{content_type} = "";
469        my $output = "Content-Type: $args{content_type}\n\n"
470                     . OpenGuides::Template->output( %output_conf );
471    } else {
472        return OpenGuides::Template->output( %output_conf );
473    }
474}
475
476sub get_cookie {
477    my $self = shift;
478    my $config = $self->config;
479    my $pref_name = shift or return "";
480    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
481    return $cookie_data{$pref_name};
482}
483
484sub make_geocache_link {
485    my $self = shift;
486    my $wiki = $self->wiki;
487    my $config = $self->config;
488    return "" unless $self->get_cookie( "include_geocache_link" );
489    my $node = shift || $config->{_}->{home_name};
490    my %current_data = $wiki->retrieve_node( $node );
491    my %criteria     = ( name => $node );
492    my %node_data    = $wiki->retrieve_node( %criteria );
493    my %metadata     = %{$node_data{metadata}};
494    my $latitude     = $metadata{latitude}[0];
495    my $longitude    = $metadata{longitude}[0];
496    my $geocache     = CGI::Wiki::Plugin::GeoCache->new();
497    my $link_text    = "Look for nearby geocaches";
498
499    if ($latitude && $longitude) {
500        my $cache_url    = $geocache->make_link(
501                                        latitude  => $latitude,
502                                        longitude => $longitude,
503                                        link_text => $link_text
504                                );
505        return $cache_url;
506    }
507    else {
508        return "";
509    }
510}
511
512=back
513
514=head1 BUGS AND CAVEATS
515
516At the moment, the location data uses a United-Kingdom-specific module,
517so the location features might not work so well outside the UK.
518
519=head1 SEE ALSO
520
521=over 4
522
523=item * L<http://london.openguides.org/|The Open Guide to London>, the first and biggest OpenGuides site.
524
525=item * L<http://openguides.org/|The OpenGuides website>, with a list of all live OpenGuides installs.
526
527=item * L<CGI::Wiki>, the Wiki toolkit which does the heavy lifting for OpenGuides
528
529=back
530
531=head1 FEEDBACK
532
533If you have a question, a bug report, or a patch, or you're interested
534in joining the development team, please contact openguides-dev@openguides.org
535(moderated mailing list, will reach all current developers but you'll have
536to wait for your post to be approved) or kake@earth.li (a real person who
537may take a little while to reply to your mail if she's busy).
538
539=head1 AUTHOR
540
541The OpenGuides Project (openguides-dev@openguides.org)
542
543=head1 COPYRIGHT
544
545     Copyright (C) 2003-4 The OpenGuides Project.  All Rights Reserved.
546
547The OpenGuides distribution is free software; you can redistribute it
548and/or modify it under the same terms as Perl itself.
549
550=head1 CREDITS
551
552Programming by Earle Martin, Kake Pugh, Ivor Williams.  Testing and
553bug reporting by Cal Henderson, Bob Walker, Kerry Bosworth, Dominic
554Hargreaves, Simon Cozens, among others.  Much of the Module::Build
555stuff copied from the Siesta project L<http://siesta.unixbeard.net/>
556
557=cut
558
5591;
Note: See TracBrowser for help on using the repository browser.