source: trunk/lib/OpenGuides.pm @ 380

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

Ensure RDF has content-type of text/plain.

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