source: trunk/lib/OpenGuides.pm @ 471

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

Improved RecentChanges.

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