source: trunk/lib/OpenGuides.pm @ 466

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

Split commit_node out into OpenGuides.pm in preparation for spam filtering option.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 25.0 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.39';
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          => $id,
180                 language      => $config->{_}->{default_language},
181               );
182
183
184    # We've undef'ed $version above if this is the current version.
185    $tt_vars{current} = 1 unless $version;
186
187    if ($id eq "RecentChanges") {
188        my $minor_edits = $self->get_cookie( "show_minor_edits_in_rc" );
189        my %criteria = ( days => 7 );
190        $criteria{metadata_was} = { edit_type => "Normal edit" }
191          unless $minor_edits;
192        my @recent = $wiki->list_recent_changes( %criteria );
193        @recent = map { {name          => CGI->escapeHTML($_->{name}),
194                         last_modified => CGI->escapeHTML($_->{last_modified}),
195                         version       => CGI->escapeHTML($_->{version}),
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{id};
303    my $metres = $args{metres};
304    my $formatter = $self->wiki->formatter;
305    my @finds = $self->locator->find_within_distance(
306                                                      node   => $node,
307                                                      metres => $metres,
308                                                    );
309    my @nodes;
310    foreach my $find ( @finds ) {
311        my $distance = $self->locator->distance(
312                                                 from_node => $node,
313                                                 to_node   => $find,
314                                                 unit      => "metres"
315                                               );
316        push @nodes, {
317                       name     => $find,
318                       param    => $formatter->node_name_to_node_param($find),
319                       distance => $distance,
320                     };
321    }
322    @nodes = sort { $a->{distance} <=> $b->{distance} } @nodes;
323
324    my %tt_vars = (
325                    nodes        => \@nodes,
326                    origin       => $node,
327                    origin_param => $formatter->node_name_to_node_param($node),
328                    limit        => "$metres metres",
329                  );
330
331    print $self->process_template(
332                                   id       => "index", # KLUDGE
333                                   template => "site_index.tt",
334                                   tt_vars  => \%tt_vars,
335                                 );
336}
337
338=item B<show_index>
339
340  $guide->show_index(
341                      type   => "category",
342                      value  => "pubs",
343                    );
344
345  # RDF version.
346  $guide->show_index(
347                      type   => "locale",
348                      value  => "Holborn",
349                      format => "rdf",
350                    );
351
352  # Or return output as a string (useful for writing tests).
353  $guide->show_index(
354                      type          => "category",
355                      value         => "pubs",
356                      return_output => 1,
357                    );
358
359=cut
360
361sub show_index {
362    my ($self, %args) = @_;
363    my $wiki = $self->wiki;
364    my $formatter = $wiki->formatter;
365    my %tt_vars;
366    my @selnodes;
367
368    if ( $args{type} and $args{value} ) {
369        if ( $args{type} eq "fuzzy_title_match" ) {
370            my %finds = $wiki->fuzzy_title_match( $args{value} );
371            @selnodes = sort { $finds{$a} <=> $finds{$b} } keys %finds;
372            $tt_vars{criterion} = {
373                type  => $args{type},  # for RDF version
374                value => $args{value}, # for RDF version
375                name  => CGI->escapeHTML("Fuzzy Title Match on '$args{value}'")
376            };
377        } else {
378            @selnodes = $wiki->list_nodes_by_metadata(
379                metadata_type  => $args{type},
380                metadata_value => $args{value},
381                ignore_case    => 1,
382            );
383            my $name = ucfirst($args{type}) . " $args{value}" ;
384            my $url = $self->config->{_}->{script_name}
385                      . "?"
386                      . ucfirst( $args{type} )
387                      . "_"
388                      . uri_escape(
389                              $formatter->node_name_to_node_param($args{value})
390                                  );
391            $tt_vars{criterion} = {
392                type  => $args{type},
393                value => $args{value}, # for RDF version
394                name  => CGI->escapeHTML( $name ),
395                url   => $url,
396            };
397        }
398    } else {
399        @selnodes = $wiki->list_all_nodes();
400    }
401
402    my @nodes = map { { name      => $_,
403                        node_data => { $wiki->retrieve_node( name => $_ ) },
404                        param     => $formatter->node_name_to_node_param($_) }
405                    } sort @selnodes;
406
407    $tt_vars{nodes} = \@nodes;
408
409    my ($template, %conf);
410
411    if ( $args{format} and $args{format} eq "rdf" ) {
412        $template = "rdf_index.tt";
413        $conf{content_type} = "text/plain";
414    } else {
415        $template = "site_index.tt";
416    }
417
418    %conf = (
419              %conf,
420              node        => "$args{type} index", # KLUDGE
421              template    => $template,
422              tt_vars     => \%tt_vars,
423    );
424
425    my $output = $self->process_template( %conf );
426    return $output if $args{return_output};
427    print $output;
428}
429
430=item B<list_all_versions>
431
432  $guide->list_all_versions ( id => "Home Page" );
433
434  # Or return output as a string (useful for writing tests).
435  $guide->list_all_versions (
436                              id            => "Home Page",
437                              return_output => 1,
438                            );
439
440  # Or return the hash of variables that will be passed to the template
441  # (not including those set additionally by OpenGuides::Template).
442  $guide->list_all_versions (
443                              id             => "Home Page",
444                              return_tt_vars => 1,
445                            );
446
447=cut
448
449sub list_all_versions {
450    my ($self, %args) = @_;
451    my $return_output = $args{return_output} || 0;
452    my $node = $args{id};
453    my %curr_data = $self->wiki->retrieve_node($node);
454    my $curr_version = $curr_data{version};
455    croak "This is the first version" unless $curr_version > 1;
456    my @history;
457    for my $version ( 1 .. $curr_version ) {
458        my %node_data = $self->wiki->retrieve_node( name    => $node,
459                                                    version => $version );
460        # $node_data{version} will be zero if this version was deleted.
461        push @history, {
462            version  => CGI->escapeHTML( $version ),
463            modified => CGI->escapeHTML( $node_data{last_modified} ),
464            username => CGI->escapeHTML( $node_data{metadata}{username}[0] ),
465            comment  => CGI->escapeHTML( $node_data{metadata}{comment}[0] ),
466                       } if $node_data{version};
467    }
468    @history = reverse @history;
469    my %tt_vars = ( node          => $node,
470                    version       => $curr_version,
471                    not_deletable => 1,
472                    history       => \@history );
473    return %tt_vars if $args{return_tt_vars};
474    my $output = $self->process_template(
475                                          id       => $node,
476                                          template => "node_history.tt",
477                                          tt_vars  => \%tt_vars,
478                                        );
479    return $output if $return_output;
480    print $output;
481}
482
483=item B<commit_node>
484
485  $guide->commit_node(
486                       id      => $node,
487                       cgi_obj => $q,
488                     );
489
490As with other methods, parameters C<return_tt_vars> and
491C<return_output> can be used to return these things instead of
492printing the output to STDOUT.
493
494=cut
495
496sub commit_node {
497    my ($self, %args) = @_;
498    my $node = $args{id};
499    my $q = $args{cgi_obj};
500    my $wiki = $self->wiki;
501    my $config = $self->config;
502
503    my $content  = $q->param("content");
504    $content =~ s/\r\n/\n/gs;
505    my $checksum = $q->param("checksum");
506
507    my %metadata = OpenGuides::Template->extract_metadata_vars(
508        wiki    => $wiki,
509        config  => $config,
510        cgi_obj => $q
511    );
512
513    $metadata{opening_hours_text} = $q->param("hours_text") || "";
514
515    # Check to make sure all the indexable nodes are created
516    foreach my $type (qw(Category Locale)) {
517        my $lctype = lc($type);
518        foreach my $index (@{$metadata{$lctype}}) {
519            $index =~ s/(.*)/\u$1/;
520            my $node = $type . " " . $index;
521            # Uppercase the node name before checking for existence
522            $node =~ s/ (\S+)/ \u$1/g;
523            unless ( $wiki->node_exists($node) ) {
524                my $category = $type eq "Category" ? "Category" : "Locales";
525                $wiki->write_node( $node,
526                                   "\@INDEX_LINK [[$node]]",
527                                   undef,
528                                   { username => "Auto Create",
529                                     comment  => "Auto created $lctype stub page",
530                                     category => $category
531                                   }
532                );
533            }
534        }
535    }
536       
537    foreach my $var ( qw( username comment edit_type ) ) {
538        $metadata{$var} = $q->param($var) || "";
539    }
540    $metadata{host} = $ENV{REMOTE_ADDR};
541
542    my $written = $wiki->write_node($node, $content, $checksum, \%metadata );
543
544    if ($written) {
545        print $self->redirect_to_node($node);
546    } else {
547        my %node_data = $wiki->retrieve_node($node);
548        my %tt_vars = ( checksum       => $node_data{checksum},
549                        new_content    => $content,
550                        stored_content => $node_data{content} );
551        foreach my $mdvar ( keys %metadata ) {
552            if ($mdvar eq "locales") {
553                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{locale};
554                $tt_vars{"new_$mdvar"}    = $metadata{locale};
555            } elsif ($mdvar eq "categories") {
556                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{category};
557                $tt_vars{"new_$mdvar"}    = $metadata{category};
558            } elsif ($mdvar eq "username" or $mdvar eq "comment"
559                      or $mdvar eq "edit_type" ) {
560                $tt_vars{$mdvar} = $metadata{$mdvar};
561            } else {
562                $tt_vars{"stored_$mdvar"} = $node_data{metadata}{$mdvar}[0];
563                $tt_vars{"new_$mdvar"}    = $metadata{$mdvar};
564            }
565        }
566        return %tt_vars if $args{return_tt_vars};
567        my $output = $self->process_template(
568                                              id       => $node,
569                                              template => "edit_conflict.tt",
570                                              tt_vars  => \%tt_vars,
571                                            );
572        return $output if $args{return_output};
573        print $output;
574    }
575}
576
577
578=item B<delete_node>
579
580  $guide->delete_node(
581                       id       => "FAQ",
582                       version  => 15,
583                       password => "beer",
584                     );
585
586C<version> is optional - if it isn't supplied then all versions of the
587node will be deleted; in other words the node will be entirely
588removed.
589
590If C<password> is not supplied then a form for entering the password
591will be displayed.
592
593=cut
594
595sub delete_node {
596    my ($self, %args) = @_;
597    my $node = $args{id} or croak "No node ID supplied for deletion";
598
599    my %tt_vars = (
600                    not_editable  => 1,
601                    not_deletable => 1,
602                  );
603    $tt_vars{delete_version} = $args{version} || "";
604
605    my $password = $args{password};
606
607    if ($password) {
608        if ($password ne $self->config->{_}->{admin_pass}) {
609            print $self->process_template(
610                                     id       => $node,
611                                     template => "delete_password_wrong.tt",
612                                     tt_vars  => \%tt_vars,
613                                   );
614        } else {
615            $self->wiki->delete_node(
616                                      name    => $node,
617                                      version => $args{version},
618                                    );
619            # Check whether any versions of this node remain.
620            my %check = $self->wiki->retrieve_node( name => $node );
621            $tt_vars{other_versions_remain} = 1 if $check{version};
622            print $self->process_template(
623                                     id       => $node,
624                                     template => "delete_done.tt",
625                                     tt_vars  => \%tt_vars,
626                                   );
627        }
628    } else {
629        print $self->process_template(
630                                 id       => $node,
631                                 template => "delete_confirm.tt",
632                                 tt_vars  => \%tt_vars,
633                               );
634    }
635}
636
637sub process_template {
638    my ($self, %args) = @_;
639    my %output_conf = ( wiki     => $self->wiki,
640                        config   => $self->config,
641                        node     => $args{id},
642                        template => $args{template},
643                        vars     => $args{tt_vars},
644    );
645    if ( $args{content_type} ) {
646        $output_conf{content_type} = "";
647        my $output = "Content-Type: $args{content_type}\n\n"
648                     . OpenGuides::Template->output( %output_conf );
649    } else {
650        return OpenGuides::Template->output( %output_conf );
651    }
652}
653
654sub redirect_to_node {
655    my ($self, $node) = @_;
656    my $script_url = $self->config->{_}->{script_url};
657    my $script_name = $self->config->{_}->{script_name};
658    my $formatter = $self->wiki->formatter;
659    my $param = $formatter->node_name_to_node_param( $node );
660    return CGI->redirect( "$script_url$script_name?$param" );
661}
662
663sub get_cookie {
664    my $self = shift;
665    my $config = $self->config;
666    my $pref_name = shift or return "";
667    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
668    return $cookie_data{$pref_name};
669}
670
671sub make_geocache_link {
672    my $self = shift;
673    my $wiki = $self->wiki;
674    my $config = $self->config;
675    return "" unless $self->get_cookie( "include_geocache_link" );
676    my $node = shift || $config->{_}->{home_name};
677    my %current_data = $wiki->retrieve_node( $node );
678    my %criteria     = ( name => $node );
679    my %node_data    = $wiki->retrieve_node( %criteria );
680    my %metadata     = %{$node_data{metadata}};
681    my $latitude     = $metadata{latitude}[0];
682    my $longitude    = $metadata{longitude}[0];
683    my $geocache     = CGI::Wiki::Plugin::GeoCache->new();
684    my $link_text    = "Look for nearby geocaches";
685
686    if ($latitude && $longitude) {
687        my $cache_url    = $geocache->make_link(
688                                        latitude  => $latitude,
689                                        longitude => $longitude,
690                                        link_text => $link_text
691                                );
692        return $cache_url;
693    }
694    else {
695        return "";
696    }
697}
698
699=back
700
701=head1 BUGS AND CAVEATS
702
703At the moment, the location data uses a United-Kingdom-specific module,
704so the location features might not work so well outside the UK.
705
706=head1 SEE ALSO
707
708=over 4
709
710=item * L<http://london.openguides.org/|The Open Guide to London>, the first and biggest OpenGuides site.
711
712=item * L<http://openguides.org/|The OpenGuides website>, with a list of all live OpenGuides installs.
713
714=item * L<CGI::Wiki>, the Wiki toolkit which does the heavy lifting for OpenGuides
715
716=back
717
718=head1 FEEDBACK
719
720If you have a question, a bug report, or a patch, or you're interested
721in joining the development team, please contact openguides-dev@openguides.org
722(moderated mailing list, will reach all current developers but you'll have
723to wait for your post to be approved) or kake@earth.li (a real person who
724may take a little while to reply to your mail if she's busy).
725
726=head1 AUTHOR
727
728The OpenGuides Project (openguides-dev@openguides.org)
729
730=head1 COPYRIGHT
731
732     Copyright (C) 2003-4 The OpenGuides Project.  All Rights Reserved.
733
734The OpenGuides distribution is free software; you can redistribute it
735and/or modify it under the same terms as Perl itself.
736
737=head1 CREDITS
738
739Programming by Dominic Hargreaves, Earle Martin, Kake Pugh, and Ivor
740Williams.  Testing and bug reporting by Billy Abbott, Jody Belka,
741Kerry Bosworth, Simon Cozens, Cal Henderson, Steve Jolly, and Bob
742Walker (among others).  Much of the Module::Build stuff copied from
743the Siesta project L<http://siesta.unixbeard.net/>
744
745=cut
746
7471;
Note: See TracBrowser for help on using the repository browser.