File Coverage

blib/lib/OpenGuides.pm
Criterion Covered Total %
statement 788 915 86.1
branch 298 430 69.3
condition 137 192 71.3
subroutine 44 47 93.6
pod 27 31 87.1
total 1294 1615 80.1


line stmt bran cond sub pod time code
1             package OpenGuides;
2 91     91   718161 use strict;
  91         199  
  91         4129  
3              
4 91     91   470 use Carp "croak";
  91         119  
  91         5182  
5 91     91   73732 use CGI;
  91         2344223  
  91         776  
6 91     91   72482 use Wiki::Toolkit::Plugin::Diff;
  91         2508537  
  91         3854  
7 91     91   49355 use Wiki::Toolkit::Plugin::Locator::Grid;
  91         79773  
  91         2800  
8 91     91   52690 use OpenGuides::CGI;
  91         414  
  91         3330  
9 91     91   43969 use OpenGuides::Feed;
  91         334  
  91         950  
10 91     91   43637 use OpenGuides::Template;
  91         263  
  91         3614  
11 91     91   50636 use OpenGuides::Utils;
  91         338  
  91         3976  
12 91     91   934 use Time::Piece;
  91         160  
  91         926  
13 91     91   7356 use URI::Escape;
  91         218  
  91         6374  
14              
15 91     91   480 use vars qw( $VERSION );
  91         156  
  91         970131  
16              
17             $VERSION = '0.80';
18              
19             =head1 NAME
20              
21             OpenGuides - A complete web application for managing a collaboratively-written guide to a city or town.
22              
23             =head1 DESCRIPTION
24              
25             The OpenGuides software provides the framework for a collaboratively-written
26             city guide. It is similar to a wiki but provides somewhat more structured
27             data storage allowing you to annotate wiki pages with information such as
28             category, location, and much more. It provides searching facilities
29             including "find me everything within a certain distance of this place".
30             Every page includes a link to a machine-readable (RDF) version of the page.
31              
32             =head1 METHODS
33              
34             =over
35              
36             =item B
37              
38             my $config = OpenGuides::Config->new( file => "wiki.conf" );
39             my $guide = OpenGuides->new( config => $config );
40              
41             =cut
42              
43             sub new {
44 112     112 1 1349995 my ($class, %args) = @_;
45 112         367 my $self = {};
46 112         328 bless $self, $class;
47 112         1215 my $wiki = OpenGuides::Utils->make_wiki_object( config => $args{config} );
48 112         714 $self->{wiki} = $wiki;
49 112         378 $self->{config} = $args{config};
50              
51 112         508 my $geo_handler = $self->config->geo_handler;
52 112         1033 my $locator;
53 112 100       500 if ( $geo_handler == 1 ) {
    100          
54 98         1164 $locator = Wiki::Toolkit::Plugin::Locator::Grid->new(
55             x => "os_x", y => "os_y" );
56             } elsif ( $geo_handler == 2 ) {
57 4         47 $locator = Wiki::Toolkit::Plugin::Locator::Grid->new(
58             x => "osie_x", y => "osie_y" );
59             } else {
60 10         106 $locator = Wiki::Toolkit::Plugin::Locator::Grid->new(
61             x => "easting", y => "northing" );
62             }
63 112         3095 $wiki->register_plugin( plugin => $locator );
64 112         8142 $self->{locator} = $locator;
65              
66 112         1036 my $differ = Wiki::Toolkit::Plugin::Diff->new;
67 112         5928 $wiki->register_plugin( plugin => $differ );
68 112         5365 $self->{differ} = $differ;
69              
70 112 100       361 if($self->config->ping_services) {
71 1         8 eval {
72 1         6 require Wiki::Toolkit::Plugin::Ping;
73             };
74              
75 1 50       3 if ( $@ ) {
76 0         0 warn "You asked for some ping services, but can't find "
77             . "Wiki::Toolkit::Plugin::Ping";
78             } else {
79 1         3 my @ws = split(/\s*,\s*/, $self->config->ping_services);
80 1         83 my %well_known = Wiki::Toolkit::Plugin::Ping->well_known;
81 1         5 my %services;
82 1         3 foreach my $s (@ws) {
83 3 100       6 if($well_known{$s}) {
84 2         4 $services{$s} = $well_known{$s};
85             } else {
86 1         93 warn("Ignoring unknown ping service '$s'");
87             }
88             }
89 1         11 my $ping = Wiki::Toolkit::Plugin::Ping->new(
90             node_to_url => $self->{config}->{script_url}
91             . $self->{config}->{script_name} . '?$node',
92             services => \%services
93             );
94 1         48 $wiki->register_plugin( plugin => $ping );
95             }
96             }
97              
98 112         1707 return $self;
99             }
100              
101             =item B
102              
103             An accessor, returns the underlying L object.
104              
105             =cut
106              
107             sub wiki {
108 2142     2142 1 22648 my $self = shift;
109 2142         7049 return $self->{wiki};
110             }
111              
112             =item B
113              
114             An accessor, returns the underlying L object.
115              
116             =cut
117              
118             sub config {
119 3171     3171 1 32307 my $self = shift;
120 3171         13893 return $self->{config};
121             }
122              
123             =item B
124              
125             An accessor, returns the underlying L object.
126              
127             =cut
128              
129             sub locator {
130 7     7 1 2013 my $self = shift;
131 7         33 return $self->{locator};
132             }
133              
134             =item B
135              
136             An accessor, returns the underlying L object.
137              
138             =cut
139              
140             sub differ {
141 4     4 1 11 my $self = shift;
142 4         44 return $self->{differ};
143             }
144              
145             =item B
146              
147             # Print node to STDOUT.
148             $guide->display_node(
149             id => "Calthorpe Arms",
150             version => 2,
151             );
152              
153             # Or return output as a string (useful for writing tests).
154             $guide->display_node(
155             id => "Calthorpe Arms",
156             return_output => 1,
157             );
158              
159             # Return output as a string with HTTP headers omitted (for tests).
160             $guide->display_node(
161             id => "Calthorpe Arms",
162             return_output => 1,
163             noheaders => 1,
164             );
165              
166             # Or return the hash of variables that will be passed to the template
167             # (not including those set additionally by OpenGuides::Template).
168             $guide->display_node(
169             id => "Calthorpe Arms",
170             return_tt_vars => 1,
171             );
172              
173             If C is omitted then it will assume you want the latest version.
174              
175             Note that if you pass the C parameter, and your node is a
176             redirecting node, this method will fake the redirect and return the output
177             that will actually end up in the user's browser. If instead you want to see
178             the HTTP headers that will be printed in order to perform the redirect, pass
179             the C parameter as well. The C
180             parameter has no effect if the node isn't a redirect, or if the
181             C parameter is omitted.
182              
183             (At the moment, C acts as if the C
184             parameter was passed.)
185              
186             The C parameter only takes effect if C is true
187             and C is false or omitted.
188              
189             If you have specified the C option in your
190             C, this method will attempt to call the
191             method of that module to determine whether the host requesting the node
192             has been blacklisted. If this method returns true, then the
193             C template will be used to display an error message.
194              
195             The C method will be passed a scalar containing the host's
196             IP address.
197              
198             =cut
199              
200             sub display_node {
201 103     103 1 2141584 my ($self, %args) = @_;
202 103   100     668 my $return_output = $args{return_output} || 0;
203 103         247 my $intercept_redirect = $args{intercept_redirect};
204 103   100     1149 my $noheaders = ( $return_output && !$intercept_redirect
205             && $args{noheaders} );
206 103         289 my $version = $args{version};
207 103   66     631 my $id = $args{id} || $self->config->home_name;
208 103         466 my $wiki = $self->wiki;
209 103         537 my $config = $self->config;
210 103   50     768 my $oldid = $args{oldid} || '';
211 103 100       660 my $do_redirect = defined($args{redirect}) ? $args{redirect} : 1;
212              
213 103         178 my %tt_vars;
214              
215             # If we can, check to see if requesting host is blacklisted.
216 103         587 my $host_checker = $config->host_checker_module;
217 103         1191 my $is_blacklisted;
218 103 100       375 if ( $host_checker ) {
219 1         3 eval {
220 1         102 eval "require $host_checker";
221 1         15 $is_blacklisted = $host_checker->blacklisted_host(CGI->new->remote_host);
222             };
223             }
224              
225 103 100       707 if ( $is_blacklisted ) {
226 1         5 my $output = OpenGuides::Template->output(
227             wiki => $self->wiki,
228             config => $config,
229             template => "blacklisted_host.tt",
230             vars => {
231             not_editable => 1,
232             },
233             noheaders => $noheaders,
234             );
235 1 50       1041 return $output if $return_output;
236 0         0 print $output;
237 0         0 return;
238             }
239              
240 102         298 $tt_vars{home_name} = $self->config->home_name;
241              
242 102 100       1385 if ( $id =~ /^(Category|Locale) (.*)$/ ) {
243 10         30 my $type = $1;
244 10         25 $tt_vars{is_indexable_node} = 1;
245 10         29 $tt_vars{index_type} = lc($type);
246 10         30 $tt_vars{index_value} = $2;
247 10         42 $tt_vars{"rss_".lc($type)."_url"} =
248             $config->script_name . "?action=rc;format=rss;"
249             . lc($type) . "=" . lc(CGI->escape($2));
250 10         391 $tt_vars{"atom_".lc($type)."_url"} =
251             $config->script_name . "?action=rc;format=atom;"
252             . lc($type) . "=" . lc(CGI->escape($2));
253             }
254              
255 102         855 my %current_data = $wiki->retrieve_node( $id );
256 102         143038 my $current_version = $current_data{version};
257 102 50 66     648 undef $version if ($version && $version == $current_version);
258 102         330 my %criteria = ( name => $id );
259 102 100       336 $criteria{version} = $version if $version; # retrieve_node default is current
260              
261 102         468 my %node_data = $wiki->retrieve_node( %criteria );
262              
263             # Fixes passing undefined values to Text::Wikiformat if node doesn't exist.
264 102         117432 my $content = '';
265 102 100       440 if ($node_data{content}) {
266 85         443 $content = $wiki->format($node_data{content});
267             }
268              
269 102         667075 my $modified = $node_data{last_modified};
270 102         257 my $moderated = $node_data{moderated};
271 102         170 my %metadata = %{$node_data{metadata}};
  102         1117  
272              
273 102         1416 my ($wgs84_long, $wgs84_lat) = OpenGuides::Utils->get_wgs84_coords(
274             longitude => $metadata{longitude}[0],
275             latitude => $metadata{latitude}[0],
276             config => $config);
277 102 50 33     584 if ($args{format} && $args{format} eq 'raw') {
278 0 0       0 print "Content-Type: text/plain\n\n" unless $noheaders;
279 0         0 print $node_data{content};
280 0         0 return 0;
281             }
282              
283 102         992 my %metadata_vars = OpenGuides::Template->extract_metadata_vars(
284             wiki => $wiki,
285             config => $config,
286             metadata => $node_data{metadata}
287             );
288              
289 102         679 my $node_exists = $wiki->node_exists($id);
290 102 100       121881 my $http_status = $node_exists ? undef : '404 Not Found';
291 102         1362 %tt_vars = (
292             %tt_vars,
293             %metadata_vars,
294             content => $content,
295             last_modified => $modified,
296             version => $node_data{version},
297             node => $id,
298             language => $config->default_language,
299             moderated => $moderated,
300             oldid => $oldid,
301             enable_gmaps => 1,
302             wgs84_long => $wgs84_long,
303             wgs84_lat => $wgs84_lat,
304             empty_node => !$node_exists,
305             read_only => $config->read_only,
306             );
307              
308             # Hide from search engines if showing a specific version.
309 102 100       8108 $tt_vars{'deter_robots'} = 1 if $args{version};
310              
311 102 100 100     458 if ( $config->show_gmap_in_node_display
312             && $self->get_cookie( "display_google_maps" ) ) {
313 89         223 $tt_vars{display_google_maps} = 1;
314             }
315              
316 102         667 my $redirect = OpenGuides::Utils->detect_redirect(
317             content => $node_data{content} );
318 102 100       316 if ( $redirect ) {
319             # Don't redirect if the parameter "redirect" is given as 0.
320 3 100 33     17 if ($do_redirect == 0) {
    50 33        
321 1         3 $tt_vars{current} = 1;
322 1 50       7 return %tt_vars if $args{return_tt_vars};
323 1         6 my $output = $self->process_template(
324             id => $id,
325             template => "node.tt",
326             tt_vars => \%tt_vars,
327             http_status => $http_status
328             );
329 1 50       1808 return $output if $return_output;
330 0         0 print $output;
331             } elsif ( $wiki->node_exists($redirect) && $redirect ne $id && $redirect ne $oldid ) {
332             # Avoid loops by not generating redirects to the same node or the previous node.
333 2 50       1383 if ( $return_output ) {
334 2 50       9 if ( $intercept_redirect ) {
335 2         10 return $self->redirect_to_node( $redirect, $id );
336             } else {
337 0         0 return $self->display_node( id => $redirect,
338             oldid => $id,
339             return_output => 1,
340             );
341             }
342             }
343 0         0 print $self->redirect_to_node( $redirect, $id );
344 0         0 return 0;
345             }
346             }
347              
348             # We've undef'ed $version above if this is the current version.
349 99 100       379 $tt_vars{current} = 1 unless $version;
350              
351 99 100       495 if ($id eq "RecentChanges") {
    100          
352 2         10 $self->display_recent_changes(%args);
353             } elsif ( $id eq $self->config->home_name ) {
354 16 100       185 if ( $self->config->recent_changes_on_home_page ) {
355 15         207 my @recent = $wiki->list_recent_changes(
356             last_n_changes => 10,
357             metadata_was => { edit_type => "Normal edit" },
358             );
359 15         26888 my $base_url = $config->script_name . '?';
360 16         531 @recent = map {
361 15         189 {
362             name => CGI->escapeHTML($_->{name}),
363             last_modified =>
364             CGI->escapeHTML($_->{last_modified}),
365             version => CGI->escapeHTML($_->{version}),
366             comment => OpenGuides::Utils::parse_change_comment(
367             CGI->escapeHTML($_->{metadata}{comment}[0]),
368             $base_url,
369             ),
370             username =>
371             CGI->escapeHTML($_->{metadata}{username}[0]),
372             url => $base_url
373             . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name}))
374             }
375             } @recent;
376 15         1530 $tt_vars{recent_changes} = \@recent;
377             }
378 16 100       126 return %tt_vars if $args{return_tt_vars};
379 15         80 my $output = $self->process_template(
380             id => $id,
381             template => "home_node.tt",
382             tt_vars => \%tt_vars,
383             http_status => $http_status,
384             noheaders => $noheaders,
385             );
386 15 50       12065 return $output if $return_output;
387 0         0 print $output;
388             } else {
389 81 100       1329 return %tt_vars if $args{return_tt_vars};
390 73         1776 my $output = $self->process_template(
391             id => $id,
392             template => "node.tt",
393             tt_vars => \%tt_vars,
394             http_status => $http_status,
395             noheaders => $noheaders,
396             );
397 73 50       112555 return $output if $return_output;
398 0         0 print $output;
399             }
400             }
401              
402             =item B
403              
404             $guide->display_random_page;
405              
406             Display a random page. As with other methods, the C
407             parameter can be used to return the output instead of printing it to STDOUT.
408             You can also restrict it to a given category and/or locale by supplying
409             appropriate parameters:
410              
411             $guide->display_random_page(
412             category => "pubs",
413             locale => "bermondsey",
414             );
415              
416             The values of these parameters are case-insensitive.
417              
418             You can make sure this method never returns pages that are themselves
419             categories and/or locales by setting C
420             and/or C in your wiki.conf.
421              
422             =cut
423              
424             sub display_random_page {
425 7     7 1 976 my ( $self, %args ) = @_;
426 7         15 my $wiki = $self->wiki;
427 7         13 my $config = $self->config;
428              
429 7         10 my ( @catnodes, @locnodes, @nodes );
430 7 100       19 if ( $args{category} ) {
431 3         14 @catnodes = $wiki->list_nodes_by_metadata(
432             metadata_type => "category",
433             metadata_value => $args{category},
434             ignore_case => 1,
435             );
436             }
437 7 100       1168 if ( $args{locale} ) {
438 3         13 @locnodes = $wiki->list_nodes_by_metadata(
439             metadata_type => "locale",
440             metadata_value => $args{locale},
441             ignore_case => 1,
442             );
443             }
444              
445 7 100 100     949 if ( $args{category} && $args{locale} ) {
    100          
    100          
446             # If we have both category and locale, return the intersection.
447 2         4 my %count;
448 2         5 foreach my $node ( @catnodes, @locnodes ) {
449 4         6 $count{$node}++;
450             }
451 2         6 foreach my $node ( keys %count ) {
452 3 100       9 push @nodes, $node if $count{$node} > 1;
453             }
454             } elsif ( $args{category} ) {
455 1         2 @nodes = @catnodes;
456             } elsif ( $args{locale} ) {
457 1         2 @nodes = @locnodes;
458             } else {
459 3         12 @nodes = $wiki->list_all_nodes();
460             }
461              
462 7         1027 my $omit_cats = $config->random_page_omits_categories;
463 7         135 my $omit_locs = $config->random_page_omits_locales;
464              
465 7 100 100     71 if ( $omit_cats || $omit_locs ) {
466 2         4 my %all_nodes = map { $_ => $_ } @nodes;
  6         20  
467 2 100       9 if ( $omit_cats ) {
468 1         6 my @cats = $wiki->list_nodes_by_metadata(
469             metadata_type => "category",
470             metadata_value => "category",
471             ignore_case => 1,
472             );
473 1         389 foreach my $omit ( @cats ) {
474 1         6 delete $all_nodes{$omit};
475             }
476             }
477 2 100       8 if ( $omit_locs ) {
478 1         6 my @locs = $wiki->list_nodes_by_metadata(
479             metadata_type => "category",
480             metadata_value => "locales",
481             ignore_case => 1,
482             );
483 1         560 foreach my $omit ( @locs ) {
484 1         6 delete $all_nodes{$omit};
485             }
486             }
487 2         14 @nodes = keys %all_nodes;
488             }
489 7         27 my $node = $nodes[ rand @nodes ];
490 7         9 my $output;
491              
492 7 100       18 if ( $node ) {
493 6         17 $output = $self->redirect_to_node( $node );
494             } else {
495 1         5 my %tt_vars = (
496             category => $args{category},
497             locale => $args{locale},
498             );
499 1         11 $output = OpenGuides::Template->output(
500             wiki => $wiki,
501             config => $config,
502             template => "random_page_failure.tt",
503             vars => \%tt_vars,
504             );
505             }
506 7 50       3049 return $output if $args{return_output};
507 0         0 print $output;
508             }
509              
510             =item B
511              
512             $guide->display_edit_form(
513             id => "Vivat Bacchus",
514             vars => \%vars,
515             content => $content,
516             metadata => \%metadata,
517             checksum => $checksum
518             );
519              
520             Display an edit form for the specified node. As with other methods, the
521             C parameter can be used to return the output instead of
522             printing it to STDOUT.
523              
524             If this is to redisplay an existing edit, the content, metadata
525             and checksum may be supplied in those arguments
526              
527             Extra template variables may be supplied in the vars argument
528              
529             =cut
530              
531             sub display_edit_form {
532 6     6 1 4505 my ($self, %args) = @_;
533 6   50     28 my $return_output = $args{return_output} || 0;
534 6         20 my $config = $self->config;
535 6         22 my $wiki = $self->wiki;
536 6         13 my $node = $args{id};
537 6         37 my %node_data = $wiki->retrieve_node($node);
538 6         6330 my ($content, $checksum) = @node_data{ qw( content checksum ) };
539 6         51 my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
540              
541 6         32 my $username = $self->get_cookie( "username" );
542 6 50       21 my $edit_type = $self->get_cookie( "default_edit_type" ) eq "normal"
543             ? "Normal edit"
544             : "Minor tidying";
545              
546 6         54 my %metadata_vars = OpenGuides::Template->extract_metadata_vars(
547             wiki => $wiki,
548             config => $config,
549             metadata => $node_data{metadata} );
550              
551 6   50     48 $metadata_vars{website} ||= 'http://';
552 6         29 my $moderate = $wiki->node_required_moderation($node);
553              
554 6         5964 my %tt_vars = ( content => CGI->escapeHTML($content),
555             checksum => CGI->escapeHTML($checksum),
556             %metadata_vars,
557             config => $config,
558             username => $username,
559             edit_type => $edit_type,
560             moderate => $moderate,
561             deter_robots => 1,
562             read_only => $config->read_only,
563             );
564              
565             # Override some things if we were supplied with them
566 6 100       1393 $tt_vars{content} = $args{content} if $args{content};
567 6 50       23 $tt_vars{checksum} = $args{checksum} if $args{checksum};
568 6 100       21 if (defined $args{vars}) {
569 1         2 my %supplied_vars = %{$args{vars}};
  1         4  
570 1         3 foreach my $key ( keys %supplied_vars ) {
571 1         3 $tt_vars{$key} = $supplied_vars{$key};
572             }
573             }
574 6 100       21 if (defined $args{metadata}) {
575 1         1 my %supplied_metadata = %{$args{metadata}};
  1         10  
576 1         4 foreach my $key ( keys %supplied_metadata ) {
577 20         21 $tt_vars{$key} = $supplied_metadata{$key};
578             }
579             }
580              
581 6         36 my $output = $self->process_template(
582             id => $node,
583             template => "edit_form.tt",
584             tt_vars => \%tt_vars,
585             );
586 6 50       4785 return $output if $return_output;
587 0         0 print $output;
588             }
589              
590             =item B
591              
592             $guide->preview_edit(
593             id => "Vivat Bacchus",
594             cgi_obj => $q,
595             );
596              
597             Preview the edited version of the specified node. As with other methods, the
598             C parameter can be used to return the output instead of
599             printing it to STDOUT.
600              
601             =cut
602              
603             sub preview_edit {
604 1     1 1 1026 my ($self, %args) = @_;
605 1         4 my $node = $args{id};
606 1         2 my $q = $args{cgi_obj};
607 1         2 my $return_output = $args{return_output};
608 1         5 my $wiki = $self->wiki;
609 1         4 my $config = $self->config;
610              
611 1         4 my $content = $q->param('content');
612 1         18 $content =~ s/\r\n/\n/gs;
613 1         3 my $checksum = $q->param('checksum');
614              
615 1         23 my %new_metadata = OpenGuides::Template->extract_metadata_vars(
616             wiki => $wiki,
617             config => $config,
618             cgi_obj => $q,
619             set_coord_field_vars => 1,
620             );
621 1         4 foreach my $var ( qw( username comment edit_type ) ) {
622 3         384 $new_metadata{$var} = $q->escapeHTML(scalar $q->param($var));
623             }
624              
625 1 50       51 if ($wiki->verify_checksum($node, $checksum)) {
626 1         711 my $moderate = $wiki->node_required_moderation($node);
627 1         437 my %tt_vars = (
628             %new_metadata,
629             config => $config,
630             content => $q->escapeHTML($content),
631             preview_html => $wiki->format($content),
632             preview_above_edit_box => $self->get_cookie(
633             "preview_above_edit_box" ),
634             checksum => $q->escapeHTML($checksum),
635             moderate => $moderate,
636             read_only => $config->read_only,
637             );
638 1         105 my $output = $self->process_template(
639             id => $node,
640             template => "edit_form.tt",
641             tt_vars => \%tt_vars,
642             );
643 1 50       1249 return $output if $args{return_output};
644 0         0 print $output;
645             } else {
646 0         0 return $self->_handle_edit_conflict(
647             id => $node,
648             content => $content,
649             new_metadata => \%new_metadata,
650             return_output => $return_output,
651             );
652             }
653             }
654              
655             =item B
656              
657             $guide->display_prefs_form;
658              
659             Displays a form that lets the user view and set their preferences. The
660             C and C parameters can be used to return
661             the output or template variables, instead of printing the output to STDOUT.
662             The C parameter can also be used in conjunction with
663             C, if you wish to omit all HTTP headers.
664              
665             =cut
666              
667             sub display_prefs_form {
668 14     14 1 25401 my ($self, %args) = @_;
669 14         44 my $config = $self->config;
670 14         43 my $wiki = $self->wiki;
671              
672 14   100     64 my $from = $ENV{HTTP_REFERER} || "";
673 14         56 my $url_base = $config->script_url . $config->script_name;
674 14 100       212 if ( $from !~ /^$url_base/ ) {
675 12         24 $from = "";
676             }
677              
678 14         64 my %tt_vars = (
679             not_editable => 1,
680             show_form => 1,
681             not_deletable => 1,
682             return_to_url => $from,
683             );
684 14 100       54 return %tt_vars if $args{return_tt_vars};
685              
686 12         111 my $output = OpenGuides::Template->output(
687             wiki => $wiki,
688             config => $config,
689             template => "preferences.tt",
690             vars => \%tt_vars,
691             noheaders => $args{noheaders},
692             );
693 12 50       11455 return $output if $args{return_output};
694 0         0 print $output;
695             }
696              
697             =item B
698              
699             $guide->display_recent_changes;
700              
701             As with other methods, the C parameter can be used to
702             return the output instead of printing it to STDOUT.
703              
704             =cut
705              
706             sub display_recent_changes {
707 36     36 1 20223 my ($self, %args) = @_;
708 36         139 my $config = $self->config;
709 36         127 my $wiki = $self->wiki;
710 36         140 my $minor_edits = $self->get_cookie( "show_minor_edits_in_rc" );
711 36   66     221 my $id = $args{id} || $self->config->home_name;
712 36   100     475 my $return_output = $args{return_output} || 0;
713 36         51 my (%tt_vars, %recent_changes);
714             # NB the $q stuff below should be removed - we should _always_ do this via
715             # an argument to the method.
716 36         257 my $q = CGI->new;
717 36   66     9101 my $since = $args{since} || $q->param("since");
718 36 100       580 if ( $since ) {
719 6         7 $tt_vars{since} = $since;
720 6         21 my $t = localtime($since); # overloaded by Time::Piece
721 6         273 $tt_vars{since_string} = $t->strftime;
722 6         131 my %criteria = ( since => $since );
723 6 100       20 $criteria{metadata_was} = { edit_type => "Normal edit" }
724             unless $minor_edits;
725 6         17 my @rc = $self->_get_recent_changes(
726             config => $config, criteria => \%criteria );
727 6 100       17 if ( scalar @rc ) {
728 5         20 $recent_changes{since} = \@rc;
729             }
730             } else {
731             # Look at day, week, fortnight, month separately, but make sure things
732             # don't appear in e.g. "week" if we've already seen them in "day".
733 30         51 my %seen;
734 30         155 for my $days ( [0, 1], [1, 7], [7, 14], [14, 30] ) {
735 120         291 my %criteria = ( between_days => $days );
736 120 100       486 $criteria{metadata_was} = { edit_type => "Normal edit" }
737             unless $minor_edits;
738 120         502 my @rc = $self->_get_recent_changes(
739             config => $config, criteria => \%criteria );
740 120         153 my @filtered;
741 120         196 foreach my $node ( @rc ) {
742 50 100       174 next if $seen{$node->{name}};
743 43         103 $seen{$node->{name}}++;
744 43         104 push @filtered, $node;
745             }
746 120 100       434 if ( scalar @filtered ) {
747 34         178 $recent_changes{$days->[1]} = \@filtered;
748             }
749             }
750             }
751 36         153 $tt_vars{not_editable} = 1;
752 36         105 $tt_vars{recent_changes} = \%recent_changes;
753 36         202 my %processing_args = (
754             id => $id,
755             template => "recent_changes.tt",
756             tt_vars => \%tt_vars,
757             );
758 36 100 100     405 if ( !$since && $self->get_cookie("track_recent_changes_views") ) {
759 9         53 my $cookie =
760             OpenGuides::CGI->make_recent_changes_cookie(config => $config );
761 9         28 $processing_args{cookies} = $cookie;
762 9         53 $tt_vars{last_viewed} = OpenGuides::CGI->get_last_recent_changes_visit_from_cookie( config => $config );
763             }
764 36 100       208 return %tt_vars if $args{return_tt_vars};
765 28         161 my $output = $self->process_template( %processing_args );
766 28 50       29448 return $output if $return_output;
767 0         0 print $output;
768             }
769              
770             sub _get_recent_changes {
771 126     126   314 my ( $self, %args ) = @_;
772 126         278 my $wiki = $self->wiki;
773 126         549 my $formatter = $wiki->formatter;
774 126         531 my $config = $self->config;
775 126         164 my %criteria = %{ $args{criteria} };
  126         379  
776              
777 126         443 my @rc = $wiki->list_recent_changes( %criteria );
778 126         110072 my $base_url = $config->script_name . '?';
779              
780             # If using metadata_was then we need to pick out just the most recent
781             # versions.
782 126 100       1530 if ( $criteria{metadata_was} ) {
783 67         87 my %seen;
784             my @filtered;
785 67         113 foreach my $node ( @rc ) {
786 38 100       196 next if $seen{$node->{name}};
787 33         78 $seen{$node->{name}}++;
788 33         63 push @filtered, $node;
789             }
790 67         174 @rc = @filtered;
791             }
792              
793 59         2458 @rc = map {
794 126         224 {
795             name => CGI->escapeHTML($_->{name}),
796             last_modified => CGI->escapeHTML($_->{last_modified}),
797             version => CGI->escapeHTML($_->{version}),
798             comment => OpenGuides::Utils::parse_change_comment(
799             CGI->escapeHTML($_->{metadata}{comment}[0]),
800             $base_url,
801             ),
802             username => CGI->escapeHTML($_->{metadata}{username}[0]),
803             host => CGI->escapeHTML($_->{metadata}{host}[0]),
804             username_param => CGI->escape($_->{metadata}{username}[0]),
805             edit_type => CGI->escapeHTML($_->{metadata}{edit_type}[0]),
806             url => $base_url
807             . CGI->escape($formatter->node_name_to_node_param($_->{name})),
808             }
809             } @rc;
810 126         7078 return @rc;
811             }
812              
813             =item B
814              
815             $guide->display_diffs(
816             id => "Home Page",
817             version => 6,
818             other_version => 5,
819             );
820              
821             # Or return output as a string (useful for writing tests).
822             my $output = $guide->display_diffs(
823             id => "Home Page",
824             version => 6,
825             other_version => 5,
826             return_output => 1,
827             );
828              
829             # Or return the hash of variables that will be passed to the template
830             # (not including those set additionally by OpenGuides::Template).
831             my %vars = $guide->display_diffs(
832             id => "Home Page",
833             version => 6,
834             other_version => 5,
835             return_tt_vars => 1,
836             );
837              
838             =cut
839              
840             sub display_diffs {
841 4     4 1 186557 my ($self, %args) = @_;
842 4         22 my %diff_vars = $self->differ->differences(
843             node => $args{id},
844             left_version => $args{version},
845             right_version => $args{other_version},
846             );
847 4         61943 $diff_vars{not_deletable} = 1;
848 4         12 $diff_vars{not_editable} = 1;
849 4         81 $diff_vars{deter_robots} = 1;
850 4 50       17 return %diff_vars if $args{return_tt_vars};
851 4         24 my $output = $self->process_template(
852             id => $args{id},
853             template => "differences.tt",
854             tt_vars => \%diff_vars
855             );
856 4 50       4053 return $output if $args{return_output};
857 0         0 print $output;
858             }
859              
860             =item B
861              
862             $guide->find_within_distance(
863             id => $node,
864             metres => $q->param("distance_in_metres")
865             );
866              
867             =cut
868              
869             sub find_within_distance {
870 0     0 1 0 my ($self, %args) = @_;
871 0         0 my $node = $args{id};
872 0         0 my $metres = $args{metres};
873 0         0 my %data = $self->wiki->retrieve_node( $node );
874 0         0 my $lat = $data{metadata}{latitude}[0];
875 0         0 my $long = $data{metadata}{longitude}[0];
876 0         0 my $script_url = $self->config->script_url;
877 0         0 my $q = CGI->new;
878 0         0 print $q->redirect( $script_url . "search.cgi?lat=$lat;long=$long;distance_in_metres=$metres" );
879             }
880              
881             =item B
882              
883             $guide->show_backlinks( id => "Calthorpe Arms" );
884              
885             As with other methods, parameters C and
886             C can be used to return these things instead of
887             printing the output to STDOUT.
888              
889             =cut
890              
891             sub show_backlinks {
892 0     0 1 0 my ($self, %args) = @_;
893 0         0 my $wiki = $self->wiki;
894 0         0 my $formatter = $wiki->formatter;
895              
896 0         0 my @backlinks = $wiki->list_backlinks( node => $args{id} );
897 0         0 my @results = map {
898 0         0 {
899             url => CGI->escape($formatter->node_name_to_node_param($_)),
900             title => CGI->escapeHTML($_)
901             }
902             } sort @backlinks;
903 0         0 my %tt_vars = ( results => \@results,
904             num_results => scalar @results,
905             not_deletable => 1,
906             deter_robots => 1,
907             not_editable => 1 );
908 0 0       0 return %tt_vars if $args{return_tt_vars};
909 0         0 my $output = OpenGuides::Template->output(
910             node => $args{id},
911             wiki => $wiki,
912             config => $self->config,
913             template=>"backlink_results.tt",
914             vars => \%tt_vars,
915             );
916 0 0       0 return $output if $args{return_output};
917 0         0 print $output;
918             }
919              
920             =item B
921              
922             # Show everything in Category: Pubs.
923             $guide->show_index(
924             cat => "pubs",
925             );
926              
927             # Show all pubs in Holborn.
928             $guide->show_index(
929             cat => "pubs",
930             loc => "holborn",
931             );
932              
933             # RDF version of things in Locale: Holborn.
934             $guide->show_index(
935             loc => "Holborn",
936             format => "rdf",
937             );
938              
939             # RSS / Atom version (recent changes style).
940             $guide->show_index(
941             loc => "Holborn",
942             format => "rss",
943             );
944              
945             # Or return output as a string (useful for writing tests).
946             $guide->show_index(
947             cat => "pubs",
948             return_output => 1,
949             );
950              
951             # Return output as a string with HTTP headers omitted (for tests).
952             $guide->show_index(
953             cat => "pubs",
954             return_output => 1,
955             noheaders => 1,
956             );
957              
958             # Or return the template variables (again, useful for writing tests).
959             $guide->show_index(
960             cat => "pubs",
961             format => "map"
962             return_tt_vars => 1,
963             );
964              
965             If neither C or C is supplied, then all pages will be returned.
966              
967             The recommended format of parameters to this method changed to the
968             above in version 0.67 of OpenGuides, though older invocations are
969             still supported and will redirect to the new URL format.
970              
971             If you pass the C or C parameters, and a
972             redirect is required, this method will fake the redirect and return the
973             output/variables that will actually end up being viewed by the user. If
974             instead you want to see the HTTP headers that will be printed in order to
975             perform the redirect, pass the C parameter as well.
976              
977             The C parameter has no effect if no redirect is required,
978             or if the C/C parameter is omitted.
979              
980             The C parameter only takes effect if C is true
981             and C is false or omitted.
982              
983             =cut
984              
985             sub show_index {
986 35     35 1 227944 my ($self, %args) = @_;
987 35         138 my $wiki = $self->wiki;
988 35         172 my $formatter = $wiki->formatter;
989 35         206 my $use_leaflet = $self->config->use_leaflet;
990 35         355 my %tt_vars;
991             my @selnodes;
992              
993 35 100 66     215 if ( $args{type} and $args{value} ) {
994 2 50       7 if ( $args{type} eq "fuzzy_title_match" ) {
995 0         0 my %finds = $wiki->fuzzy_title_match( $args{value} );
996 0         0 @selnodes = sort { $finds{$a} <=> $finds{$b} } keys %finds;
  0         0  
997 0         0 $tt_vars{criterion} = {
998             type => $args{type}, # for RDF version
999             value => $args{value}, # for RDF version
1000             name => CGI->escapeHTML("Fuzzy Title Match on '$args{value}'")
1001             };
1002 0         0 $tt_vars{not_editable} = 1;
1003             } else {
1004 2         9 return $self->_do_old_style_index_search( %args );
1005             }
1006             } else {
1007             # OK, we either show everything, or do a new-style cat/loc search.
1008 33   100     179 my $cat = $args{cat} || "";
1009 33   100     152 my $loc = $args{loc} || "";
1010 33         57 my ( $type, $value, @names, @criteria );
1011 33 100 100     208 if ( !$cat && !$loc ) {
1012 1         8 @selnodes = $wiki->list_all_nodes();
1013             } else {
1014 32         49 my ( @catnodes, @locnodes );
1015 32 100       97 if ( $cat ) {
1016 17         86 @catnodes = $wiki->list_nodes_by_metadata(
1017             metadata_type => "category",
1018             metadata_value => $cat,
1019             ignore_case => 1
1020             );
1021 17         8510 my $name = "Category $cat";
1022 17         189 $name =~ s/(\s\w)/\U$1/g;
1023 17         116 push @criteria, {
1024             type => "category",
1025             value => $cat,
1026             name => $name,
1027             param => $formatter->node_name_to_node_param( $name ),
1028             };
1029 17         561 push @names, $name;
1030             }
1031 32 100       103 if ( $loc ) {
1032 23         112 @locnodes = $wiki->list_nodes_by_metadata(
1033             metadata_type => "locale",
1034             metadata_value => $loc,
1035             ignore_case => 1
1036             );
1037 23         10706 my $name = "Locale $loc";
1038 23         259 $name =~ s/(\s\w)/\U$1/g;
1039 23         162 push @criteria, {
1040             type => "locale",
1041             value => $loc,
1042             name => $name,
1043             param => $formatter->node_name_to_node_param( $name ),
1044             };
1045 23         729 push @names, $name;
1046             }
1047 32 100 100     306 if ( $cat && !$loc ) {
    100 66        
1048 9         30 @selnodes = @catnodes;
1049             } elsif ( $loc && !$cat ) {
1050 15         44 @selnodes = @locnodes;
1051             } else {
1052             # Intersect the category and locale results.
1053 8         17 my %count = ();
1054 8         19 foreach my $node ( @catnodes, @locnodes ) { $count{$node}++; }
  28         43  
1055 8         25 foreach my $node ( keys %count ) {
1056 20 100       51 push @selnodes, $node if $count{$node} > 1;
1057             }
1058             }
1059 32         129 $tt_vars{criteria_title} = join( " and ", @names );
1060 32         90 $tt_vars{criteria} = \@criteria;
1061 32         93 $tt_vars{not_editable} = 1;
1062             }
1063              
1064 33   100     979 $tt_vars{page_description} =
1065             OpenGuides::Utils->get_index_page_description(
1066             format => $args{format} || "",
1067             criteria => \@criteria,
1068             );
1069              
1070 33         119 my $feed_base = $self->config->script_url
1071             . $self->config->script_name . "?action=index";
1072 33         304 foreach my $criterion ( @criteria ) {
1073 40 100       165 if ( $criterion->{type} eq "category" ) {
    50          
1074 17         64 $feed_base .= ";cat=" . lc( $criterion->{value} );
1075             } elsif ( $criterion->{type} eq "locale" ) {
1076 23         90 $feed_base .= ";loc=" . lc( $criterion->{value} );
1077             }
1078             }
1079 33         269 my @dropdowns = OpenGuides::CGI->make_index_form_dropdowns(
1080             guide => $self,
1081             selected => \@criteria );
1082 33         97 $tt_vars{index_form_fields} = \@dropdowns;
1083 33         183 $tt_vars{feed_base} = $feed_base;
1084             }
1085              
1086 62         38200 my @nodes = map {
1087 33         94 {
1088             name => $_,
1089             node_data => { $wiki->retrieve_node( name => $_ ) },
1090             param => $formatter->node_name_to_node_param($_) }
1091             } sort @selnodes;
1092              
1093             # Convert the lat+long to WGS84 as required, and count how many nodes
1094             # we have for the map (if using Leaflet).
1095 33         48678 my $nodes_on_map;
1096 33         171 for(my $i=0; $i
1097 62         94 my $node = $nodes[$i];
1098 62 50       147 if($node) {
1099 62         72 my %metadata = %{$node->{node_data}->{metadata}};
  62         693  
1100 62         132 my ($wgs84_long, $wgs84_lat);
1101 62         96 eval {
1102 62         386 ($wgs84_long, $wgs84_lat) = OpenGuides::Utils->get_wgs84_coords(
1103             longitude => $metadata{longitude}[0],
1104             latitude => $metadata{latitude}[0],
1105             config => $self->config);
1106             };
1107 62 50       196 warn $@." on ".$metadata{latitude}[0]." ".$metadata{longitude}[0] if $@;
1108              
1109 62         76 push @{$nodes[$i]->{node_data}->{metadata}->{wgs84_long}}, $wgs84_long;
  62         233  
1110 62         100 push @{$nodes[$i]->{node_data}->{metadata}->{wgs84_lat}}, $wgs84_lat;
  62         174  
1111 62 100       209 if ( $use_leaflet ) {
1112 48 50 100     542 if ( defined $wgs84_lat && $wgs84_lat =~ /^[-.\d]+$/
      66        
      66        
1113             && defined $wgs84_long && $wgs84_long =~ /^[-.\d]+$/ ) {
1114 19         42 $node->{has_geodata} = 1;
1115 19         38 $node->{wgs84_lat} = $wgs84_lat;
1116 19         30 $node->{wgs84_long} = $wgs84_long;
1117 19         200 $nodes_on_map++;
1118             }
1119             }
1120             }
1121             }
1122              
1123 33         95 $tt_vars{nodes} = \@nodes;
1124              
1125 33         48 my ($template, %conf);
1126              
1127 33 100       107 if ( $args{format} ) {
1128 23 100 66     213 if ( $args{format} eq "rdf" ) {
    100          
    50          
    100          
    50          
1129 2         5 $template = "rdf_index.tt";
1130 2         6 $conf{content_type} = "application/rdf+xml";
1131             } elsif ( $args{format} eq "json" ) {
1132 1         2 $template = "json_index.tt";
1133 1         2 $conf{content_type} = "text/javascript";
1134             } elsif ( $args{format} eq "plain" ) {
1135 0         0 $template = "plain_index.tt";
1136 0         0 $conf{content_type} = "text/plain";
1137             } elsif ( $args{format} eq "map" ) {
1138 18         46 $tt_vars{display_google_maps} = 1; # override for this page
1139 18 100       61 if ( $use_leaflet ) {
1140 17 100       87 if ( $nodes_on_map ) {
1141 29         124 my @points = map {
1142 9         22 { wgs84_lat =>
1143             $_->{node_data}->{metadata}->{wgs84_lat}[0],
1144             wgs84_long =>
1145             $_->{node_data}->{metadata}->{wgs84_long}[0]
1146             }
1147             } @nodes;
1148 9         54 my %minmaxdata = OpenGuides::Utils->get_wgs84_min_max(
1149             nodes => \@points );
1150 9         176 %tt_vars = ( %tt_vars, %minmaxdata );
1151             } else {
1152 8         18 $tt_vars{no_nodes_on_map} = 1;
1153             }
1154 17         56 $template = "map_index_leaflet.tt";
1155             } else {
1156 1         6 my $q = CGI->new;
1157 1   50     317 $tt_vars{zoom} = $q->param('zoom') || '';
1158 1   50     23 $tt_vars{lat} = $q->param('lat') || '';
1159 1   50     19 $tt_vars{long} = $q->param('long') || '';
1160 1   50     20 $tt_vars{map_type} = $q->param('map_type') || '';
1161 1         20 $tt_vars{centre_long} = $self->config->centre_long;
1162 1         13 $tt_vars{centre_lat} = $self->config->centre_lat;
1163 1         10 $tt_vars{default_gmaps_zoom}
1164             = $self->config->default_gmaps_zoom;
1165 1         10 $tt_vars{enable_gmaps} = 1;
1166 1         5 $template = "map_index.tt";
1167             }
1168             } elsif( $args{format} eq "rss" || $args{format} eq "atom") {
1169             # They really wanted a recent changes style rss/atom feed
1170 2         6 my $feed_type = $args{format};
1171 2         9 my ($feed,$content_type) = $self->get_feed_and_content_type($feed_type);
1172 2         4 my ($name, $params );
1173 2 50       8 if ( $args{cat} ) {
1174 2         6 $name = "Index of Category $args{cat}";
1175 2         5 $params = "action=index;cat=$args{cat}";
1176             } else {
1177 0         0 $name = "Index of Locale $args{loc}";
1178 0         0 $params = "action=index;loc=$args{loc}";
1179             }
1180 2         8 $feed->set_feed_name_and_url_params( $name, $params );
1181              
1182             # Grab the actual node data out of @nodes
1183 2         3 my @node_data;
1184 2         5 foreach my $node (@nodes) {
1185 4         15 $node->{node_data}->{name} = $node->{name};
1186 4         11 push @node_data, $node->{node_data};
1187             }
1188              
1189 2         8 my $output = "Content-Type: ".$content_type."\n";
1190 2         10 $output .= $feed->build_feed_for_nodes($feed_type, @node_data);
1191              
1192 2 50       59 return $output if $args{return_output};
1193 0         0 print $output;
1194 0         0 return;
1195             }
1196             } else {
1197 10         19 $template = "site_index.tt";
1198             }
1199              
1200 31 100       319 return %tt_vars if $args{return_tt_vars};
1201              
1202 24         100 %conf = (
1203             %conf,
1204             template => $template,
1205             tt_vars => \%tt_vars,
1206             );
1207              
1208 24 50 33     188 if ( $args{return_output} && !$args{intercept_redirect} ) {
1209 24         53 $conf{noheaders} = $args{noheaders};
1210             }
1211              
1212 24         109 my $output = $self->process_template( %conf );
1213 24 50       17457 return $output if $args{return_output};
1214 0         0 print $output;
1215             }
1216              
1217             # Deal with legacy URLs/tests.
1218             sub _do_old_style_index_search {
1219 2     2   6 my ( $self, %args ) = @_;
1220 2 50 33     8 if ( ( $args{return_output} || $args{return_tt_vars} ) ) {
1221 2 50       5 if ( $args{intercept_redirect} ) {
1222 2         10 return $self->redirect_index_search( %args );
1223             } else {
1224 0         0 my $type = delete $args{type};
1225 0         0 my $value = delete $args{value};
1226 0 0       0 if ( $type eq "category" ) {
    0          
1227 0         0 return $self->show_index( %args, cat => $value );
1228             } elsif ( $type eq "locale" ) {
1229 0         0 return $self->show_index( %args, loc => $value );
1230             } else {
1231 0         0 return $self->show_index( %args );
1232             }
1233             }
1234             } else {
1235 0         0 print $self->redirect_index_search( %args );
1236             }
1237             }
1238              
1239             =item B
1240              
1241             $guide->show_metadata();
1242             $guide->show_metadata(type => "category");
1243             $guide->show_metadata(type => "category", format => "json");
1244              
1245             Lists all metadata types, or all metadata values of a given
1246             type. Useful for programatically discovering a guide.
1247              
1248             As with other methods, parameters C and
1249             C can be used to return these things instead of
1250             printing the output to STDOUT.
1251              
1252             =cut
1253             sub show_metadata {
1254 0     0 1 0 my ($self, %args) = @_;
1255 0         0 my $wiki = $self->wiki;
1256 0         0 my $formatter = $wiki->formatter;
1257              
1258 0         0 my @values;
1259             my $type;
1260 0         0 my $may_descend = 0;
1261 0 0 0     0 if($args{"type"} && $args{"type"} ne "metadata_type") {
1262 0         0 $type = $args{"type"};
1263 0         0 @values = $wiki->store->list_metadata_by_type($args{"type"});
1264             } else {
1265 0         0 $may_descend = 1;
1266 0         0 $type = "metadata_type";
1267 0         0 @values = $wiki->store->list_metadata_names;
1268             }
1269              
1270 0         0 my %tt_vars = ( type => $type,
1271             may_descend => $may_descend,
1272             metadata => \@values,
1273             num_results => scalar @values,
1274             not_deletable => 1,
1275             deter_robots => 1,
1276             not_editable => 1 );
1277 0 0       0 return %tt_vars if $args{return_tt_vars};
1278              
1279 0         0 my $output;
1280             my $content_type;
1281              
1282 0 0       0 if($args{"format"}) {
1283 0 0       0 if($args{"format"} eq "json") {
1284 0         0 $content_type = "text/javascript";
1285 0         0 my $json = OpenGuides::JSON->new( wiki => $wiki,
1286             config => $self->config );
1287 0         0 $output = $json->output_as_json(
1288             $type => \@values
1289             );
1290             }
1291             }
1292 0 0       0 unless($output) {
1293 0         0 $output = OpenGuides::Template->output(
1294             wiki => $wiki,
1295             config => $self->config,
1296             template=>"metadata.tt",
1297             vars => \%tt_vars,
1298             );
1299             }
1300 0 0       0 return $output if $args{return_output};
1301              
1302 0 0       0 if($content_type) {
1303 0         0 print "Content-type: $content_type\n\n";
1304             }
1305 0         0 print $output;
1306             }
1307              
1308             =item B
1309              
1310             $guide->list_all_versions ( id => "Home Page" );
1311              
1312             # Or return output as a string (useful for writing tests).
1313             $guide->list_all_versions (
1314             id => "Home Page",
1315             return_output => 1,
1316             );
1317              
1318             # Or return the hash of variables that will be passed to the template
1319             # (not including those set additionally by OpenGuides::Template).
1320             $guide->list_all_versions (
1321             id => "Home Page",
1322             return_tt_vars => 1,
1323             );
1324              
1325             =cut
1326              
1327             sub list_all_versions {
1328 4     4 1 8852 my ($self, %args) = @_;
1329 4   50     23 my $return_output = $args{return_output} || 0;
1330 4         10 my $node = $args{id};
1331 4         17 my %curr_data = $self->wiki->retrieve_node($node);
1332 4         6599 my $curr_version = $curr_data{version};
1333 4         11 my @history;
1334 4         39 for my $version ( 1 .. $curr_version ) {
1335 4         19 my %node_data = $self->wiki->retrieve_node( name => $node,
1336             version => $version );
1337             # $node_data{version} will be zero if this version was deleted.
1338 4 50       5707 push @history, {
1339             version => CGI->escapeHTML( $version ),
1340             modified => CGI->escapeHTML( $node_data{last_modified} ),
1341             username => CGI->escapeHTML( $node_data{metadata}{username}[0] ),
1342             comment => OpenGuides::Utils::parse_change_comment(
1343             CGI->escapeHTML( $node_data{metadata}{comment}[0] ),
1344             $self->config->script_name . '?',
1345             ),
1346             } if $node_data{version};
1347             }
1348 4         12 @history = reverse @history;
1349 4         32 my %tt_vars = (
1350             node => $node,
1351             version => $curr_version,
1352             not_deletable => 1,
1353             not_editable => 1,
1354             deter_robots => 1,
1355             history => \@history
1356             );
1357 4 50       22 return %tt_vars if $args{return_tt_vars};
1358 4         25 my $output = $self->process_template(
1359             id => $node,
1360             template => "node_history.tt",
1361             tt_vars => \%tt_vars,
1362             );
1363 4 50       4251 return $output if $return_output;
1364 0         0 print $output;
1365             }
1366              
1367             =item B
1368              
1369             Fetch the OpenGuides feed object, and the output content type, for the
1370             supplied feed type.
1371              
1372             Handles all the setup for the OpenGuides feed object.
1373              
1374             =cut
1375              
1376             sub get_feed_and_content_type {
1377 8     8 1 17 my ($self, $feed_type) = @_;
1378              
1379 8         25 my $feed = OpenGuides::Feed->new(
1380             wiki => $self->wiki,
1381             config => $self->config,
1382             og_version => $VERSION,
1383             );
1384              
1385 8         35 my $content_type = $feed->default_content_type($feed_type);
1386              
1387 8         23 return ($feed, $content_type);
1388             }
1389              
1390             =item B
1391              
1392             # Last ten non-minor edits to Hammersmith pages in RSS 1.0 format
1393             $guide->display_feed(
1394             feed_type => 'rss',
1395             feed_listing => 'recent_changes',
1396             items => 10,
1397             ignore_minor_edits => 1,
1398             locale => "Hammersmith",
1399             );
1400              
1401             # All edits bob has made to pub pages in the last week in Atom format
1402             $guide->display_feed(
1403             feed_type => 'atom',
1404             feed_listing => 'recent_changes',
1405             days => 7,
1406             username => "bob",
1407             category => "Pubs",
1408             );
1409              
1410             C is a mandatory parameter. Supported values at present are
1411             "rss" and "atom".
1412              
1413             C is a mandatory parameter. Supported values at present
1414             are "recent_changes". (More values are coming soon though!)
1415              
1416             As with other methods, the C parameter can be used to
1417             return the output instead of printing it to STDOUT.
1418              
1419             =cut
1420              
1421             sub display_feed {
1422 6     6 1 26714 my ($self, %args) = @_;
1423              
1424 6         15 my $feed_type = $args{feed_type};
1425 6 50       22 croak "No feed type given" unless $feed_type;
1426              
1427 6         11 my $feed_listing = $args{feed_listing};
1428 6 50       19 croak "No feed listing given" unless $feed_listing;
1429              
1430 6 50       19 my $return_output = $args{return_output} ? 1 : 0;
1431              
1432             # Basic criteria, whatever the feed listing type is
1433 6         25 my %criteria = (
1434             feed_type => $feed_type,
1435             feed_listing => $feed_listing,
1436             also_return_timestamp => 1,
1437             );
1438              
1439             # Feed listing specific criteria
1440 6 100       24 if($feed_listing eq "recent_changes") {
    50          
1441 2   50     8 $criteria{items} = $args{items} || "";
1442 2   50     15 $criteria{days} = $args{days} || "";
1443 2 50       6 $criteria{ignore_minor_edits} = $args{ignore_minor_edits} ? 1 : 0;
1444              
1445 2   50     9 my $username = $args{username} || "";
1446 2   50     11 my $category = $args{category} || "";
1447 2   50     11 my $locale = $args{locale} || "";
1448              
1449 2         4 my %filter;
1450 2 50       8 $filter{username} = $username if $username;
1451 2 50       7 $filter{category} = $category if $category;
1452 2 50       7 $filter{locale} = $locale if $locale;
1453 2 50       8 if ( scalar keys %filter ) {
1454 2         7 $criteria{filter_on_metadata} = \%filter;
1455             }
1456             }
1457             elsif($feed_listing eq "node_all_versions") {
1458 4         9 $criteria{name} = $args{name};
1459             }
1460              
1461              
1462             # Get the feed object, and the content type
1463 6         21 my ($feed,$content_type) = $self->get_feed_and_content_type($feed_type);
1464              
1465 6         14 my $output = "Content-Type: ".$content_type;
1466 6 50       17 if($self->config->http_charset) {
1467 6         61 $output .= "; charset=".$self->config->http_charset;
1468             }
1469 6         48 $output .= "\n";
1470              
1471             # Get the feed, and the timestamp, in one go
1472 6         30 my ($feed_output, $feed_timestamp) =
1473             $feed->make_feed( %criteria );
1474 6         796 my $maker = $feed->fetch_maker($feed_type);
1475              
1476 6         24 $output .= "Last-Modified: " . ($maker->parse_feed_timestamp($feed_timestamp))->strftime('%a, %d %b %Y %H:%M:%S +0000') . "\n\n";
1477 6         343 $output .= $feed_output;
1478              
1479 6 50       49 return $output if $return_output;
1480 0         0 print $output;
1481             }
1482              
1483             =item B
1484              
1485             print $guide->display_about(format => "rdf");
1486              
1487             Displays static 'about' information in various format. Defaults to HTML.
1488              
1489             =cut
1490              
1491             sub display_about {
1492 3     3 1 1004 my ($self, %args) = @_;
1493              
1494 3         5 my $output;
1495              
1496 3 100 100     30 if ($args{format} && $args{format} =~ /^rdf$/i) {
    100 66        
1497 1         8 $output = qq{Content-Type: application/rdf+xml
1498              
1499            
1500            
1501             xmlns:rdf = "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
1502             xmlns:foaf = "http://xmlns.com/foaf/0.1/">
1503            
1504             OpenGuides
1505              
1506             2003-04-29
1507              
1508            
1509             A wiki engine for collaborative description of places with specialised
1510             geodata metadata features.
1511            
1512              
1513            
1514             OpenGuides is a collaborative wiki environment, written in Perl, for
1515             building guides and sharing information, as both human-readable text
1516             and RDF. The engine contains a number of geodata-specific metadata
1517             mechanisms such as locale search, node classification and integration
1518             with Google Maps.
1519            
1520              
1521            
1522            
1523            
1524              
1525            
1526            
1527             Dominic Hargreaves
1528            
1529            
1530            
1531              
1532            
1533            
1534            
1535            
1536            
1537            
1538              
1539            
1540            
1541             $VERSION
1542            
1543            
1544              
1545            
1546              
1547            
1548            
1549              
1550            
1551            
1552              
1553            
1554              
1555             };
1556             } elsif ($args{format} && $args{format} eq 'opensearch') {
1557 1         3 my $site_name = $self->config->site_name;
1558 1         9 my $search_url = $self->config->script_url . 'search.cgi';
1559 1         3 my $contact_email = $self->config->contact_email;
1560 1         13 $output = qq{Content-Type: application/opensearchdescription+xml; charset=utf-8
1561              
1562            
1563              
1564            
1565             $site_name
1566             Search the site '$site_name'
1567             $site_name
1568             $contact_email
1569            
1570             template="$search_url?search={searchTerms};format=atom"/>
1571            
1572             template="$search_url?search={searchTerms};format=rss"/>
1573            
1574             template="$search_url?search={searchTerms}"/>
1575            
1576             };
1577             } else {
1578 1         3 my $site_name = $self->config->{site_name};
1579 1         4 my $script_name = $self->config->{script_name};
1580 1         21 $output = qq{Content-Type: text/html; charset=utf-8
1581              
1582            
1583            
1584             About $site_name
1585            
1594            
1595             type="application/rdf+xml"
1596             title="DOAP (Description Of A Project) profile for this site's software"
1597             href="$script_name?action=about;format=rdf" />
1598            
1599            
1600            
1601            
1602            
1603             src="http://openguides.org/img/logo.png" alt="OpenGuides">
1604            

$site_name

1605            

is powered by OpenGuides -

1606             the guides made by you.
1607            

version $VERSION

1608            
1609            
1610            

1611            
1612             src="http://openguides.org/img/rdf_icon.png" width="44" height="48"
1613             style="float: right; margin-left: 10px; border: 0px"> OpenGuides is a
1614             web-based collaborative wiki
1615             environment for building guides and sharing information, as both
1616             human-readable text and
1617             title="Resource Description Framework">RDF. The engine contains
1618             a number of geodata-specific metadata mechanisms such as locale search, node
1619             classification and integration with Google
1620             Maps.
1621            

1622            

1623             OpenGuides is written in Perl, and is
1624             made available under the same license as Perl itself (dual
1625             href="http://dev.perl.org/licenses/artistic.html" title='The "Artistic Licence"'>Artistic and
1626             href="http://www.opensource.org/licenses/gpl-license.php">
1627             title="GNU Public Licence">GPL). Developer information for the
1628             project is available from the OpenGuides
1629             development site.
1630            

1631            

1632             Copyright ©2003-2008, The OpenGuides
1633             Project. "OpenGuides", "[The] Open Guide To..." and "The guides made by
1634             you" are trademarks of The OpenGuides Project. Any uses on this site are made
1635             with permission.
1636            

1637            
1638            
1639            
1640             title="Description Of A Project">DOAP RDF version of this
1641             information
1642            
1643            
1644            
1645             };
1646             }
1647              
1648 3 50       24 return $output if $args{return_output};
1649 0         0 print $output;
1650             }
1651              
1652             =item B
1653              
1654             $guide->commit_node(
1655             id => $node,
1656             cgi_obj => $q,
1657             );
1658              
1659             As with other methods, parameters C and
1660             C can be used to return these things instead of
1661             printing the output to STDOUT.
1662              
1663             If you have specified the C option in your
1664             C, this method will attempt to call the
1665             method of that module to determine whether the edit is spam. If this
1666             method returns true, then the C template will be
1667             used to display an error message.
1668              
1669             The C method will be passed a datastructure containing
1670             content and metadata.
1671              
1672             The geographical data that you should provide in the L object
1673             depends on the handler you chose in C.
1674              
1675             =over
1676              
1677             =item *
1678              
1679             B - provide either C and C or
1680             C and C; whichever set of data you give, it will
1681             be converted to the other and both sets will be stored.
1682              
1683             =item *
1684              
1685             B - provide either C and C or
1686             C and C; whichever set of data you give, it will
1687             be converted to the other and both sets will be stored.
1688              
1689             =item *
1690              
1691             B - provide C and C; these will be
1692             converted to easting and northing and both sets of data will be stored.
1693              
1694             =back
1695              
1696             =cut
1697              
1698             sub commit_node {
1699 353     353 1 4137036 my ($self, %args) = @_;
1700 353         776 my $node = $args{id};
1701 353         667 my $q = $args{cgi_obj};
1702 353         813 my $return_output = $args{return_output};
1703 353         1141 my $wiki = $self->wiki;
1704 353         1119 my $config = $self->config;
1705              
1706 353         1452 my $content = $q->param("content");
1707 353         8737 $content =~ s/\r\n/\n/gs;
1708 353         1073 my $checksum = $q->param("checksum");
1709              
1710 353         7778 my %new_metadata = OpenGuides::Template->extract_metadata_vars(
1711             wiki => $wiki,
1712             config => $config,
1713             cgi_obj => $q
1714             );
1715              
1716 353 50       1764 delete $new_metadata{website} if $new_metadata{website} eq 'http://';
1717              
1718 353   100     1492 $new_metadata{opening_hours_text} = $q->param("hours_text") || "";
1719              
1720             # Pick out the unmunged versions of lat/long if they're set.
1721             # (If they're not, it means they weren't munged in the first place.)
1722 353 100       9305 $new_metadata{latitude} = delete $new_metadata{latitude_unmunged}
1723             if $new_metadata{latitude_unmunged};
1724 353 100       1121 $new_metadata{longitude} = delete $new_metadata{longitude_unmunged}
1725             if $new_metadata{longitude_unmunged};
1726              
1727 353         1029 foreach my $var ( qw( summary username comment edit_type ) ) {
1728 1412   100     21532 $new_metadata{$var} = $q->param($var) || "";
1729             }
1730 353         7154 $new_metadata{host} = $ENV{REMOTE_ADDR};
1731              
1732             # Wiki::Toolkit::Plugin::RSS::ModWiki wants "major_change" to be set.
1733 353 100       1581 $new_metadata{major_change} = ( $new_metadata{edit_type} eq "Normal edit" )
1734             ? 1
1735             : 0;
1736              
1737             # General validation
1738 353         3449 my $fails = OpenGuides::Utils->validate_edit(
1739             cgi_obj => $q
1740             );
1741              
1742 353 100 66     517 if ( scalar @{$fails} or $config->read_only ) {
  353         2522  
1743 1         74 my %vars = (
1744             validate_failed => $fails
1745             );
1746              
1747 1         7 my $output = $self->display_edit_form(
1748             id => $node,
1749             content => CGI->escapeHTML($content),
1750             metadata => \%new_metadata,
1751             vars => \%vars,
1752             checksum => CGI->escapeHTML($checksum),
1753             return_output => 1,
1754             read_only => $config->read_only,
1755             );
1756              
1757 1 50       15 return $output if $return_output;
1758 0         0 print $output;
1759 0         0 return;
1760             }
1761              
1762             # If we can, check to see if this edit looks like spam.
1763 352         5409 my $spam_detector = $config->spam_detector_module;
1764 352         2687 my $is_spam;
1765 352 100       1046 if ( $spam_detector ) {
1766 2         6 eval {
1767 2         210 eval "require $spam_detector";
1768 2         24 $is_spam = $spam_detector->looks_like_spam(
1769             node => $node,
1770             content => $content,
1771             metadata => \%new_metadata,
1772             );
1773             };
1774             }
1775              
1776 352 100       1079 if ( $is_spam ) {
1777 1         4 my $output = OpenGuides::Template->output(
1778             wiki => $self->wiki,
1779             config => $config,
1780             template => "spam_detected.tt",
1781             vars => {
1782             not_editable => 1,
1783             },
1784             );
1785 1 50       864 return $output if $return_output;
1786 0         0 print $output;
1787 0         0 return;
1788             }
1789              
1790             # Check to make sure all the indexable nodes are created
1791             # Skip this for nodes needing moderation - this occurs for them once
1792             # they've been moderated
1793 351         1634 my $needs_moderation = $wiki->node_required_moderation($node);
1794 351         244190 my $in_moderate_whitelist
1795             = OpenGuides::Utils->in_moderate_whitelist($self->config, $new_metadata{host});
1796              
1797 351 100 100     4882 if ( $in_moderate_whitelist or not $needs_moderation ) {
1798 350         1968 $self->_autoCreateCategoryLocale(
1799             id => $node,
1800             metadata => \%new_metadata
1801             );
1802             }
1803              
1804 351         4435470 my $written = $wiki->write_node( $node, $content, $checksum,
1805             \%new_metadata );
1806              
1807 351 100       32517029 if ($written) {
1808 349 100       1961 if ( $needs_moderation ) {
1809 2 100       13 if ( $in_moderate_whitelist ) {
    50          
1810 1         5 $self->wiki->moderate_node(
1811             name => $node,
1812             version => $written
1813             );
1814             }
1815             elsif ( $config->send_moderation_notifications ) {
1816 1         18 my $body = "The node '$node' in the OpenGuides installation\n" .
1817             "'" . $config->site_name . "' requires moderation. ".
1818             "Please visit\n" .
1819             $config->script_url . $config->script_name .
1820             "?action=show_needing_moderation\nat your convenience.\n";
1821 1         9 eval {
1822 1         10 OpenGuides::Utils->send_email(
1823             config => $config,
1824             subject => "Node requires moderation",
1825             body => $body,
1826             admin => 1,
1827             return_output => $return_output
1828             );
1829             };
1830 1 50       251 warn $@ if $@;
1831             }
1832             }
1833              
1834 349         236576 my $output = $self->redirect_to_node($node);
1835 349 100       179239 return $output if $return_output;
1836 42         14050 print $output;
1837             } else {
1838 2         16 return $self->_handle_edit_conflict(
1839             id => $node,
1840             content => $content,
1841             new_metadata => \%new_metadata,
1842             return_output => $return_output,
1843             );
1844             }
1845             }
1846              
1847             sub _handle_edit_conflict {
1848 2     2   13 my ($self, %args) = @_;
1849 2   50     12 my $return_output = $args{return_output} || 0;
1850 2         10 my $config = $self->config;
1851 2         9 my $wiki = $self->wiki;
1852 2         5 my $node = $args{id};
1853 2         5 my $content = $args{content};
1854 2         5 my %new_metadata = %{$args{new_metadata}};
  2         42  
1855              
1856 2         16 my %node_data = $wiki->retrieve_node($node);
1857 2         4386 my %tt_vars = ( checksum => $node_data{checksum},
1858             new_content => $content,
1859             content => $node_data{content} );
1860 2         23 my %old_metadata = OpenGuides::Template->extract_metadata_vars(
1861             wiki => $wiki,
1862             config => $config,
1863             metadata => $node_data{metadata} );
1864             # Make sure we look at all variables.
1865 2         31 my @tmp = (keys %new_metadata, keys %old_metadata );
1866 2         8 my %tmp_hash = map { $_ => 1; } @tmp;
  102         152  
1867 2         44 my @all_vars = keys %tmp_hash;
1868              
1869 2         14 foreach my $mdvar ( keys %new_metadata ) {
1870 46 100 100     245 if ($mdvar eq "locales") {
    100 100        
    100          
1871 2         4 $tt_vars{$mdvar} = $old_metadata{locales};
1872 2         8 $tt_vars{"new_$mdvar"} = $new_metadata{locale};
1873             } elsif ($mdvar eq "categories") {
1874 2         7 $tt_vars{$mdvar} = $old_metadata{categories};
1875 2         7 $tt_vars{"new_$mdvar"} = $new_metadata{category};
1876             } elsif ($mdvar eq "username" or $mdvar eq "comment"
1877             or $mdvar eq "edit_type" ) {
1878 6         14 $tt_vars{$mdvar} = $new_metadata{$mdvar};
1879             } else {
1880 36         53 $tt_vars{$mdvar} = $old_metadata{$mdvar};
1881 36         82 $tt_vars{"new_$mdvar"} = $new_metadata{$mdvar};
1882             }
1883             }
1884              
1885 2         9 $tt_vars{coord_field_1} = $old_metadata{coord_field_1};
1886 2         6 $tt_vars{coord_field_2} = $old_metadata{coord_field_2};
1887 2         4 $tt_vars{coord_field_1_value} = $old_metadata{coord_field_1_value};
1888 2         6 $tt_vars{coord_field_2_value} = $old_metadata{coord_field_2_value};
1889 2         6 $tt_vars{"new_coord_field_1_value"}
1890             = $new_metadata{$old_metadata{coord_field_1}};
1891 2         5 $tt_vars{"new_coord_field_2_value"}
1892             = $new_metadata{$old_metadata{coord_field_2}};
1893              
1894 2         5 $tt_vars{conflict} = 1;
1895 2 50       9 return %tt_vars if $args{return_tt_vars};
1896 2         11 my $output = $self->process_template(
1897             id => $node,
1898             template => "edit_form.tt",
1899             tt_vars => \%tt_vars,
1900             );
1901 2 50       1766 return $output if $args{return_output};
1902 0         0 print $output;
1903             }
1904              
1905             =item B<_autoCreateCategoryLocale>
1906              
1907             $guide->_autoCreateCategoryLocale(
1908             id => "FAQ",
1909             metadata => \%metadata,
1910             );
1911              
1912             When a new node is added, or a previously un-moderated node is moderated,
1913             identifies if any of its Categories or Locales are missing, and creates them.
1914              
1915             Guide admins can control the text that gets put into the content field of the
1916             autocreated node by putting it in custom_autocreate_content.tt in their custom
1917             templates directory. The following TT variables will be available to the
1918             template:
1919              
1920             =over
1921              
1922             =item * index_type (e.g. C)
1923              
1924             =item * index_value (e.g. C)
1925              
1926             =item * node_name (e.g. C)
1927              
1928             =back
1929              
1930             (Note capitalisation - index_value is what they typed in to the form, and
1931             node_name is the fully free-upper-ed name of the autocreated node.)
1932              
1933             For nodes not requiring moderation, should be called on writing the node
1934             For nodes requiring moderation, should only be called on moderation
1935              
1936             =cut
1937              
1938             sub _autoCreateCategoryLocale {
1939 351     351   1335 my ($self, %args) = @_;
1940              
1941 351         1116 my $wiki = $self->wiki;
1942 351         817 my $id = $args{'id'};
1943 351         531 my %metadata = %{$args{'metadata'}};
  351         4337  
1944              
1945             # Check to make sure all the indexable nodes are created
1946 351         1321 my $config = $self->config;
1947 351         1573 my $template_path = $config->template_path;
1948 351   100     3759 my $custom_template_path = $config->custom_template_path || "";
1949 351         7282 my $tt = Template->new( { INCLUDE_PATH =>
1950             "$custom_template_path:$template_path" } );
1951              
1952 351         1287637 foreach my $type (qw(Category Locale)) {
1953 702         3203982 my $lctype = lc($type);
1954 702         889 foreach my $index (@{$metadata{$lctype}}) {
  702         4592  
1955 166         3054077 $index =~ s/(.*)/\u$1/;
1956 166         531 my $node = $type . " " . $index;
1957             # Uppercase the node name before checking for existence
1958 166         795 $node = $wiki->formatter->_do_freeupper( $node );
1959 166 100       3121 unless ( $wiki->node_exists($node) ) {
1960 84 100       57804 my $category = $type eq "Category" ? "Category" : "Locales";
1961             # Try to get the autocreated content from a custom template;
1962             # if we fail, use some default text.
1963 84         139 my $blurb;
1964 84         451 my %tt_vars = (
1965             index_type => $type,
1966             index_value => $index,
1967             node_name => $node,
1968             );
1969 84         7312 my $ok = $tt->process( "custom_autocreate_content.tt",
1970             \%tt_vars, \$blurb );
1971 84 100       31765 if ( !$ok ) {
1972 81         651 $ok = $tt->process( "autocreate_content.tt",
1973             \%tt_vars, \$blurb );
1974             }
1975 84 50       8280 if ( !$ok ) {
1976 0         0 $blurb = "\@INDEX_LINK [[$node]]";
1977             }
1978             $wiki->write_node(
1979 84         936 $node,
1980             $blurb,
1981             undef,
1982             {
1983             username => "Auto Create",
1984             comment => "Auto created $lctype stub page",
1985             category => $category
1986             }
1987             );
1988             }
1989             }
1990             }
1991             }
1992              
1993              
1994             =item B
1995              
1996             $guide->delete_node(
1997             id => "FAQ",
1998             version => 15,
1999             password => "beer",
2000             );
2001              
2002             C is optional - if it isn't supplied then all versions of the
2003             node will be deleted; in other words the node will be entirely
2004             removed.
2005              
2006             If C is not supplied then a form for entering the password
2007             will be displayed.
2008              
2009             As with other methods, parameters C and
2010             C can be used to return these things instead of
2011             printing the output to STDOUT.
2012              
2013             =cut
2014              
2015             sub delete_node {
2016 2     2 1 23 my ($self, %args) = @_;
2017 2 50       9 my $node = $args{id} or croak "No node ID supplied for deletion";
2018 2   50     14 my $return_tt_vars = $args{return_tt_vars} || 0;
2019 2   50     6 my $return_output = $args{return_output} || 0;
2020              
2021 2         9 my %tt_vars = (
2022             not_editable => 1,
2023             not_deletable => 1,
2024             deter_robots => 1,
2025             );
2026 2   50     12 $tt_vars{delete_version} = $args{version} || "";
2027              
2028 2         3 my $password = $args{password};
2029              
2030 2 50       8 if ($password) {
2031 2 50       10 if ($password ne $self->config->admin_pass) {
2032 0 0       0 return %tt_vars if $return_tt_vars;
2033 0         0 my $output = $self->process_template(
2034             id => $node,
2035             template => "delete_password_wrong.tt",
2036             tt_vars => \%tt_vars,
2037             );
2038 0 0       0 return $output if $return_output;
2039 0         0 print $output;
2040             } else {
2041 2         29 $self->wiki->delete_node(
2042             name => $node,
2043             version => $args{version},
2044             );
2045             # Check whether any versions of this node remain.
2046 2         220370 my %check = $self->wiki->retrieve_node( name => $node );
2047 2 50       1397 $tt_vars{other_versions_remain} = 1 if $check{version};
2048 2 50       10 return %tt_vars if $return_tt_vars;
2049 2         14 my $output = $self->process_template(
2050             id => $node,
2051             template => "delete_done.tt",
2052             tt_vars => \%tt_vars,
2053             );
2054 2 50       1891 return $output if $return_output;
2055 0         0 print $output;
2056             }
2057             } else {
2058 0 0       0 return %tt_vars if $return_tt_vars;
2059 0         0 my $output = $self->process_template(
2060             id => $node,
2061             template => "delete_confirm.tt",
2062             tt_vars => \%tt_vars,
2063             );
2064 0 0       0 return $output if $return_output;
2065 0         0 print $output;
2066             }
2067             }
2068              
2069             =item B
2070              
2071             $guide->set_node_moderation(
2072             id => "FAQ",
2073             password => "beer",
2074             moderation_flag => 1,
2075             );
2076              
2077             Sets the moderation needed flag on a node, either on or off.
2078              
2079             If C is not supplied then a form for entering the password
2080             will be displayed.
2081              
2082             =cut
2083              
2084             sub set_node_moderation {
2085 7     7 1 695879 my ($self, %args) = @_;
2086 7 50       45 my $node = $args{id} or croak "No node ID supplied for node moderation";
2087 7   50     60 my $return_tt_vars = $args{return_tt_vars} || 0;
2088 7   100     40 my $return_output = $args{return_output} || 0;
2089              
2090             # Get the moderation flag into something sane
2091 7 100 66     127 if($args{moderation_flag} eq "1" || $args{moderation_flag} eq "yes" ||
      66        
      33        
2092             $args{moderation_flag} eq "on" || $args{moderation_flag} eq "true") {
2093 1         4 $args{moderation_flag} = 1;
2094             } else {
2095 6         18 $args{moderation_flag} = 0;
2096             }
2097              
2098             # Set up the TT variables
2099 7         180 my %tt_vars = (
2100             not_editable => 1,
2101             not_deletable => 1,
2102             deter_robots => 1,
2103             moderation_action => 'set_moderation',
2104             moderation_flag => $args{moderation_flag},
2105             moderation_url_args => 'action=set_moderation;moderation_flag='.$args{moderation_flag},
2106             );
2107              
2108 7         24 my $password = $args{password};
2109              
2110 7 100       39 if ($password) {
2111 6 100       27 if ($password ne $self->config->admin_pass) {
2112 1 50       17 return %tt_vars if $return_tt_vars;
2113 1         6 my $output = $self->process_template(
2114             id => $node,
2115             template => "moderate_password_wrong.tt",
2116             tt_vars => \%tt_vars,
2117             );
2118 1 50       735 return $output if $return_output;
2119 0         0 print $output;
2120             } else {
2121 5         69 my $worked = $self->wiki->set_node_moderation(
2122             name => $node,
2123             required => $args{moderation_flag},
2124             );
2125 5         101852 my $moderation_flag = "changed";
2126 5 100       40 unless($worked) {
2127 1         3 $moderation_flag = "unknown_node";
2128 1         253 warn("Tried to set moderation status on node '$node', which doesn't exist");
2129             }
2130              
2131             # Send back to the admin interface
2132 5         48 my $script_url = $self->config->script_url;
2133 5         28 my $script_name = $self->config->script_name;
2134 5         103 my $q = CGI->new;
2135 5         2074 my $output = $q->redirect( $script_url.$script_name."?action=admin;moderation=".$moderation_flag );
2136 5 100       3526 return $output if $return_output;
2137 3         1311 print $output;
2138             }
2139             } else {
2140 1 50       8 return %tt_vars if $return_tt_vars;
2141 1         7 my $output = $self->process_template(
2142             id => $node,
2143             template => "moderate_confirm.tt",
2144             tt_vars => \%tt_vars,
2145             );
2146 1 50       1087 return $output if $return_output;
2147 0         0 print $output;
2148             }
2149             }
2150              
2151             =item B
2152              
2153             $guide->moderate_node(
2154             id => "FAQ",
2155             version => 12,
2156             password => "beer",
2157             );
2158              
2159             Marks a version of a node as moderated. Will also auto-create and Locales
2160             and Categories for the newly moderated version.
2161              
2162             If C is not supplied then a form for entering the password
2163             will be displayed.
2164              
2165             =cut
2166              
2167             sub moderate_node {
2168 1     1 1 12 my ($self, %args) = @_;
2169 1 50       5 my $node = $args{id} or croak "No node ID supplied for node moderation";
2170 1 50       3 my $version = $args{version} or croak "No node version supplied for node moderation";
2171 1   50     6 my $return_tt_vars = $args{return_tt_vars} || 0;
2172 1   50     5 my $return_output = $args{return_output} || 0;
2173              
2174             # Set up the TT variables
2175 1         6 my %tt_vars = (
2176             not_editable => 1,
2177             not_deletable => 1,
2178             deter_robots => 1,
2179             version => $version,
2180             moderation_action => 'moderate',
2181             moderation_url_args => 'action=moderate;version='.$version
2182             );
2183              
2184 1         1 my $password = $args{password};
2185 1 50       3 unless($self->config->moderation_requires_password) {
2186 0         0 $password = $self->config->admin_pass;
2187             }
2188              
2189 1 50       9 if ($password) {
2190 1 50       2 if ($password ne $self->config->admin_pass) {
2191 0 0       0 return %tt_vars if $return_tt_vars;
2192 0         0 my $output = $self->process_template(
2193             id => $node,
2194             template => "moderate_password_wrong.tt",
2195             tt_vars => \%tt_vars,
2196             );
2197 0 0       0 return $output if $return_output;
2198 0         0 print $output;
2199             } else {
2200 1         9 $self->wiki->moderate_node(
2201             name => $node,
2202             version => $version
2203             );
2204              
2205             # Create any categories or locales for it
2206 1         18312 my %details = $self->wiki->retrieve_node(
2207             name => $node,
2208             version => $version
2209             );
2210 1         1849 $self->_autoCreateCategoryLocale(
2211             id => $node,
2212             metadata => $details{'metadata'}
2213             );
2214              
2215             # Send back to the admin interface
2216 1         77914 my $script_url = $self->config->script_url;
2217 1         3 my $script_name = $self->config->script_name;
2218 1         15 my $q = CGI->new;
2219 1         279 my $output = $q->redirect( $script_url.$script_name."?action=admin;moderation=moderated" );
2220 1 50       371 return $output if $return_output;
2221 1         315 print $output;
2222             }
2223             } else {
2224 0 0       0 return %tt_vars if $return_tt_vars;
2225 0         0 my $output = $self->process_template(
2226             id => $node,
2227             template => "moderate_confirm.tt",
2228             tt_vars => \%tt_vars,
2229             );
2230 0 0       0 return $output if $return_output;
2231 0         0 print $output;
2232             }
2233             }
2234              
2235             =item B
2236              
2237             Search for nodes which don't have a certain kind of metadata. Excludes nodes
2238             which are pure redirects, and optionally also excludes locales and categories.
2239              
2240             =cut
2241              
2242             sub show_missing_metadata {
2243 14     14 1 60553 my ($self, %args) = @_;
2244 14   100     96 my $return_tt_vars = $args{return_tt_vars} || 0;
2245 14   100     63 my $return_output = $args{return_output} || 0;
2246              
2247 14         69 my $wiki = $self->wiki;
2248 14         38 my $formatter = $self->wiki->formatter;
2249 14         332 my $script_name = $self->config->script_name;
2250 14         183 my $use_leaflet = $self->config->use_leaflet;
2251              
2252 14         136 my ( $metadata_type, $metadata_value, $exclude_locales,
2253             $exclude_categories, $format)
2254             = @args{ qw( metadata_type metadata_value exclude_locales
2255             exclude_categories format ) };
2256 14   100     65 $format ||= "";
2257              
2258 14         99 my @nodes;
2259 14         25 my $done_search = 0;
2260 14         20 my $nodes_on_map;
2261              
2262             # Only search if they supplied at least a metadata type
2263 14 100       47 if($metadata_type) {
2264 10         18 $done_search = 1;
2265 10         51 my @all_nodes = $wiki->list_nodes_by_missing_metadata(
2266             metadata_type => $metadata_type,
2267             metadata_value => $metadata_value,
2268             ignore_case => 1,
2269             );
2270              
2271             # Filter out redirects; also filter out locales/categories if required.
2272 10         7225 foreach my $node ( sort @all_nodes ) {
2273 29 100 100     123 next if ( $exclude_locales && $node =~ /^Locale / );
2274 28 100 100     89 next if ( $exclude_categories && $node =~ /^Category / );
2275 27         117 my %data = $wiki->retrieve_node( $node );
2276 27 100       36134 next if OpenGuides::Utils->detect_redirect(
2277             content => $data{content} );
2278 23         117 my $node_param = $formatter->node_name_to_node_param( $node );
2279 23         841 my %this_node = (
2280             name => $node,
2281             param => $node_param,
2282             address => $data{metadata}{address}[0],
2283             view_url => "$script_name?$node_param",
2284             edit_url => "$script_name?id=$node_param;action=edit",
2285             );
2286 23 100 100     121 if ( $format eq "map" && $use_leaflet ) {
2287 7         49 my ( $wgs84_long, $wgs84_lat )
2288             = OpenGuides::Utils->get_wgs84_coords(
2289             latitude => $data{metadata}{latitude}[0],
2290             longitude => $data{metadata}{longitude}[0],
2291             config => $self->config );
2292 7 100       26 if ( defined $wgs84_lat ) {
2293 4         11 $this_node{has_geodata} = 1;
2294 4         11 $this_node{wgs84_lat} = $wgs84_lat;
2295 4         11 $this_node{wgs84_long} = $wgs84_long;
2296 4         8 $nodes_on_map++;
2297             }
2298             }
2299 23         239 push @nodes, \%this_node;
2300             }
2301             }
2302              
2303             # Set up our TT variables, including the search parameters
2304 14         153 my %tt_vars = (
2305             not_editable => 1,
2306             not_deletable => 1,
2307             deter_robots => 1,
2308             nodes => \@nodes,
2309             done_search => $done_search,
2310             no_nodes_on_map => !$nodes_on_map,
2311             metadata_type => $metadata_type,
2312             metadata_value => $metadata_value,
2313             exclude_locales => $exclude_locales,
2314             exclude_categories => $exclude_categories,
2315             script_name => $script_name
2316             );
2317              
2318             # Figure out the map boundaries and centre, if applicable.
2319 14 100       52 if ( $format eq "map" ) {
2320 5 100       18 if ( $use_leaflet ) {
2321 4         29 my %minmaxdata = OpenGuides::Utils->get_wgs84_min_max(
2322             nodes => \@nodes );
2323 4 100       17 if ( scalar %minmaxdata ) {
2324 2         30 %tt_vars = ( %tt_vars, %minmaxdata );
2325             }
2326 4         17 $tt_vars{display_google_maps} = 1; # to get the JavaScript in
2327             }
2328             # Set the show_map var even if we don't have Leaflet enabled, so
2329             # people aren't left wondering why there's no map.
2330 5         14 $tt_vars{show_map} = 1;
2331             }
2332              
2333 14 100       104 return %tt_vars if $return_tt_vars;
2334              
2335             # Render to the page
2336 10   50     83 my $output = $self->process_template(
2337             id => "",
2338             template => "missing_metadata.tt",
2339             tt_vars => \%tt_vars,
2340             noheaders => $args{noheaders} || 0,
2341             );
2342 10 50       9969 return $output if $return_output;
2343 0         0 print $output;
2344             }
2345              
2346             =item B
2347              
2348             If C is not supplied then a form for entering the password
2349             will be displayed, along with a list of all the edits the user made.
2350              
2351             If the password is given, will delete all of these versions.
2352             =cut
2353             sub revert_user_interface {
2354 9     9 1 6736 my ($self, %args) = @_;
2355              
2356 9   100     41 my $password = $args{password} || '';
2357 9   50     26 my $return_tt_vars = $args{return_tt_vars} || 0;
2358 9   50     40 my $return_output = $args{return_output} || 0;
2359              
2360 9         24 my $wiki = $self->wiki;
2361 9         19 my $formatter = $self->wiki->formatter;
2362 9         42 my $script_name = $self->config->script_name;
2363              
2364 9         81 my ($type,$value);
2365 9 50       25 if($args{'username'}) {
2366 9         17 ($type,$value) = ('username', $args{'username'});
2367             }
2368 9 50       20 if($args{'host'}) {
2369 0         0 ($type,$value) = ('host', $args{'host'});
2370             }
2371 9 50 33     43 unless($type && $value) {
2372 0         0 croak("One of username or host must be given");
2373             }
2374              
2375             # Grab everything they've touched, ever
2376 9         18 my @user_edits = $self->wiki->list_recent_changes(
2377             since => 1,
2378             metadata_was => { $type => $value },
2379             );
2380              
2381 9 100       12990 if ($password) {
2382 3 50       10 if ($password ne $self->config->admin_pass) {
2383 0         0 croak("Bad password supplied");
2384             } else {
2385             # Delete all these versions
2386 3         30 foreach my $edit (@user_edits) {
2387 4         118169 $self->wiki->delete_node(
2388             name => $edit->{name},
2389             version => $edit->{version},
2390             );
2391             }
2392              
2393             # Grab new list
2394 3         224903 @user_edits = $self->wiki->list_recent_changes(
2395             since => 1,
2396             metadata_was => { $type => $value },
2397             );
2398             }
2399             } else {
2400             # Don't do anything
2401             }
2402              
2403             # Set up our TT variables, including the search parameters
2404 9         1931 my %tt_vars = (
2405             not_editable => 1,
2406             not_deletable => 1,
2407             deter_robots => 1,
2408              
2409             edits => \@user_edits,
2410             username => $args{username},
2411             host => $args{host},
2412             by_type => $type,
2413             by => $value,
2414              
2415             script_name => $script_name
2416             );
2417 9 50       113 return %tt_vars if $return_tt_vars;
2418              
2419             # Render to the page
2420 0         0 my $output = $self->process_template(
2421             id => "",
2422             template => "admin_revert_user.tt",
2423             tt_vars => \%tt_vars,
2424             );
2425 0 0       0 return $output if $return_output;
2426 0         0 print $output;
2427             }
2428              
2429             =item B
2430              
2431             Fetch everything we need to display the admin interface, and passes it off
2432             to the template
2433              
2434             =cut
2435              
2436             sub display_admin_interface {
2437 2     2 1 2929 my ($self, %args) = @_;
2438 2   100     21 my $return_tt_vars = $args{return_tt_vars} || 0;
2439 2   100     9 my $return_output = $args{return_output} || 0;
2440              
2441 2         8 my $wiki = $self->wiki;
2442 2         7 my $formatter = $self->wiki->formatter;
2443 2         14 my $script_name = $self->config->script_name;
2444              
2445             # Grab all the recent nodes
2446 2         33 my @all_nodes = $wiki->list_recent_changes(last_n_changes => 100);
2447              
2448             # Split into nodes, Locales and Categories
2449 2         9711 my @nodes;
2450             my @categories;
2451 0         0 my @locales;
2452 2         6 for my $node (@all_nodes) {
2453             # Add moderation status
2454 10         131 $node->{'moderate'} = $wiki->node_required_moderation($node->{'name'});
2455              
2456             # Make the URLs
2457 10         10934 my $node_param = uri_escape( $formatter->node_name_to_node_param( $node->{'name'} ) );
2458 10         387 $node->{'view_url'} = $script_name . "?id=" . $node_param;
2459 10         24 $node->{'versions_url'} = $script_name .
2460             "?action=list_all_versions;id=" . $node_param;
2461 10         29 $node->{'moderation_url'} = $script_name .
2462             "?action=set_moderation;id=" . $node_param;
2463 10         37 $node->{'revert_user_url'} = $script_name . "?action=revert_user" .
2464             ";username=".$node->{metadata}->{username}->[0];
2465              
2466             # Filter
2467 10 100       53 if($node->{'name'} =~ /^Category /) {
    100          
2468 4         10 $node->{'page_name'} = $node->{'name'};
2469 4         16 $node->{'name'} =~ s/^Category //;
2470 4         10 push @categories, $node;
2471             } elsif($node->{'name'} =~ /^Locale /) {
2472 2         6 $node->{'page_name'} = $node->{'name'};
2473 2         7 $node->{'name'} =~ s/^Locale //;
2474 2         6 push @locales, $node;
2475             } else {
2476 4         12 push @nodes, $node;
2477             }
2478             }
2479              
2480             # Handle completed notice for actions
2481 2         6 my $completed_action = "";
2482 2 50       9 if($args{moderation_completed}) {
2483 0 0       0 if($args{moderation_completed} eq "moderation") {
2484 0         0 $completed_action = "Version moderated";
2485             }
2486 0 0       0 if($args{moderation_completed} eq "changed") {
2487 0         0 $completed_action = "Node moderation flag changed";
2488             }
2489 0 0       0 if($args{moderation_completed} eq "unknown_node") {
2490 0         0 $completed_action = "Node moderation flag not changed, node not known";
2491             }
2492             }
2493              
2494             # Render in a template
2495 2         19 my %tt_vars = (
2496             not_editable => 1,
2497             not_deletable => 1,
2498             deter_robots => 1,
2499             nodes => \@nodes,
2500             categories => \@categories,
2501             locales => \@locales,
2502             completed_action => $completed_action
2503             );
2504 2 100       16 return %tt_vars if $return_tt_vars;
2505 1         8 my $output = $self->process_template(
2506             id => "",
2507             template => "admin_home.tt",
2508             tt_vars => \%tt_vars,
2509             );
2510 1 50       1022 return $output if $return_output;
2511 0         0 print $output;
2512             }
2513              
2514             sub process_template {
2515 173     173 0 873 my ($self, %args) = @_;
2516 173         630 my %output_conf = (
2517             wiki => $self->wiki,
2518             config => $self->config,
2519             node => $args{id},
2520             template => $args{template},
2521             vars => $args{tt_vars},
2522             cookies => $args{cookies},
2523             http_status => $args{http_status},
2524             noheaders => $args{noheaders},
2525             );
2526 173 100       654 if ( $args{content_type} ) {
2527 3         8 $output_conf{content_type} = $args{content_type};
2528             }
2529 173         1736 return OpenGuides::Template->output( %output_conf );
2530             }
2531              
2532             # Redirection for legacy URLs.
2533             sub redirect_index_search {
2534 2     2 0 5 my ( $self, %args ) = @_;
2535 2   50     8 my $type = lc( $args{type} || "" );
2536 2   50     7 my $value = lc( $args{value} || "" );
2537 2   100     10 my $format = lc( $args{format} || "" );
2538              
2539 2         5 my $script_url = $self->config->script_url;
2540 2         6 my $script_name = $self->config->script_name;
2541              
2542 2         21 my $url = "$script_url$script_name?action=index";
2543              
2544 2 100       15 if ( $type eq "category" ) {
    50          
2545 1         4 $url .= ";cat=$value";
2546             } elsif ( $type eq "locale" ) {
2547 1         3 $url .= ";loc=$value";
2548             }
2549 2 100       18 if ( $format ) {
2550 1         3 $url .= ";format=$format";
2551             }
2552 2         18 return CGI->redirect( -uri => $url, -status => 301 );
2553             }
2554              
2555             sub redirect_to_node {
2556 357     357 0 1068 my ($self, $node, $redirected_from) = @_;
2557              
2558 357         1989 my $script_url = $self->config->script_url;
2559 357         1306 my $script_name = $self->config->script_name;
2560 357         3870 my $formatter = $self->wiki->formatter;
2561              
2562 357         3745 my $id = $formatter->node_name_to_node_param( $node );
2563 357         14061 my $oldid;
2564 357 100       1397 $oldid = $formatter->node_name_to_node_param( $redirected_from ) if $redirected_from;
2565              
2566 357         1336 my $redir_param = "$script_url$script_name?";
2567 357 100       1246 $redir_param .= 'id=' if $oldid;
2568 357         966 $redir_param .= $id;
2569 357 100       1187 $redir_param .= ";oldid=$oldid" if $oldid;
2570              
2571 357         3832 my $q = CGI->new;
2572 357         101720 return $q->redirect( $redir_param );
2573             }
2574              
2575             sub get_cookie {
2576 179     179 0 24390 my $self = shift;
2577 179         545 my $config = $self->config;
2578 179 50       635 my $pref_name = shift or return "";
2579 179         835 my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
2580 179         1430 return $cookie_data{$pref_name};
2581             }
2582              
2583             =back
2584              
2585             =head1 BUGS AND CAVEATS
2586              
2587             UTF8 data are currently not handled correctly throughout.
2588              
2589             Other bugs are documented at
2590             L
2591              
2592             =head1 SEE ALSO
2593              
2594             =over 4
2595              
2596             =item * The Randomness Guide to London, at L, the largest OpenGuides site.
2597              
2598             =item * The list of live OpenGuides installs at L.
2599              
2600             =item * L, the Wiki toolkit which does the heavy lifting for OpenGuides.
2601              
2602             =back
2603              
2604             =head1 FEEDBACK
2605              
2606             If you have a question, a bug report, or a patch, or you're interested
2607             in joining the development team, please contact openguides-dev@lists.openguides.org
2608             (moderated mailing list, will reach all current developers but you'll have
2609             to wait for your post to be approved) or file a bug report at
2610             L
2611              
2612             =head1 AUTHOR
2613              
2614             The OpenGuides Project (openguides-dev@lists.openguides.org)
2615              
2616             =head1 COPYRIGHT
2617              
2618             Copyright (C) 2003-2013 The OpenGuides Project. All Rights Reserved.
2619              
2620             The OpenGuides distribution is free software; you can redistribute it
2621             and/or modify it under the same terms as Perl itself.
2622              
2623             =head1 CREDITS
2624              
2625             Programming by Dominic Hargreaves, Earle Martin, Kake Pugh, and Ivor
2626             Williams. Testing and bug reporting by Billy Abbott, Jody Belka,
2627             Kerry Bosworth, Simon Cozens, Cal Henderson, Steve Jolly, and Bob
2628             Walker (among others). Much of the Module::Build stuff copied from
2629             the Siesta project L
2630              
2631             =cut
2632              
2633             1;