source: trunk/lib/OpenGuides.pm @ 446

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

Bumped version number.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 21.8 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.37';
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                         version       => CGI->escapeHTML($_->{version}),
197                         comment       => CGI->escapeHTML($_->{metadata}{comment}[0]),
198                         username      => CGI->escapeHTML($_->{metadata}{username}[0]),
199                         host          => CGI->escapeHTML($_->{metadata}{host}[0]),
200                         username_param => CGI->escape($_->{metadata}{username}[0]),
201                         edit_type     => CGI->escapeHTML($_->{metadata}{edit_type}[0]),
202                         url           => "$config->{_}->{script_name}?"
203          . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name})) }
204                       } @recent;
205        $tt_vars{recent_changes} = \@recent;
206        $tt_vars{days} = 7;
207        return %tt_vars if $args{return_tt_vars};
208        my $output = $self->process_template(
209                                          id            => $id,
210                                          template      => "recent_changes.tt",
211                                          tt_vars       => \%tt_vars,
212                                            );
213        return $output if $return_output;
214        print $output;
215    } elsif ( $id eq $self->config->{_}->{home_name} ) {
216        my @recent = $wiki->list_recent_changes(
217            last_n_changes => 10,
218            metadata_was   => { edit_type => "Normal edit" },
219        );
220        @recent = map { {name          => CGI->escapeHTML($_->{name}),
221                         last_modified => CGI->escapeHTML($_->{last_modified}),
222                         comment       => CGI->escapeHTML($_->{metadata}{comment}[0]),
223                         username      => CGI->escapeHTML($_->{metadata}{username}[0]),
224                         url           => "$config->{_}->{script_name}?"
225          . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name})) }
226                       } @recent;
227        $tt_vars{recent_changes} = \@recent;
228        return %tt_vars if $args{return_tt_vars};
229        my $output = $self->process_template(
230                                              id            => $id,
231                                              template      => "home_node.tt",
232                                              tt_vars       => \%tt_vars,
233                                            );
234        return $output if $return_output;
235        print $output;
236    } else {
237        return %tt_vars if $args{return_tt_vars};
238        my $output = $self->process_template(
239                                              id            => $id,
240                                              template      => "node.tt",
241                                              tt_vars       => \%tt_vars,
242                                            );
243        return $output if $return_output;
244        print $output;
245    }
246}
247
248=item B<display_diffs>
249
250  $guide->display_diffs(
251                         id            => "Home Page",
252                         version       => 6,
253                         other_version => 5,
254                       );
255
256  # Or return output as a string (useful for writing tests).
257  my $output = $guide->display_diffs(
258                                      id            => "Home Page",
259                                      version       => 6,
260                                      other_version => 5,
261                                      return_output => 1,
262                                    );
263
264  # Or return the hash of variables that will be passed to the template
265  # (not including those set additionally by OpenGuides::Template).
266  my %vars = $guide->display_diffs(
267                                    id             => "Home Page",
268                                    version        => 6,
269                                    other_version  => 5,
270                                    return_tt_vars => 1,
271                                  );
272
273=cut
274
275sub display_diffs {
276    my ($self, %args) = @_;
277    my %diff_vars = $self->differ->differences(
278                                        node          => $args{id},
279                                        left_version  => $args{version},
280                                        right_version => $args{other_version},
281                                              );
282    return %diff_vars if $args{return_tt_vars};
283    my $output = $self->process_template(
284                                          id       => $args{id},
285                                          template => "differences.tt",
286                                          tt_vars  => \%diff_vars
287                                        );
288    return $output if $args{return_output};
289    print $output;
290}
291
292=item B<find_within_distance>
293
294  $guide->find_within_distance(
295                                id => $node,
296                                metres => $q->param("distance_in_metres")
297                              );
298
299=cut
300
301sub find_within_distance {
302    my ($self, %args) = @_;
303    my $node = $args{id};
304    my $metres = $args{metres};
305    my $formatter = $self->wiki->formatter;
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                                   tt_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  # Or return output as a string (useful for writing tests).
436  $guide->list_all_versions (
437                              id            => "Home Page",
438                              return_output => 1,
439                            );
440
441  # Or return the hash of variables that will be passed to the template
442  # (not including those set additionally by OpenGuides::Template).
443  $guide->list_all_versions (
444                              id             => "Home Page",
445                              return_tt_vars => 1,
446                            );
447
448=cut
449
450sub list_all_versions {
451    my ($self, %args) = @_;
452    my $return_output = $args{return_output} || 0;
453    my $node = $args{id};
454    my %curr_data = $self->wiki->retrieve_node($node);
455    my $curr_version = $curr_data{version};
456    croak "This is the first version" unless $curr_version > 1;
457    my @history;
458    for my $version ( 1 .. $curr_version ) {
459        my %node_data = $self->wiki->retrieve_node( name    => $node,
460                                                    version => $version );
461        # $node_data{version} will be zero if this version was deleted.
462        push @history, {
463            version  => CGI->escapeHTML( $version ),
464            modified => CGI->escapeHTML( $node_data{last_modified} ),
465            username => CGI->escapeHTML( $node_data{metadata}{username}[0] ),
466            comment  => CGI->escapeHTML( $node_data{metadata}{comment}[0] ),
467                       } if $node_data{version};
468    }
469    @history = reverse @history;
470    my %tt_vars = ( node          => $node,
471                    version       => $curr_version,
472                    not_deletable => 1,
473                    history       => \@history );
474    return %tt_vars if $args{return_tt_vars};
475    my $output = $self->process_template(
476                                          id       => $node,
477                                          template => "node_history.tt",
478                                          tt_vars  => \%tt_vars,
479                                        );
480    return $output if $return_output;
481    print $output;
482}
483
484=item B<delete_node>
485
486  $guide->delete_node(
487                       id       => "FAQ",
488                       version  => 15,
489                       password => "beer",
490                     );
491
492C<version> is optional - if it isn't supplied then all versions of the
493node will be deleted; in other words the node will be entirely
494removed.
495
496If C<password> is not supplied then a form for entering the password
497will be displayed.
498
499=cut
500
501sub delete_node {
502    my ($self, %args) = @_;
503    my $node = $args{id} or croak "No node ID supplied for deletion";
504
505    my %tt_vars = (
506                    not_editable  => 1,
507                    not_deletable => 1,
508                  );
509    $tt_vars{delete_version} = $args{version} || "";
510
511    my $password = $args{password};
512
513    if ($password) {
514        if ($password ne $self->config->{_}->{admin_pass}) {
515            print $self->process_template(
516                                     id       => $node,
517                                     template => "delete_password_wrong.tt",
518                                     tt_vars  => \%tt_vars,
519                                   );
520        } else {
521            $self->wiki->delete_node(
522                                      name    => $node,
523                                      version => $args{version},
524                                    );
525            # Check whether any versions of this node remain.
526            my %check = $self->wiki->retrieve_node( name => $node );
527            $tt_vars{other_versions_remain} = 1 if $check{version};
528            print $self->process_template(
529                                     id       => $node,
530                                     template => "delete_done.tt",
531                                     tt_vars  => \%tt_vars,
532                                   );
533        }
534    } else {
535        print $self->process_template(
536                                 id       => $node,
537                                 template => "delete_confirm.tt",
538                                 tt_vars  => \%tt_vars,
539                               );
540    }
541}
542
543sub process_template {
544    my ($self, %args) = @_;
545    my %output_conf = ( wiki     => $self->wiki,
546                        config   => $self->config,
547                        node     => $args{id},
548                        template => $args{template},
549                        vars     => $args{tt_vars},
550    );
551    if ( $args{content_type} ) {
552        $output_conf{content_type} = "";
553        my $output = "Content-Type: $args{content_type}\n\n"
554                     . OpenGuides::Template->output( %output_conf );
555    } else {
556        return OpenGuides::Template->output( %output_conf );
557    }
558}
559
560sub redirect_to_node {
561    my ($self, $node) = @_;
562    my $script_url = $self->config->{_}->{script_url};
563    my $script_name = $self->config->{_}->{script_name};
564    my $formatter = $self->wiki->formatter;
565    my $param = $formatter->node_name_to_node_param( $node );
566    return CGI->redirect( "$script_url$script_name?$param" );
567}
568
569sub get_cookie {
570    my $self = shift;
571    my $config = $self->config;
572    my $pref_name = shift or return "";
573    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
574    return $cookie_data{$pref_name};
575}
576
577sub make_geocache_link {
578    my $self = shift;
579    my $wiki = $self->wiki;
580    my $config = $self->config;
581    return "" unless $self->get_cookie( "include_geocache_link" );
582    my $node = shift || $config->{_}->{home_name};
583    my %current_data = $wiki->retrieve_node( $node );
584    my %criteria     = ( name => $node );
585    my %node_data    = $wiki->retrieve_node( %criteria );
586    my %metadata     = %{$node_data{metadata}};
587    my $latitude     = $metadata{latitude}[0];
588    my $longitude    = $metadata{longitude}[0];
589    my $geocache     = CGI::Wiki::Plugin::GeoCache->new();
590    my $link_text    = "Look for nearby geocaches";
591
592    if ($latitude && $longitude) {
593        my $cache_url    = $geocache->make_link(
594                                        latitude  => $latitude,
595                                        longitude => $longitude,
596                                        link_text => $link_text
597                                );
598        return $cache_url;
599    }
600    else {
601        return "";
602    }
603}
604
605=back
606
607=head1 BUGS AND CAVEATS
608
609At the moment, the location data uses a United-Kingdom-specific module,
610so the location features might not work so well outside the UK.
611
612=head1 SEE ALSO
613
614=over 4
615
616=item * L<http://london.openguides.org/|The Open Guide to London>, the first and biggest OpenGuides site.
617
618=item * L<http://openguides.org/|The OpenGuides website>, with a list of all live OpenGuides installs.
619
620=item * L<CGI::Wiki>, the Wiki toolkit which does the heavy lifting for OpenGuides
621
622=back
623
624=head1 FEEDBACK
625
626If you have a question, a bug report, or a patch, or you're interested
627in joining the development team, please contact openguides-dev@openguides.org
628(moderated mailing list, will reach all current developers but you'll have
629to wait for your post to be approved) or kake@earth.li (a real person who
630may take a little while to reply to your mail if she's busy).
631
632=head1 AUTHOR
633
634The OpenGuides Project (openguides-dev@openguides.org)
635
636=head1 COPYRIGHT
637
638     Copyright (C) 2003-4 The OpenGuides Project.  All Rights Reserved.
639
640The OpenGuides distribution is free software; you can redistribute it
641and/or modify it under the same terms as Perl itself.
642
643=head1 CREDITS
644
645Programming by Earle Martin, Kake Pugh, Ivor Williams.  Testing and
646bug reporting by Cal Henderson, Bob Walker, Kerry Bosworth, Dominic
647Hargreaves, Simon Cozens, among others.  Much of the Module::Build
648stuff copied from the Siesta project L<http://siesta.unixbeard.net/>
649
650=cut
651
6521;
Note: See TracBrowser for help on using the repository browser.