source: trunk/lib/OpenGuides.pm @ 370

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

Move differ stuff into OpenGuides.pm

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 11.0 KB
Line 
1package OpenGuides;
2use strict;
3
4use CGI;
5use CGI::Wiki::Plugin::Diff;
6use CGI::Wiki::Plugin::Locator::UK;
7use OpenGuides::Template;
8use OpenGuides::Utils;
9
10use vars qw( $VERSION );
11
12$VERSION = '0.33_02';
13
14=head1 NAME
15
16OpenGuides - A complete web application for managing a collaboratively-written guide to a city or town.
17
18=head1 DESCRIPTION
19
20The OpenGuides software provides the framework for a collaboratively-written
21city guide.  It is similar to a wiki but provides somewhat more structured
22data storage allowing you to annotate wiki pages with information such as
23category, location, and much more.  It provides searching facilities
24including "find me everything within a certain distance of this place".
25Every page includes a link to a machine-readable (RDF) version of the page.
26
27=head1 METHODS
28
29=over
30
31=item B<new>
32
33  my $guide = OpenGuides->new( config => $config );
34
35=cut
36
37sub new {
38    my ($class, %args) = @_;
39    my $self = {};
40    bless $self, $class;
41    my $wiki = OpenGuides::Utils->make_wiki_object( config => $args{config} );
42    $self->{wiki} = $wiki;
43    $self->{config} = $args{config};
44    my $locator = CGI::Wiki::Plugin::Locator::UK->new;
45    $wiki->register_plugin( plugin => $locator );
46    $self->{locator} = $locator;
47    my $differ = CGI::Wiki::Plugin::Diff->new;
48    $wiki->register_plugin( plugin => $differ );
49    $self->{differ} = $differ;
50    return $self;
51}
52
53=item B<wiki>
54
55An accessor, returns the underlying L<CGI::Wiki> object.
56
57=cut
58
59sub wiki {
60    my $self = shift;
61    return $self->{wiki};
62}
63
64=item B<config>
65
66An accessor, returns the underlying L<Config::Tiny> object.
67
68=cut
69
70sub config {
71    my $self = shift;
72    return $self->{config};
73}
74
75=item B<locator>
76
77An accessor, returns the underlying L<CGI::Wiki::Plugin::Locator::UK> object.
78
79=cut
80
81sub locator {
82    my $self = shift;
83    return $self->{locator};
84}
85
86=item B<differ>
87
88An accessor, returns the underlying L<CGI::Wiki::Plugin::Diff> object.
89
90=cut
91
92sub differ {
93    my $self = shift;
94    return $self->{differ};
95}
96
97=item B<display_node>
98
99  # Print node to STDOUT.
100  $guide->display_node(
101                        id      => "Calthorpe Arms",
102                        version => 2,
103                      );
104
105  # Or return output as a string (useful for writing tests).
106  $guide->display_node(
107                        id            => "Calthorpe Arms",
108                        return_output => 1,
109                      );
110
111If C<version> is omitted then the latest version will be displayed.
112
113=cut
114
115sub display_node {
116    my ($self, %args) = @_;
117    my $return_output = $args{return_output} || 0;
118    my $version = $args{version};
119    my $id = $args{id} || "Home";
120    my $wiki = $self->wiki;
121    my $config = $self->config;
122
123    my %tt_vars;
124
125    if ( $id =~ /^(Category|Locale) (.*)$/ ) {
126        my $type = $1;
127        $tt_vars{is_indexable_node} = 1;
128        $tt_vars{index_type} = lc($type);
129        $tt_vars{index_value} = $2;
130    }
131
132    my %current_data = $wiki->retrieve_node( $id );
133    my $current_version = $current_data{version};
134    undef $version if ($version && $version == $current_version);
135    my %criteria = ( name => $id );
136    $criteria{version} = $version if $version;#retrieve_node default is current
137
138    my %node_data = $wiki->retrieve_node( %criteria );
139    my $raw = $node_data{content};
140    if ( $raw =~ /^#REDIRECT\s+(.+?)\s*$/ ) {
141        my $redirect = $1;
142        # Strip off enclosing [[ ]] in case this is an extended link.
143        $redirect =~ s/^\[\[//;
144        $redirect =~ s/\]\]\s*$//;
145        # See if this is a valid node, if not then just show the page as-is.
146        if ( $wiki->node_exists($redirect) ) {
147            redirect_to_node($redirect);
148        }
149    }
150    my $content    = $wiki->format($raw);
151    my $modified   = $node_data{last_modified};
152    my %metadata   = %{$node_data{metadata}};
153
154    my %metadata_vars = OpenGuides::Template->extract_metadata_vars(
155                            wiki     => $wiki,
156                            config   => $config,
157                            metadata => $node_data{metadata} );
158
159    %tt_vars = (
160                 %tt_vars,
161                 %metadata_vars,
162                 content       => $content,
163                 geocache_link => $self->make_geocache_link($id),
164                 last_modified => $modified,
165                 version       => $node_data{version},
166                 node_name     => CGI->escapeHTML($id),
167                 node_param    => CGI->escape($id),
168                 language      => $config->{_}->{default_language},
169               );
170
171
172    # We've undef'ed $version above if this is the current version.
173    $tt_vars{current} = 1 unless $version;
174
175    if ($id eq "RecentChanges") {
176        my $minor_edits = $self->get_cookie( "show_minor_edits_in_rc" );
177        my %criteria = ( days => 7 );
178        $criteria{metadata_was} = { edit_type => "Normal edit" }
179          unless $minor_edits;
180        my @recent = $wiki->list_recent_changes( %criteria );
181        @recent = map { {name          => CGI->escapeHTML($_->{name}),
182                         last_modified => CGI->escapeHTML($_->{last_modified}),
183                         comment       => CGI->escapeHTML($_->{metadata}{comment}[0]),
184                         username      => CGI->escapeHTML($_->{metadata}{username}[0]),
185                         host          => CGI->escapeHTML($_->{metadata}{host}[0]),
186                         username_param => CGI->escape($_->{metadata}{username}[0]),
187                         edit_type     => CGI->escapeHTML($_->{metadata}{edit_type}[0]),
188                         url           => "$config->{_}->{script_name}?"
189          . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name})) }
190                       } @recent;
191        $tt_vars{recent_changes} = \@recent;
192        $tt_vars{days} = 7;
193        my $output = $self->process_template(
194                                          id            => $id,
195                                          template      => "recent_changes.tt",
196                                          tt_vars       => \%tt_vars,
197                                            );
198        return $output if $return_output;
199        print $output;
200    } elsif ($id eq "Home") {
201        my @recent = $wiki->list_recent_changes(
202            last_n_changes => 10,
203            metadata_was   => { edit_type => "Normal edit" },
204        );
205        @recent = map { {name          => CGI->escapeHTML($_->{name}),
206                         last_modified => CGI->escapeHTML($_->{last_modified}),
207                         comment       => CGI->escapeHTML($_->{metadata}{comment}[0]),
208                         username      => CGI->escapeHTML($_->{metadata}{username}[0]),
209                         url           => "$config->{_}->{script_name}?"
210          . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name})) }
211                       } @recent;
212        $tt_vars{recent_changes} = \@recent;
213        my $output = $self->process_template(
214                                              id            => $id,
215                                              template      => "home_node.tt",
216                                              tt_vars       => \%tt_vars,
217                                            );
218        return $output if $return_output;
219        print $output;
220    } else {
221        my $output = $self->process_template(
222                                              id            => $id,
223                                              template      => "node.tt",
224                                              tt_vars       => \%tt_vars,
225                                            );
226        return $output if $return_output;
227        print $output;
228    }
229}
230
231=item B<display_diffs>
232
233  $guide->display_diffs(
234                         id            => "Home Page",
235                         version       => 6,
236                         other_version => 5,
237                       );
238
239=cut
240
241sub display_diffs {
242    my ($self, %args) = @_;
243    my %diff_vars = $self->differ->differences(
244                                        node          => $args{id},
245                                        left_version  => $args{version},
246                                        right_version => $args{other_version},
247                                              );
248    print $self->process_template(
249                                   id       => $args{id},
250                                   template => "differences.tt",
251                                   vars     => \%diff_vars
252                                 );
253}
254
255sub process_template {
256    my ($self, %args) = @_;
257    my %output_conf = ( wiki     => $self->wiki,
258                        config   => $self->config,
259                        node     => $args{id},
260                        template => $args{template},
261                        vars     => $args{tt_vars},
262    );
263    return OpenGuides::Template->output( %output_conf );
264}
265
266sub get_cookie {
267    my $self = shift;
268    my $config = $self->config;
269    my $pref_name = shift or return "";
270    my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
271    return $cookie_data{$pref_name};
272}
273
274sub make_geocache_link {
275    my $self = shift;
276    my $wiki = $self->wiki;
277    my $config = $self->config;
278    return "" unless $self->get_cookie( "include_geocache_link" );
279    my $node = shift || $config->{_}->{home_name};
280    my %current_data = $wiki->retrieve_node( $node );
281    my %criteria     = ( name => $node );
282    my %node_data    = $wiki->retrieve_node( %criteria );
283    my %metadata     = %{$node_data{metadata}};
284    my $latitude     = $metadata{latitude}[0];
285    my $longitude    = $metadata{longitude}[0];
286    my $geocache     = CGI::Wiki::Plugin::GeoCache->new();
287    my $link_text    = "Look for nearby geocaches";
288
289    if ($latitude && $longitude) {
290        my $cache_url    = $geocache->make_link(
291                                        latitude  => $latitude,
292                                        longitude => $longitude,
293                                        link_text => $link_text
294                                );
295        return $cache_url;
296    }
297    else {
298        return "";
299    }
300}
301
302=back
303
304=head1 BUGS AND CAVEATS
305
306At the moment, the location data uses a United-Kingdom-specific module,
307so the location features might not work so well outside the UK.
308
309=head1 SEE ALSO
310
311=over 4
312
313=item * L<http://london.openguides.org/|The Open Guide to London>, the first and biggest OpenGuides site.
314
315=item * L<http://openguides.org/|The OpenGuides website>, with a list of all live OpenGuides installs.
316
317=item * L<CGI::Wiki>, the Wiki toolkit which does the heavy lifting for OpenGuides
318
319=back
320
321=head1 FEEDBACK
322
323If you have a question, a bug report, or a patch, or you're interested
324in joining the development team, please contact openguides-dev@openguides.org
325(moderated mailing list, will reach all current developers but you'll have
326to wait for your post to be approved) or kake@earth.li (a real person who
327may take a little while to reply to your mail if she's busy).
328
329=head1 AUTHOR
330
331The OpenGuides Project (openguides-dev@openguides.org)
332
333=head1 COPYRIGHT
334
335     Copyright (C) 2003-4 The OpenGuides Project.  All Rights Reserved.
336
337The OpenGuides distribution is free software; you can redistribute it
338and/or modify it under the same terms as Perl itself.
339
340=head1 CREDITS
341
342Programming by Earle Martin, Kake Pugh, Ivor Williams.  Testing and
343bug reporting by Cal Henderson, Bob Walker, Kerry Bosworth, Dominic
344Hargreaves, Simon Cozens, among others.  Much of the Module::Build
345stuff copied from the Siesta project L<http://siesta.unixbeard.net/>
346
347=cut
348
3491;
Note: See TracBrowser for help on using the repository browser.