File Coverage

blib/lib/OpenGuides.pm
Criterion Covered Total %
statement 790 917 86.1
branch 298 430 69.3
condition 135 192 70.3
subroutine 44 47 93.6
pod 27 31 87.1
total 1294 1617 80.0


line stmt bran cond sub pod time code
1             package OpenGuides;
2 92     92   776061 use strict;
  92         229  
  92         2813  
3              
4 92     92   497 use Carp "croak";
  92         154  
  92         4542  
5 92     92   105297 use CGI;
  92         2519730  
  92         602  
6 92     92   89677 use Wiki::Toolkit::Plugin::Diff;
  92         2745686  
  92         3392  
7 92     92   67148 use Wiki::Toolkit::Plugin::Locator::Grid;
  92         86340  
  92         2730  
8 92     92   55650 use OpenGuides::CGI;
  92         285  
  92         2764  
9 92     92   53314 use OpenGuides::Feed;
  92         329  
  92         813  
10 92     92   52847 use OpenGuides::Template;
  92         301  
  92         3210  
11 92     92   60705 use OpenGuides::Utils;
  92         374  
  92         3310  
12 92     92   641 use Time::Piece;
  92         219  
  92         1028  
13 92     92   7134 use URI::Escape;
  92         192  
  92         5718  
14              
15 92     92   475 use vars qw( $VERSION );
  92         179  
  92         1083267  
16              
17             $VERSION = '0.81';
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 113     113 1 1967503 my ($class, %args) = @_;
45 113         453 my $self = {};
46 113         395 bless $self, $class;
47 113         1640 my $wiki = OpenGuides::Utils->make_wiki_object( config => $args{config} );
48 113         645 $self->{wiki} = $wiki;
49 113         419 $self->{config} = $args{config};
50              
51 113         700 my $geo_handler = $self->config->geo_handler;
52 113         1214 my $locator;
53 113 100       488 if ( $geo_handler == 1 ) {
    100          
54 99         1347 $locator = Wiki::Toolkit::Plugin::Locator::Grid->new(
55             x => "os_x", y => "os_y" );
56             } elsif ( $geo_handler == 2 ) {
57 4         65 $locator = Wiki::Toolkit::Plugin::Locator::Grid->new(
58             x => "osie_x", y => "osie_y" );
59             } else {
60 10         289 $locator = Wiki::Toolkit::Plugin::Locator::Grid->new(
61             x => "easting", y => "northing" );
62             }
63 113         3005 $wiki->register_plugin( plugin => $locator );
64 113         8415 $self->{locator} = $locator;
65              
66 113         1479 my $differ = Wiki::Toolkit::Plugin::Diff->new;
67 113         6679 $wiki->register_plugin( plugin => $differ );
68 113         6304 $self->{differ} = $differ;
69              
70 113 100       409 if($self->config->ping_services) {
71 1         10 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         4 my @ws = split(/\s*,\s*/, $self->config->ping_services);
80 1         23 my %well_known = Wiki::Toolkit::Plugin::Ping->well_known;
81 1         8 my %services;
82 1         2 foreach my $s (@ws) {
83 3 100       9 if($well_known{$s}) {
84 2         5 $services{$s} = $well_known{$s};
85             } else {
86 1         108 warn("Ignoring unknown ping service '$s'");
87             }
88             }
89             my $ping = Wiki::Toolkit::Plugin::Ping->new(
90             node_to_url => $self->{config}->{script_url}
91 1         11 . $self->{config}->{script_name} . '?$node',
92             services => \%services
93             );
94 1         57 $wiki->register_plugin( plugin => $ping );
95             }
96             }
97              
98 113         1867 return $self;
99             }
100              
101             =item B
102              
103             An accessor, returns the underlying L object.
104              
105             =cut
106              
107             sub wiki {
108 2162     2162 1 23222 my $self = shift;
109 2162         7530 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 3207     3207 1 37410 my $self = shift;
120 3207         17659 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 2382 my $self = shift;
131 7         36 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         43 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 106     106 1 2317917 my ($self, %args) = @_;
202 106   100     741 my $return_output = $args{return_output} || 0;
203 106         399 my $intercept_redirect = $args{intercept_redirect};
204             my $noheaders = ( $return_output && !$intercept_redirect
205 106   66     1380 && $args{noheaders} );
206 106         270 my $version = $args{version};
207 106   66     602 my $id = $args{id} || $self->config->home_name;
208 106         683 my $wiki = $self->wiki;
209 106         511 my $config = $self->config;
210 106   50     777 my $oldid = $args{oldid} || '';
211 106 100       464 my $do_redirect = defined($args{redirect}) ? $args{redirect} : 1;
212              
213 106         244 my %tt_vars;
214              
215             # If we can, check to see if requesting host is blacklisted.
216 106         669 my $host_checker = $config->host_checker_module;
217 106         1378 my $is_blacklisted;
218 106 100       422 if ( $host_checker ) {
219 1         2 eval {
220 1         69 eval "require $host_checker";
221 1         10 $is_blacklisted = $host_checker->blacklisted_host(CGI->new->remote_host);
222             };
223             }
224              
225 106 100       729 if ( $is_blacklisted ) {
226 1         4 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       950 return $output if $return_output;
236 0         0 print $output;
237 0         0 return;
238             }
239              
240 105         352 $tt_vars{home_name} = $self->config->home_name;
241              
242 105 100       1649 if ( $id =~ /^(Category|Locale) (.*)$/ ) {
243 12         36 my $type = $1;
244 12         33 $tt_vars{is_indexable_node} = 1;
245 12         42 $tt_vars{index_type} = lc($type);
246 12         44 $tt_vars{index_value} = $2;
247 12         62 $tt_vars{"rss_".lc($type)."_url"} =
248             $config->script_name . "?action=rc;format=rss;"
249             . lc($type) . "=" . lc(CGI->escape($2));
250 12         520 $tt_vars{"atom_".lc($type)."_url"} =
251             $config->script_name . "?action=rc;format=atom;"
252             . lc($type) . "=" . lc(CGI->escape($2));
253             }
254              
255 105         1066 my %current_data = $wiki->retrieve_node( $id );
256 105         175246 my $current_version = $current_data{version};
257 105 50 66     696 undef $version if ($version && $version == $current_version);
258 105         373 my %criteria = ( name => $id );
259 105 100       377 $criteria{version} = $version if $version; # retrieve_node default is current
260              
261 105         513 my %node_data = $wiki->retrieve_node( %criteria );
262              
263             # Fixes passing undefined values to Text::Wikiformat if node doesn't exist.
264 105         140643 my $content = '';
265 105 100       501 if ($node_data{content}) {
266 88         520 $content = $wiki->format($node_data{content});
267             }
268              
269 105         816412 my $modified = $node_data{last_modified};
270 105         294 my $moderated = $node_data{moderated};
271 105         208 my %metadata = %{$node_data{metadata}};
  105         1334  
272              
273             my ($wgs84_long, $wgs84_lat) = OpenGuides::Utils->get_wgs84_coords(
274             longitude => $metadata{longitude}[0],
275 105         1584 latitude => $metadata{latitude}[0],
276             config => $config);
277 105 50 33     636 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             my %metadata_vars = OpenGuides::Template->extract_metadata_vars(
284             wiki => $wiki,
285             config => $config,
286             metadata => $node_data{metadata}
287 105         1217 );
288              
289 105         892 my $node_exists = $wiki->node_exists($id);
290 105 100       146143 my $http_status = $node_exists ? undef : '404 Not Found';
291             %tt_vars = (
292             %tt_vars,
293             %metadata_vars,
294             content => $content,
295             last_modified => $modified,
296             version => $node_data{version},
297 105         1285 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 105 100       5569 $tt_vars{'deter_robots'} = 1 if $args{version};
310              
311 105 100 100     510 if ( $config->show_gmap_in_node_display
312             && $self->get_cookie( "display_google_maps" ) ) {
313 92         240 $tt_vars{display_google_maps} = 1;
314             }
315              
316             my $redirect = OpenGuides::Utils->detect_redirect(
317 105         703 content => $node_data{content} );
318 105 100       373 if ( $redirect ) {
319             # Don't redirect if the parameter "redirect" is given as 0.
320 3 100 33     15 if ($do_redirect == 0) {
    50 33        
321 1         4 $tt_vars{current} = 1;
322 1 50       4 return %tt_vars if $args{return_tt_vars};
323 1         8 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       1683 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       1341 if ( $return_output ) {
334 2 50       7 if ( $intercept_redirect ) {
335 2         11 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 102 100       452 $tt_vars{current} = 1 unless $version;
350              
351 102 100       472 if ($id eq "RecentChanges") {
    100          
352 2         8 $self->display_recent_changes(%args);
353             } elsif ( $id eq $self->config->home_name ) {
354 16 100       201 if ( $self->config->recent_changes_on_home_page ) {
355 15         326 my @recent = $wiki->list_recent_changes(
356             last_n_changes => 10,
357             metadata_was => { edit_type => "Normal edit" },
358             );
359 15         24547 my $base_url = $config->script_name . '?';
360             @recent = map {
361 15         187 {
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 16         490 . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name}))
374             }
375             } @recent;
376 15         1628 $tt_vars{recent_changes} = \@recent;
377             }
378 16 100       121 return %tt_vars if $args{return_tt_vars};
379 15         131 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       12300 return $output if $return_output;
387 0         0 print $output;
388             } else {
389 84 100       1587 return %tt_vars if $args{return_tt_vars};
390 76         451 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 76 50       129343 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 1304 my ( $self, %args ) = @_;
426 7         21 my $wiki = $self->wiki;
427 7         19 my $config = $self->config;
428              
429 7         14 my ( @catnodes, @locnodes, @nodes );
430 7 100       27 if ( $args{category} ) {
431             @catnodes = $wiki->list_nodes_by_metadata(
432             metadata_type => "category",
433             metadata_value => $args{category},
434 3         19 ignore_case => 1,
435             );
436             }
437 7 100       1380 if ( $args{locale} ) {
438             @locnodes = $wiki->list_nodes_by_metadata(
439             metadata_type => "locale",
440             metadata_value => $args{locale},
441 3         16 ignore_case => 1,
442             );
443             }
444              
445 7 100 66     1023 if ( $args{category} && $args{locale} ) {
    100          
    100          
446             # If we have both category and locale, return the intersection.
447 2         5 my %count;
448 2         6 foreach my $node ( @catnodes, @locnodes ) {
449 4         10 $count{$node}++;
450             }
451 2         8 foreach my $node ( keys %count ) {
452 3 100       12 push @nodes, $node if $count{$node} > 1;
453             }
454             } elsif ( $args{category} ) {
455 1         3 @nodes = @catnodes;
456             } elsif ( $args{locale} ) {
457 1         4 @nodes = @locnodes;
458             } else {
459 3         110 @nodes = $wiki->list_all_nodes();
460             }
461              
462 7         1011 my $omit_cats = $config->random_page_omits_categories;
463 7         87 my $omit_locs = $config->random_page_omits_locales;
464              
465 7 100 100     90 if ( $omit_cats || $omit_locs ) {
466 2         5 my %all_nodes = map { $_ => $_ } @nodes;
  6         19  
467 2 100       8 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         324 foreach my $omit ( @cats ) {
474 1         4 delete $all_nodes{$omit};
475             }
476             }
477 2 100       9 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         387 foreach my $omit ( @locs ) {
484 1         4 delete $all_nodes{$omit};
485             }
486             }
487 2         11 @nodes = keys %all_nodes;
488             }
489 7         28 my $node = $nodes[ rand @nodes ];
490 7         13 my $output;
491              
492 7 100       20 if ( $node ) {
493 6         19 $output = $self->redirect_to_node( $node );
494             } else {
495             my %tt_vars = (
496             category => $args{category},
497             locale => $args{locale},
498 1         5 );
499 1         14 $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       3486 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 4659 my ($self, %args) = @_;
533 6   50     31 my $return_output = $args{return_output} || 0;
534 6         22 my $config = $self->config;
535 6         24 my $wiki = $self->wiki;
536 6         16 my $node = $args{id};
537 6         31 my %node_data = $wiki->retrieve_node($node);
538 6         7673 my ($content, $checksum) = @node_data{ qw( content checksum ) };
539 6         138 my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
540              
541 6         42 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             my %metadata_vars = OpenGuides::Template->extract_metadata_vars(
547             wiki => $wiki,
548             config => $config,
549 6         62 metadata => $node_data{metadata} );
550              
551 6   50     57 $metadata_vars{website} ||= 'http://';
552 6         31 my $moderate = $wiki->node_required_moderation($node);
553              
554 6         6936 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       1509 $tt_vars{content} = $args{content} if $args{content};
567 6 50       25 $tt_vars{checksum} = $args{checksum} if $args{checksum};
568 6 100       23 if (defined $args{vars}) {
569 1         2 my %supplied_vars = %{$args{vars}};
  1         4  
570 1         4 foreach my $key ( keys %supplied_vars ) {
571 1         3 $tt_vars{$key} = $supplied_vars{$key};
572             }
573             }
574 6 100       24 if (defined $args{metadata}) {
575 1         2 my %supplied_metadata = %{$args{metadata}};
  1         13  
576 1         6 foreach my $key ( keys %supplied_metadata ) {
577 20         33 $tt_vars{$key} = $supplied_metadata{$key};
578             }
579             }
580              
581 6         37 my $output = $self->process_template(
582             id => $node,
583             template => "edit_form.tt",
584             tt_vars => \%tt_vars,
585             );
586 6 50       5761 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 721 my ($self, %args) = @_;
605 1         3 my $node = $args{id};
606 1         2 my $q = $args{cgi_obj};
607 1         3 my $return_output = $args{return_output};
608 1         4 my $wiki = $self->wiki;
609 1         4 my $config = $self->config;
610              
611 1         4 my $content = $q->param('content');
612 1         21 $content =~ s/\r\n/\n/gs;
613 1         4 my $checksum = $q->param('checksum');
614              
615 1         28 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         5 foreach my $var ( qw( username comment edit_type ) ) {
622 3         329 $new_metadata{$var} = $q->escapeHTML(scalar $q->param($var));
623             }
624              
625 1 50       75 if ($wiki->verify_checksum($node, $checksum)) {
626 1         734 my $moderate = $wiki->node_required_moderation($node);
627 1         517 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       1166 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 30939 my ($self, %args) = @_;
669 14         58 my $config = $self->config;
670 14         50 my $wiki = $self->wiki;
671              
672 14   100     71 my $from = $ENV{HTTP_REFERER} || "";
673 14         62 my $url_base = $config->script_url . $config->script_name;
674 14 100       232 if ( $from !~ /^$url_base/ ) {
675 12         26 $from = "";
676             }
677              
678 14         73 my %tt_vars = (
679             not_editable => 1,
680             show_form => 1,
681             not_deletable => 1,
682             return_to_url => $from,
683             );
684 14 100       62 return %tt_vars if $args{return_tt_vars};
685              
686             my $output = OpenGuides::Template->output(
687             wiki => $wiki,
688             config => $config,
689             template => "preferences.tt",
690             vars => \%tt_vars,
691             noheaders => $args{noheaders},
692 12         112 );
693 12 50       11524 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 37     37 1 26776 my ($self, %args) = @_;
708 37         147 my $config = $self->config;
709 37         145 my $wiki = $self->wiki;
710 37         160 my $minor_edits = $self->get_cookie( "show_minor_edits_in_rc" );
711 37   66     219 my $id = $args{id} || $self->config->home_name;
712 37   100     512 my $return_output = $args{return_output} || 0;
713 37         63 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 37         249 my $q = CGI->new;
717 37   66     9602 my $since = $args{since} || $q->param("since");
718 37 100       606 if ( $since ) {
719 6         14 $tt_vars{since} = $since;
720 6         26 my $t = localtime($since); # overloaded by Time::Piece
721 6         388 $tt_vars{since_string} = $t->strftime;
722 6         195 my %criteria = ( since => $since );
723 6 100       26 $criteria{metadata_was} = { edit_type => "Normal edit" }
724             unless $minor_edits;
725 6         20 my @rc = $self->_get_recent_changes(
726             config => $config, criteria => \%criteria );
727 6 100       28 if ( scalar @rc ) {
728 5         24 $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 31         56 my %seen;
734 31         153 for my $days ( [0, 1], [1, 7], [7, 14], [14, 30] ) {
735 124         331 my %criteria = ( between_days => $days );
736 124 100       471 $criteria{metadata_was} = { edit_type => "Normal edit" }
737             unless $minor_edits;
738 124         395 my @rc = $self->_get_recent_changes(
739             config => $config, criteria => \%criteria );
740 124         239 my @filtered;
741 124         239 foreach my $node ( @rc ) {
742 54 100       190 next if $seen{$node->{name}};
743 47         118 $seen{$node->{name}}++;
744 47         107 push @filtered, $node;
745             }
746 124 100       515 if ( scalar @filtered ) {
747 35         196 $recent_changes{$days->[1]} = \@filtered;
748             }
749             }
750             }
751 37         165 $tt_vars{not_editable} = 1;
752 37         118 $tt_vars{recent_changes} = \%recent_changes;
753 37         210 my %processing_args = (
754             id => $id,
755             template => "recent_changes.tt",
756             tt_vars => \%tt_vars,
757             );
758 37 100 100     309 if ( !$since && $self->get_cookie("track_recent_changes_views") ) {
759 9         43 my $cookie =
760             OpenGuides::CGI->make_recent_changes_cookie(config => $config );
761 9         30 $processing_args{cookies} = $cookie;
762 9         40 $tt_vars{last_viewed} = OpenGuides::CGI->get_last_recent_changes_visit_from_cookie( config => $config );
763             }
764 37 100       223 return %tt_vars if $args{return_tt_vars};
765 29         168 my $output = $self->process_template( %processing_args );
766 29 50       30031 return $output if $return_output;
767 0         0 print $output;
768             }
769              
770             sub _get_recent_changes {
771 130     130   359 my ( $self, %args ) = @_;
772 130         317 my $wiki = $self->wiki;
773 130         519 my $formatter = $wiki->formatter;
774 130         635 my $config = $self->config;
775 130         186 my %criteria = %{ $args{criteria} };
  130         443  
776              
777 130         535 my @rc = $wiki->list_recent_changes( %criteria );
778 130         131571 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 130 100       1737 if ( $criteria{metadata_was} ) {
783 67         94 my %seen;
784             my @filtered;
785 67         146 foreach my $node ( @rc ) {
786 38 100       127 next if $seen{$node->{name}};
787 33         98 $seen{$node->{name}}++;
788 33         68 push @filtered, $node;
789             }
790 67         178 @rc = @filtered;
791             }
792              
793             @rc = map {
794 130         246 my $url = $base_url
795 63         2674 . CGI->escape($formatter->node_name_to_node_param($_->{name}));
796             # CGI->escape escapes commas in URLs. This is annoying.
797 63         2437 $url =~ s/%2C/,/gs;
798             {
799             name => CGI->escapeHTML($_->{name}),
800             last_modified => CGI->escapeHTML($_->{last_modified}),
801             version => CGI->escapeHTML($_->{version}),
802             comment => OpenGuides::Utils::parse_change_comment(
803             CGI->escapeHTML($_->{metadata}{comment}[0]),
804             $base_url,
805             ),
806             username => CGI->escapeHTML($_->{metadata}{username}[0]),
807             host => CGI->escapeHTML($_->{metadata}{host}[0]),
808             username_param => CGI->escape($_->{metadata}{username}[0]),
809 63         285 edit_type => CGI->escapeHTML($_->{metadata}{edit_type}[0]),
810             url => $url
811             }
812             } @rc;
813 130         6625 return @rc;
814             }
815              
816             =item B
817              
818             $guide->display_diffs(
819             id => "Home Page",
820             version => 6,
821             other_version => 5,
822             );
823              
824             # Or return output as a string (useful for writing tests).
825             my $output = $guide->display_diffs(
826             id => "Home Page",
827             version => 6,
828             other_version => 5,
829             return_output => 1,
830             );
831              
832             # Or return the hash of variables that will be passed to the template
833             # (not including those set additionally by OpenGuides::Template).
834             my %vars = $guide->display_diffs(
835             id => "Home Page",
836             version => 6,
837             other_version => 5,
838             return_tt_vars => 1,
839             );
840              
841             =cut
842              
843             sub display_diffs {
844 4     4 1 495188 my ($self, %args) = @_;
845             my %diff_vars = $self->differ->differences(
846             node => $args{id},
847             left_version => $args{version},
848             right_version => $args{other_version},
849 4         17 );
850 4         81893 $diff_vars{not_deletable} = 1;
851 4         13 $diff_vars{not_editable} = 1;
852 4         9 $diff_vars{deter_robots} = 1;
853 4 50       21 return %diff_vars if $args{return_tt_vars};
854             my $output = $self->process_template(
855             id => $args{id},
856 4         25 template => "differences.tt",
857             tt_vars => \%diff_vars
858             );
859 4 50       4641 return $output if $args{return_output};
860 0         0 print $output;
861             }
862              
863             =item B
864              
865             $guide->find_within_distance(
866             id => $node,
867             metres => $q->param("distance_in_metres")
868             );
869              
870             =cut
871              
872             sub find_within_distance {
873 0     0 1 0 my ($self, %args) = @_;
874 0         0 my $node = $args{id};
875 0         0 my $metres = $args{metres};
876 0         0 my %data = $self->wiki->retrieve_node( $node );
877 0         0 my $lat = $data{metadata}{latitude}[0];
878 0         0 my $long = $data{metadata}{longitude}[0];
879 0         0 my $script_url = $self->config->script_url;
880 0         0 my $q = CGI->new;
881 0         0 print $q->redirect( $script_url . "search.cgi?lat=$lat;long=$long;distance_in_metres=$metres" );
882             }
883              
884             =item B
885              
886             $guide->show_backlinks( id => "Calthorpe Arms" );
887              
888             As with other methods, parameters C and
889             C can be used to return these things instead of
890             printing the output to STDOUT.
891              
892             =cut
893              
894             sub show_backlinks {
895 0     0 1 0 my ($self, %args) = @_;
896 0         0 my $wiki = $self->wiki;
897 0         0 my $formatter = $wiki->formatter;
898              
899 0         0 my @backlinks = $wiki->list_backlinks( node => $args{id} );
900             my @results = map {
901 0         0 {
902 0         0 url => CGI->escape($formatter->node_name_to_node_param($_)),
903             title => CGI->escapeHTML($_)
904             }
905             } sort @backlinks;
906 0         0 my %tt_vars = ( results => \@results,
907             num_results => scalar @results,
908             not_deletable => 1,
909             deter_robots => 1,
910             not_editable => 1 );
911 0 0       0 return %tt_vars if $args{return_tt_vars};
912             my $output = OpenGuides::Template->output(
913             node => $args{id},
914 0         0 wiki => $wiki,
915             config => $self->config,
916             template=>"backlink_results.tt",
917             vars => \%tt_vars,
918             );
919 0 0       0 return $output if $args{return_output};
920 0         0 print $output;
921             }
922              
923             =item B
924              
925             # Show everything in Category: Pubs.
926             $guide->show_index(
927             cat => "pubs",
928             );
929              
930             # Show all pubs in Holborn.
931             $guide->show_index(
932             cat => "pubs",
933             loc => "holborn",
934             );
935              
936             # RDF version of things in Locale: Holborn.
937             $guide->show_index(
938             loc => "Holborn",
939             format => "rdf",
940             );
941              
942             # RSS / Atom version (recent changes style).
943             $guide->show_index(
944             loc => "Holborn",
945             format => "rss",
946             );
947              
948             # Or return output as a string (useful for writing tests).
949             $guide->show_index(
950             cat => "pubs",
951             return_output => 1,
952             );
953              
954             # Return output as a string with HTTP headers omitted (for tests).
955             $guide->show_index(
956             cat => "pubs",
957             return_output => 1,
958             noheaders => 1,
959             );
960              
961             # Or return the template variables (again, useful for writing tests).
962             $guide->show_index(
963             cat => "pubs",
964             format => "map"
965             return_tt_vars => 1,
966             );
967              
968             If neither C or C is supplied, then all pages will be returned.
969              
970             The recommended format of parameters to this method changed to the
971             above in version 0.67 of OpenGuides, though older invocations are
972             still supported and will redirect to the new URL format.
973              
974             If you pass the C or C parameters, and a
975             redirect is required, this method will fake the redirect and return the
976             output/variables that will actually end up being viewed by the user. If
977             instead you want to see the HTTP headers that will be printed in order to
978             perform the redirect, pass the C parameter as well.
979              
980             The C parameter has no effect if no redirect is required,
981             or if the C/C parameter is omitted.
982              
983             The C parameter only takes effect if C is true
984             and C is false or omitted.
985              
986             =cut
987              
988             sub show_index {
989 35     35 1 414316 my ($self, %args) = @_;
990 35         150 my $wiki = $self->wiki;
991 35         206 my $formatter = $wiki->formatter;
992 35         236 my $use_leaflet = $self->config->use_leaflet;
993 35         374 my %tt_vars;
994             my @selnodes;
995              
996 35 100 66     212 if ( $args{type} and $args{value} ) {
997 2 50       8 if ( $args{type} eq "fuzzy_title_match" ) {
998 0         0 my %finds = $wiki->fuzzy_title_match( $args{value} );
999 0         0 @selnodes = sort { $finds{$a} <=> $finds{$b} } keys %finds;
  0         0  
1000             $tt_vars{criterion} = {
1001             type => $args{type}, # for RDF version
1002             value => $args{value}, # for RDF version
1003 0         0 name => CGI->escapeHTML("Fuzzy Title Match on '$args{value}'")
1004             };
1005 0         0 $tt_vars{not_editable} = 1;
1006             } else {
1007 2         11 return $self->_do_old_style_index_search( %args );
1008             }
1009             } else {
1010             # OK, we either show everything, or do a new-style cat/loc search.
1011 33   100     219 my $cat = $args{cat} || "";
1012 33   100     146 my $loc = $args{loc} || "";
1013 33         62 my ( $type, $value, @names, @criteria );
1014 33 100 100     185 if ( !$cat && !$loc ) {
1015 1         8 @selnodes = $wiki->list_all_nodes();
1016             } else {
1017 32         64 my ( @catnodes, @locnodes );
1018 32 100       108 if ( $cat ) {
1019 17         91 @catnodes = $wiki->list_nodes_by_metadata(
1020             metadata_type => "category",
1021             metadata_value => $cat,
1022             ignore_case => 1
1023             );
1024 17         9296 my $name = "Category $cat";
1025 17         169 $name =~ s/(\s\w)/\U$1/g;
1026 17         119 push @criteria, {
1027             type => "category",
1028             value => $cat,
1029             name => $name,
1030             param => $formatter->node_name_to_node_param( $name ),
1031             };
1032 17         594 push @names, $name;
1033             }
1034 32 100       122 if ( $loc ) {
1035 23         123 @locnodes = $wiki->list_nodes_by_metadata(
1036             metadata_type => "locale",
1037             metadata_value => $loc,
1038             ignore_case => 1
1039             );
1040 23         10734 my $name = "Locale $loc";
1041 23         218 $name =~ s/(\s\w)/\U$1/g;
1042 23         155 push @criteria, {
1043             type => "locale",
1044             value => $loc,
1045             name => $name,
1046             param => $formatter->node_name_to_node_param( $name ),
1047             };
1048 23         773 push @names, $name;
1049             }
1050 32 100 100     367 if ( $cat && !$loc ) {
    100 66        
1051 9         25 @selnodes = @catnodes;
1052             } elsif ( $loc && !$cat ) {
1053 15         44 @selnodes = @locnodes;
1054             } else {
1055             # Intersect the category and locale results.
1056 8         23 my %count = ();
1057 8         19 foreach my $node ( @catnodes, @locnodes ) { $count{$node}++; }
  28         63  
1058 8         50 foreach my $node ( keys %count ) {
1059 20 100       69 push @selnodes, $node if $count{$node} > 1;
1060             }
1061             }
1062 32         138 $tt_vars{criteria_title} = join( " and ", @names );
1063 32         81 $tt_vars{criteria} = \@criteria;
1064 32         107 $tt_vars{not_editable} = 1;
1065             }
1066              
1067             $tt_vars{page_description} =
1068             OpenGuides::Utils->get_index_page_description(
1069 33   100     1145 format => $args{format} || "",
1070             criteria => \@criteria,
1071             );
1072              
1073 33         115 my $feed_base = $self->config->script_url
1074             . $self->config->script_name . "?action=index";
1075 33         365 foreach my $criterion ( @criteria ) {
1076 40 100       182 if ( $criterion->{type} eq "category" ) {
    50          
1077 17         70 $feed_base .= ";cat=" . lc( $criterion->{value} );
1078             } elsif ( $criterion->{type} eq "locale" ) {
1079 23         90 $feed_base .= ";loc=" . lc( $criterion->{value} );
1080             }
1081             }
1082 33         315 my @dropdowns = OpenGuides::CGI->make_index_form_dropdowns(
1083             guide => $self,
1084             selected => \@criteria );
1085 33         98 $tt_vars{index_form_fields} = \@dropdowns;
1086 33         125 $tt_vars{feed_base} = $feed_base;
1087             }
1088              
1089             my @nodes = map {
1090 33         99 {
1091 62         42396 name => $_,
1092             node_data => { $wiki->retrieve_node( name => $_ ) },
1093             param => $formatter->node_name_to_node_param($_) }
1094             } sort @selnodes;
1095              
1096             # Convert the lat+long to WGS84 as required, and count how many nodes
1097             # we have for the map (if using Leaflet).
1098 33         55456 my $nodes_on_map;
1099 33         216 for(my $i=0; $i
1100 62         116 my $node = $nodes[$i];
1101 62 50       165 if($node) {
1102 62         89 my %metadata = %{$node->{node_data}->{metadata}};
  62         771  
1103 62         171 my ($wgs84_long, $wgs84_lat);
1104 62         108 eval {
1105             ($wgs84_long, $wgs84_lat) = OpenGuides::Utils->get_wgs84_coords(
1106             longitude => $metadata{longitude}[0],
1107 62         354 latitude => $metadata{latitude}[0],
1108             config => $self->config);
1109             };
1110 62 50       215 warn $@." on ".$metadata{latitude}[0]." ".$metadata{longitude}[0] if $@;
1111              
1112 62         99 push @{$nodes[$i]->{node_data}->{metadata}->{wgs84_long}}, $wgs84_long;
  62         233  
1113 62         101 push @{$nodes[$i]->{node_data}->{metadata}->{wgs84_lat}}, $wgs84_lat;
  62         250  
1114 62 100       221 if ( $use_leaflet ) {
1115 48 50 100     577 if ( defined $wgs84_lat && $wgs84_lat =~ /^[-.\d]+$/
      66        
      66        
1116             && defined $wgs84_long && $wgs84_long =~ /^[-.\d]+$/ ) {
1117 19         48 $node->{has_geodata} = 1;
1118 19         36 $node->{wgs84_lat} = $wgs84_lat;
1119 19         36 $node->{wgs84_long} = $wgs84_long;
1120 19         108 $nodes_on_map++;
1121             }
1122             }
1123             }
1124             }
1125              
1126 33         156 $tt_vars{nodes} = \@nodes;
1127              
1128 33         56 my ($template, %conf);
1129              
1130 33 100       110 if ( $args{format} ) {
1131 23 100 66     196 if ( $args{format} eq "rdf" ) {
    100          
    50          
    100          
    50          
1132 2         5 $template = "rdf_index.tt";
1133 2         6 $conf{content_type} = "application/rdf+xml";
1134             } elsif ( $args{format} eq "json" ) {
1135 1         2 $template = "json_index.tt";
1136 1         3 $conf{content_type} = "text/javascript";
1137             } elsif ( $args{format} eq "plain" ) {
1138 0         0 $template = "plain_index.tt";
1139 0         0 $conf{content_type} = "text/plain";
1140             } elsif ( $args{format} eq "map" ) {
1141 18         55 $tt_vars{display_google_maps} = 1; # override for this page
1142 18 100       61 if ( $use_leaflet ) {
1143 17 100       50 if ( $nodes_on_map ) {
1144             my @points = map {
1145 9         19 { wgs84_lat =>
1146             $_->{node_data}->{metadata}->{wgs84_lat}[0],
1147             wgs84_long =>
1148 29         138 $_->{node_data}->{metadata}->{wgs84_long}[0]
1149             }
1150             } @nodes;
1151 9         50 my %minmaxdata = OpenGuides::Utils->get_wgs84_min_max(
1152             nodes => \@points );
1153 9         141 %tt_vars = ( %tt_vars, %minmaxdata );
1154             } else {
1155 8         23 $tt_vars{no_nodes_on_map} = 1;
1156             }
1157 17         66 $template = "map_index_leaflet.tt";
1158             } else {
1159 1         5 my $q = CGI->new;
1160 1   50     233 $tt_vars{zoom} = $q->param('zoom') || '';
1161 1   50     22 $tt_vars{lat} = $q->param('lat') || '';
1162 1   50     22 $tt_vars{long} = $q->param('long') || '';
1163 1   50     23 $tt_vars{map_type} = $q->param('map_type') || '';
1164 1         20 $tt_vars{centre_long} = $self->config->centre_long;
1165 1         13 $tt_vars{centre_lat} = $self->config->centre_lat;
1166             $tt_vars{default_gmaps_zoom}
1167 1         11 = $self->config->default_gmaps_zoom;
1168 1         11 $tt_vars{enable_gmaps} = 1;
1169 1         4 $template = "map_index.tt";
1170             }
1171             } elsif( $args{format} eq "rss" || $args{format} eq "atom") {
1172             # They really wanted a recent changes style rss/atom feed
1173 2         4 my $feed_type = $args{format};
1174 2         8 my ($feed,$content_type) = $self->get_feed_and_content_type($feed_type);
1175 2         4 my ($name, $params );
1176 2 50       6 if ( $args{cat} ) {
1177 2         5 $name = "Index of Category $args{cat}";
1178 2         7 $params = "action=index;cat=$args{cat}";
1179             } else {
1180 0         0 $name = "Index of Locale $args{loc}";
1181 0         0 $params = "action=index;loc=$args{loc}";
1182             }
1183 2         9 $feed->set_feed_name_and_url_params( $name, $params );
1184              
1185             # Grab the actual node data out of @nodes
1186 2         4 my @node_data;
1187 2         4 foreach my $node (@nodes) {
1188 4         12 $node->{node_data}->{name} = $node->{name};
1189 4         10 push @node_data, $node->{node_data};
1190             }
1191              
1192 2         6 my $output = "Content-Type: ".$content_type."\n";
1193 2         10 $output .= $feed->build_feed_for_nodes($feed_type, @node_data);
1194              
1195 2 50       50 return $output if $args{return_output};
1196 0         0 print $output;
1197 0         0 return;
1198             }
1199             } else {
1200 10         24 $template = "site_index.tt";
1201             }
1202              
1203 31 100       329 return %tt_vars if $args{return_tt_vars};
1204              
1205 24         105 %conf = (
1206             %conf,
1207             template => $template,
1208             tt_vars => \%tt_vars,
1209             );
1210              
1211 24 50 33     192 if ( $args{return_output} && !$args{intercept_redirect} ) {
1212 24         60 $conf{noheaders} = $args{noheaders};
1213             }
1214              
1215 24         118 my $output = $self->process_template( %conf );
1216 24 50       18504 return $output if $args{return_output};
1217 0         0 print $output;
1218             }
1219              
1220             # Deal with legacy URLs/tests.
1221             sub _do_old_style_index_search {
1222 2     2   8 my ( $self, %args ) = @_;
1223 2 50 33     8 if ( ( $args{return_output} || $args{return_tt_vars} ) ) {
1224 2 50       8 if ( $args{intercept_redirect} ) {
1225 2         10 return $self->redirect_index_search( %args );
1226             } else {
1227 0         0 my $type = delete $args{type};
1228 0         0 my $value = delete $args{value};
1229 0 0       0 if ( $type eq "category" ) {
    0          
1230 0         0 return $self->show_index( %args, cat => $value );
1231             } elsif ( $type eq "locale" ) {
1232 0         0 return $self->show_index( %args, loc => $value );
1233             } else {
1234 0         0 return $self->show_index( %args );
1235             }
1236             }
1237             } else {
1238 0         0 print $self->redirect_index_search( %args );
1239             }
1240             }
1241              
1242             =item B
1243              
1244             $guide->show_metadata();
1245             $guide->show_metadata(type => "category");
1246             $guide->show_metadata(type => "category", format => "json");
1247              
1248             Lists all metadata types, or all metadata values of a given
1249             type. Useful for programatically discovering a guide.
1250              
1251             As with other methods, parameters C and
1252             C can be used to return these things instead of
1253             printing the output to STDOUT.
1254              
1255             =cut
1256             sub show_metadata {
1257 0     0 1 0 my ($self, %args) = @_;
1258 0         0 my $wiki = $self->wiki;
1259 0         0 my $formatter = $wiki->formatter;
1260              
1261 0         0 my @values;
1262             my $type;
1263 0         0 my $may_descend = 0;
1264 0 0 0     0 if($args{"type"} && $args{"type"} ne "metadata_type") {
1265 0         0 $type = $args{"type"};
1266 0         0 @values = $wiki->store->list_metadata_by_type($args{"type"});
1267             } else {
1268 0         0 $may_descend = 1;
1269 0         0 $type = "metadata_type";
1270 0         0 @values = $wiki->store->list_metadata_names;
1271             }
1272              
1273 0         0 my %tt_vars = ( type => $type,
1274             may_descend => $may_descend,
1275             metadata => \@values,
1276             num_results => scalar @values,
1277             not_deletable => 1,
1278             deter_robots => 1,
1279             not_editable => 1 );
1280 0 0       0 return %tt_vars if $args{return_tt_vars};
1281              
1282 0         0 my $output;
1283             my $content_type;
1284              
1285 0 0       0 if($args{"format"}) {
1286 0 0       0 if($args{"format"} eq "json") {
1287 0         0 $content_type = "text/javascript";
1288 0         0 my $json = OpenGuides::JSON->new( wiki => $wiki,
1289             config => $self->config );
1290 0         0 $output = $json->output_as_json(
1291             $type => \@values
1292             );
1293             }
1294             }
1295 0 0       0 unless($output) {
1296 0         0 $output = OpenGuides::Template->output(
1297             wiki => $wiki,
1298             config => $self->config,
1299             template=>"metadata.tt",
1300             vars => \%tt_vars,
1301             );
1302             }
1303 0 0       0 return $output if $args{return_output};
1304              
1305 0 0       0 if($content_type) {
1306 0         0 print "Content-type: $content_type\n\n";
1307             }
1308 0         0 print $output;
1309             }
1310              
1311             =item B
1312              
1313             $guide->list_all_versions ( id => "Home Page" );
1314              
1315             # Or return output as a string (useful for writing tests).
1316             $guide->list_all_versions (
1317             id => "Home Page",
1318             return_output => 1,
1319             );
1320              
1321             # Or return the hash of variables that will be passed to the template
1322             # (not including those set additionally by OpenGuides::Template).
1323             $guide->list_all_versions (
1324             id => "Home Page",
1325             return_tt_vars => 1,
1326             );
1327              
1328             =cut
1329              
1330             sub list_all_versions {
1331 4     4 1 10566 my ($self, %args) = @_;
1332 4   50     20 my $return_output = $args{return_output} || 0;
1333 4         12 my $node = $args{id};
1334 4         17 my %curr_data = $self->wiki->retrieve_node($node);
1335 4         6669 my $curr_version = $curr_data{version};
1336 4         9 my @history;
1337 4         112 for my $version ( 1 .. $curr_version ) {
1338 4         16 my %node_data = $self->wiki->retrieve_node( name => $node,
1339             version => $version );
1340             # $node_data{version} will be zero if this version was deleted.
1341             push @history, {
1342             version => CGI->escapeHTML( $version ),
1343             modified => CGI->escapeHTML( $node_data{last_modified} ),
1344             username => CGI->escapeHTML( $node_data{metadata}{username}[0] ),
1345             comment => OpenGuides::Utils::parse_change_comment(
1346             CGI->escapeHTML( $node_data{metadata}{comment}[0] ),
1347             $self->config->script_name . '?',
1348             ),
1349 4 50       5735 } if $node_data{version};
1350             }
1351 4         12 @history = reverse @history;
1352 4         38 my %tt_vars = (
1353             node => $node,
1354             version => $curr_version,
1355             not_deletable => 1,
1356             not_editable => 1,
1357             deter_robots => 1,
1358             history => \@history
1359             );
1360 4 50       18 return %tt_vars if $args{return_tt_vars};
1361 4         43 my $output = $self->process_template(
1362             id => $node,
1363             template => "node_history.tt",
1364             tt_vars => \%tt_vars,
1365             );
1366 4 50       4058 return $output if $return_output;
1367 0         0 print $output;
1368             }
1369              
1370             =item B
1371              
1372             Fetch the OpenGuides feed object, and the output content type, for the
1373             supplied feed type.
1374              
1375             Handles all the setup for the OpenGuides feed object.
1376              
1377             =cut
1378              
1379             sub get_feed_and_content_type {
1380 8     8 1 18 my ($self, $feed_type) = @_;
1381              
1382 8         31 my $feed = OpenGuides::Feed->new(
1383             wiki => $self->wiki,
1384             config => $self->config,
1385             og_version => $VERSION,
1386             );
1387              
1388 8         38 my $content_type = $feed->default_content_type($feed_type);
1389              
1390 8         26 return ($feed, $content_type);
1391             }
1392              
1393             =item B
1394              
1395             # Last ten non-minor edits to Hammersmith pages in RSS 1.0 format
1396             $guide->display_feed(
1397             feed_type => 'rss',
1398             feed_listing => 'recent_changes',
1399             items => 10,
1400             ignore_minor_edits => 1,
1401             locale => "Hammersmith",
1402             );
1403              
1404             # All edits bob has made to pub pages in the last week in Atom format
1405             $guide->display_feed(
1406             feed_type => 'atom',
1407             feed_listing => 'recent_changes',
1408             days => 7,
1409             username => "bob",
1410             category => "Pubs",
1411             );
1412              
1413             C is a mandatory parameter. Supported values at present are
1414             "rss" and "atom".
1415              
1416             C is a mandatory parameter. Supported values at present
1417             are "recent_changes". (More values are coming soon though!)
1418              
1419             As with other methods, the C parameter can be used to
1420             return the output instead of printing it to STDOUT.
1421              
1422             =cut
1423              
1424             sub display_feed {
1425 6     6 1 28497 my ($self, %args) = @_;
1426              
1427 6         17 my $feed_type = $args{feed_type};
1428 6 50       26 croak "No feed type given" unless $feed_type;
1429              
1430 6         14 my $feed_listing = $args{feed_listing};
1431 6 50       19 croak "No feed listing given" unless $feed_listing;
1432              
1433 6 50       24 my $return_output = $args{return_output} ? 1 : 0;
1434              
1435             # Basic criteria, whatever the feed listing type is
1436 6         30 my %criteria = (
1437             feed_type => $feed_type,
1438             feed_listing => $feed_listing,
1439             also_return_timestamp => 1,
1440             );
1441              
1442             # Feed listing specific criteria
1443 6 100       32 if($feed_listing eq "recent_changes") {
    50          
1444 2   50     10 $criteria{items} = $args{items} || "";
1445 2   50     16 $criteria{days} = $args{days} || "";
1446 2 50       6 $criteria{ignore_minor_edits} = $args{ignore_minor_edits} ? 1 : 0;
1447              
1448 2   50     9 my $username = $args{username} || "";
1449 2   50     11 my $category = $args{category} || "";
1450 2   50     13 my $locale = $args{locale} || "";
1451              
1452 2         4 my %filter;
1453 2 50       8 $filter{username} = $username if $username;
1454 2 50       7 $filter{category} = $category if $category;
1455 2 50       8 $filter{locale} = $locale if $locale;
1456 2 50       8 if ( scalar keys %filter ) {
1457 2         8 $criteria{filter_on_metadata} = \%filter;
1458             }
1459             }
1460             elsif($feed_listing eq "node_all_versions") {
1461 4         11 $criteria{name} = $args{name};
1462             }
1463              
1464              
1465             # Get the feed object, and the content type
1466 6         25 my ($feed,$content_type) = $self->get_feed_and_content_type($feed_type);
1467              
1468 6         15 my $output = "Content-Type: ".$content_type;
1469 6 50       18 if($self->config->http_charset) {
1470 6         65 $output .= "; charset=".$self->config->http_charset;
1471             }
1472 6         59 $output .= "\n";
1473              
1474             # Get the feed, and the timestamp, in one go
1475 6         35 my ($feed_output, $feed_timestamp) =
1476             $feed->make_feed( %criteria );
1477 6         1006 my $maker = $feed->fetch_maker($feed_type);
1478              
1479 6         26 $output .= "Last-Modified: " . ($maker->parse_feed_timestamp($feed_timestamp))->strftime('%a, %d %b %Y %H:%M:%S +0000') . "\n\n";
1480 6         333 $output .= $feed_output;
1481              
1482 6 50       115 return $output if $return_output;
1483 0         0 print $output;
1484             }
1485              
1486             =item B
1487              
1488             print $guide->display_about(format => "rdf");
1489              
1490             Displays static 'about' information in various format. Defaults to HTML.
1491              
1492             =cut
1493              
1494             sub display_about {
1495 3     3 1 961 my ($self, %args) = @_;
1496              
1497 3         5 my $output;
1498              
1499 3 100 100     27 if ($args{format} && $args{format} =~ /^rdf$/i) {
    100 66        
1500 1         7 $output = qq{Content-Type: application/rdf+xml
1501              
1502            
1503            
1504             xmlns:rdf = "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
1505             xmlns:foaf = "http://xmlns.com/foaf/0.1/">
1506            
1507             OpenGuides
1508              
1509             2003-04-29
1510              
1511            
1512             A wiki engine for collaborative description of places with specialised
1513             geodata metadata features.
1514            
1515              
1516            
1517             OpenGuides is a collaborative wiki environment, written in Perl, for
1518             building guides and sharing information, as both human-readable text
1519             and RDF. The engine contains a number of geodata-specific metadata
1520             mechanisms such as locale search, node classification and integration
1521             with Google Maps.
1522            
1523              
1524            
1525            
1526            
1527              
1528            
1529            
1530             Dominic Hargreaves
1531            
1532            
1533            
1534              
1535            
1536            
1537            
1538            
1539            
1540            
1541              
1542            
1543            
1544             $VERSION
1545            
1546            
1547              
1548            
1549              
1550            
1551            
1552              
1553            
1554            
1555              
1556            
1557              
1558             };
1559             } elsif ($args{format} && $args{format} eq 'opensearch') {
1560 1         4 my $site_name = $self->config->site_name;
1561 1         11 my $search_url = $self->config->script_url . 'search.cgi';
1562 1         5 my $contact_email = $self->config->contact_email;
1563 1         15 $output = qq{Content-Type: application/opensearchdescription+xml; charset=utf-8
1564              
1565            
1566              
1567            
1568             $site_name
1569             Search the site '$site_name'
1570             $site_name
1571             $contact_email
1572            
1573             template="$search_url?search={searchTerms};format=atom"/>
1574            
1575             template="$search_url?search={searchTerms};format=rss"/>
1576            
1577             template="$search_url?search={searchTerms}"/>
1578            
1579             };
1580             } else {
1581 1         3 my $site_name = $self->config->{site_name};
1582 1         3 my $script_name = $self->config->{script_name};
1583 1         19 $output = qq{Content-Type: text/html; charset=utf-8
1584              
1585            
1586            
1587             About $site_name
1588            
1597            
1598             type="application/rdf+xml"
1599             title="DOAP (Description Of A Project) profile for this site's software"
1600             href="$script_name?action=about;format=rdf" />
1601            
1602            
1603            
1604            
1605            
1606             src="http://openguides.org/img/logo.png" alt="OpenGuides">
1607            

$site_name

1608            

is powered by OpenGuides -

1609             the guides made by you.
1610            

version $VERSION

1611            
1612            
1613            

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

1625            

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

1634            

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

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