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   473904 use strict;
  92         146  
  92         2334  
3              
4 92     92   264 use Carp "croak";
  92         93  
  92         3734  
5 92     92   55984 use CGI;
  92         1574842  
  92         386  
6 92     92   46129 use Wiki::Toolkit::Plugin::Diff;
  92         1661498  
  92         2424  
7 92     92   32312 use Wiki::Toolkit::Plugin::Locator::Grid;
  92         56220  
  92         2005  
8 92     92   32532 use OpenGuides::CGI;
  92         152  
  92         2088  
9 92     92   31240 use OpenGuides::Feed;
  92         206  
  92         502  
10 92     92   31501 use OpenGuides::Template;
  92         175  
  92         2355  
11 92     92   35213 use OpenGuides::Utils;
  92         221  
  92         2569  
12 92     92   458 use Time::Piece;
  92         114  
  92         710  
13 92     92   5308 use URI::Escape;
  92         118  
  92         4190  
14              
15 92     92   322 use vars qw( $VERSION );
  92         119  
  92         674483  
16              
17             $VERSION = '0.82';
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 907262 my ($class, %args) = @_;
45 113         260 my $self = {};
46 113         262 bless $self, $class;
47 113         1081 my $wiki = OpenGuides::Utils->make_wiki_object( config => $args{config} );
48 113         448 $self->{wiki} = $wiki;
49 113         276 $self->{config} = $args{config};
50              
51 113         416 my $geo_handler = $self->config->geo_handler;
52 113         802 my $locator;
53 113 100       413 if ( $geo_handler == 1 ) {
    100          
54 99         1011 $locator = Wiki::Toolkit::Plugin::Locator::Grid->new(
55             x => "os_x", y => "os_y" );
56             } elsif ( $geo_handler == 2 ) {
57 4         48 $locator = Wiki::Toolkit::Plugin::Locator::Grid->new(
58             x => "osie_x", y => "osie_y" );
59             } else {
60 10         179 $locator = Wiki::Toolkit::Plugin::Locator::Grid->new(
61             x => "easting", y => "northing" );
62             }
63 113         2247 $wiki->register_plugin( plugin => $locator );
64 113         6469 $self->{locator} = $locator;
65              
66 113         964 my $differ = Wiki::Toolkit::Plugin::Diff->new;
67 113         4912 $wiki->register_plugin( plugin => $differ );
68 113         3797 $self->{differ} = $differ;
69              
70 113 100       304 if($self->config->ping_services) {
71 1         8 eval {
72 1         5 require Wiki::Toolkit::Plugin::Ping;
73             };
74              
75 1 50       2 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         17 my %well_known = Wiki::Toolkit::Plugin::Ping->well_known;
81 1         6 my %services;
82 1         2 foreach my $s (@ws) {
83 3 100       5 if($well_known{$s}) {
84 2         4 $services{$s} = $well_known{$s};
85             } else {
86 1         68 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         10 . $self->{config}->{script_name} . '?$node',
92             services => \%services
93             );
94 1         44 $wiki->register_plugin( plugin => $ping );
95             }
96             }
97              
98 113         1206 return $self;
99             }
100              
101             =item B
102              
103             An accessor, returns the underlying L object.
104              
105             =cut
106              
107             sub wiki {
108 2164     2164 1 19133 my $self = shift;
109 2164         5150 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 3212     3212 1 21714 my $self = shift;
120 3212         9845 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 1829 my $self = shift;
131 7         27 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 8 my $self = shift;
142 4         34 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 107     107 1 901507 my ($self, %args) = @_;
202 107   100     488 my $return_output = $args{return_output} || 0;
203 107         273 my $intercept_redirect = $args{intercept_redirect};
204             my $noheaders = ( $return_output && !$intercept_redirect
205 107   66     997 && $args{noheaders} );
206 107         199 my $version = $args{version};
207 107   66     468 my $id = $args{id} || $self->config->home_name;
208 107         479 my $wiki = $self->wiki;
209 107         355 my $config = $self->config;
210 107   50     552 my $oldid = $args{oldid} || '';
211 107 100       326 my $do_redirect = defined($args{redirect}) ? $args{redirect} : 1;
212              
213 107         148 my %tt_vars;
214              
215             # If we can, check to see if requesting host is blacklisted.
216 107         433 my $host_checker = $config->host_checker_module;
217 107         952 my $is_blacklisted;
218 107 100       308 if ( $host_checker ) {
219 1         2 eval {
220 1         57 eval "require $host_checker";
221 1         12 $is_blacklisted = $host_checker->blacklisted_host(CGI->new->remote_host);
222             };
223             }
224              
225 107 100       550 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       879 return $output if $return_output;
236 0         0 print $output;
237 0         0 return;
238             }
239              
240 106         255 $tt_vars{home_name} = $self->config->home_name;
241              
242 106 100       1028 if ( $id =~ /^(Category|Locale) (.*)$/ ) {
243 12         29 my $type = $1;
244 12         23 $tt_vars{is_indexable_node} = 1;
245 12         40 $tt_vars{index_type} = lc($type);
246 12         21 $tt_vars{index_value} = $2;
247 12         39 $tt_vars{"rss_".lc($type)."_url"} =
248             $config->script_name . "?action=rc;format=rss;"
249             . lc($type) . "=" . lc(CGI->escape($2));
250 12         348 $tt_vars{"atom_".lc($type)."_url"} =
251             $config->script_name . "?action=rc;format=atom;"
252             . lc($type) . "=" . lc(CGI->escape($2));
253             }
254              
255 106         745 my %current_data = $wiki->retrieve_node( $id );
256 106         110937 my $current_version = $current_data{version};
257 106 50 66     427 undef $version if ($version && $version == $current_version);
258 106         259 my %criteria = ( name => $id );
259 106 100       263 $criteria{version} = $version if $version; # retrieve_node default is current
260              
261 106         384 my %node_data = $wiki->retrieve_node( %criteria );
262              
263             # Fixes passing undefined values to Text::Wikiformat if node doesn't exist.
264 106         86382 my $content = '';
265 106 100       367 if ($node_data{content}) {
266 89         381 $content = $wiki->format($node_data{content});
267             }
268              
269 106         507939 my $modified = $node_data{last_modified};
270 106         201 my $moderated = $node_data{moderated};
271 106         158 my %metadata = %{$node_data{metadata}};
  106         870  
272              
273             my ($wgs84_long, $wgs84_lat) = OpenGuides::Utils->get_wgs84_coords(
274             longitude => $metadata{longitude}[0],
275 106         1129 latitude => $metadata{latitude}[0],
276             config => $config);
277 106 50 33     465 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 106         872 );
288              
289 106         549 my $node_exists = $wiki->node_exists($id);
290 106 100       91725 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 106         938 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 106 100       3658 $tt_vars{'deter_robots'} = 1 if $args{version};
310              
311 106 100 100     349 if ( $config->show_gmap_in_node_display
312             && $self->get_cookie( "display_google_maps" ) ) {
313 93         188 $tt_vars{display_google_maps} = 1;
314             }
315              
316             my $redirect = OpenGuides::Utils->detect_redirect(
317 106         555 content => $node_data{content} );
318 106 100       367 if ( $redirect ) {
319             # Don't redirect if the parameter "redirect" is given as 0.
320 3 100 33     12 if ($do_redirect == 0) {
    50 33        
321 1         5 $tt_vars{current} = 1;
322 1 50       6 return %tt_vars if $args{return_tt_vars};
323 1         7 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       1189 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       912 if ( $return_output ) {
334 2 50       4 if ( $intercept_redirect ) {
335 2         9 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 103 100       319 $tt_vars{current} = 1 unless $version;
350              
351 103 100       385 if ($id eq "RecentChanges") {
    100          
352 2         7 $self->display_recent_changes(%args);
353             } elsif ( $id eq $self->config->home_name ) {
354 16 100       126 if ( $self->config->recent_changes_on_home_page ) {
355 15         172 my @recent = $wiki->list_recent_changes(
356             last_n_changes => 10,
357             metadata_was => { edit_type => "Normal edit" },
358             );
359 15         18934 my $base_url = $config->script_name . '?';
360             @recent = map {
361 15         135 {
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         322 . CGI->escape($wiki->formatter->node_name_to_node_param($_->{name}))
374             }
375             } @recent;
376 15         1113 $tt_vars{recent_changes} = \@recent;
377             }
378 16 100       110 return %tt_vars if $args{return_tt_vars};
379 15         74 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       9131 return $output if $return_output;
387 0         0 print $output;
388             } else {
389 85 100       985 return %tt_vars if $args{return_tt_vars};
390 77         367 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 77 50       84061 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 1341 my ( $self, %args ) = @_;
426 7         13 my $wiki = $self->wiki;
427 7         10 my $config = $self->config;
428              
429 7         6 my ( @catnodes, @locnodes, @nodes );
430 7 100       17 if ( $args{category} ) {
431             @catnodes = $wiki->list_nodes_by_metadata(
432             metadata_type => "category",
433             metadata_value => $args{category},
434 3         11 ignore_case => 1,
435             );
436             }
437 7 100       937 if ( $args{locale} ) {
438             @locnodes = $wiki->list_nodes_by_metadata(
439             metadata_type => "locale",
440             metadata_value => $args{locale},
441 3         12 ignore_case => 1,
442             );
443             }
444              
445 7 100 66     721 if ( $args{category} && $args{locale} ) {
    100          
    100          
446             # If we have both category and locale, return the intersection.
447 2         2 my %count;
448 2         4 foreach my $node ( @catnodes, @locnodes ) {
449 4         6 $count{$node}++;
450             }
451 2         5 foreach my $node ( keys %count ) {
452 3 100       8 push @nodes, $node if $count{$node} > 1;
453             }
454             } elsif ( $args{category} ) {
455 1         2 @nodes = @catnodes;
456             } elsif ( $args{locale} ) {
457 1         2 @nodes = @locnodes;
458             } else {
459 3         65 @nodes = $wiki->list_all_nodes();
460             }
461              
462 7         622 my $omit_cats = $config->random_page_omits_categories;
463 7         56 my $omit_locs = $config->random_page_omits_locales;
464              
465 7 100 100     56 if ( $omit_cats || $omit_locs ) {
466 2         3 my %all_nodes = map { $_ => $_ } @nodes;
  6         12  
467 2 100       7 if ( $omit_cats ) {
468 1         3 my @cats = $wiki->list_nodes_by_metadata(
469             metadata_type => "category",
470             metadata_value => "category",
471             ignore_case => 1,
472             );
473 1         226 foreach my $omit ( @cats ) {
474 1         3 delete $all_nodes{$omit};
475             }
476             }
477 2 100       6 if ( $omit_locs ) {
478 1         5 my @locs = $wiki->list_nodes_by_metadata(
479             metadata_type => "category",
480             metadata_value => "locales",
481             ignore_case => 1,
482             );
483 1         251 foreach my $omit ( @locs ) {
484 1         3 delete $all_nodes{$omit};
485             }
486             }
487 2         8 @nodes = keys %all_nodes;
488             }
489 7         19 my $node = $nodes[ rand @nodes ];
490 7         6 my $output;
491              
492 7 100       13 if ( $node ) {
493 6         12 $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         8 $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       2439 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 3303 my ($self, %args) = @_;
533 6   50     27 my $return_output = $args{return_output} || 0;
534 6         15 my $config = $self->config;
535 6         19 my $wiki = $self->wiki;
536 6         12 my $node = $args{id};
537 6         22 my %node_data = $wiki->retrieve_node($node);
538 6         4558 my ($content, $checksum) = @node_data{ qw( content checksum ) };
539 6         50 my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
540              
541 6         28 my $username = $self->get_cookie( "username" );
542 6 50       17 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         50 metadata => $node_data{metadata} );
550              
551 6   50     38 $metadata_vars{website} ||= 'http://';
552 6         27 my $moderate = $wiki->node_required_moderation($node);
553              
554 6         4110 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       1059 $tt_vars{content} = $args{content} if $args{content};
567 6 50       18 $tt_vars{checksum} = $args{checksum} if $args{checksum};
568 6 100       18 if (defined $args{vars}) {
569 1         2 my %supplied_vars = %{$args{vars}};
  1         3  
570 1         2 foreach my $key ( keys %supplied_vars ) {
571 1         2 $tt_vars{$key} = $supplied_vars{$key};
572             }
573             }
574 6 100       18 if (defined $args{metadata}) {
575 1         1 my %supplied_metadata = %{$args{metadata}};
  1         8  
576 1         5 foreach my $key ( keys %supplied_metadata ) {
577 20         18 $tt_vars{$key} = $supplied_metadata{$key};
578             }
579             }
580              
581 6         34 my $output = $self->process_template(
582             id => $node,
583             template => "edit_form.tt",
584             tt_vars => \%tt_vars,
585             );
586 6 50       3377 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 518 my ($self, %args) = @_;
605 1         3 my $node = $args{id};
606 1         2 my $q = $args{cgi_obj};
607 1         2 my $return_output = $args{return_output};
608 1         4 my $wiki = $self->wiki;
609 1         3 my $config = $self->config;
610              
611 1         3 my $content = $q->param('content');
612 1         20 $content =~ s/\r\n/\n/gs;
613 1         3 my $checksum = $q->param('checksum');
614              
615 1         24 my %new_metadata = OpenGuides::Template->extract_metadata_vars(
616             wiki => $wiki,
617             config => $config,
618             cgi_obj => $q,
619             set_coord_field_vars => 1,
620             );
621 1         4 foreach my $var ( qw( username comment edit_type ) ) {
622 3         247 $new_metadata{$var} = $q->escapeHTML(scalar $q->param($var));
623             }
624              
625 1 50       44 if ($wiki->verify_checksum($node, $checksum)) {
626 1         489 my $moderate = $wiki->node_required_moderation($node);
627 1         375 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         71 my $output = $self->process_template(
639             id => $node,
640             template => "edit_form.tt",
641             tt_vars => \%tt_vars,
642             );
643 1 50       702 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 16923 my ($self, %args) = @_;
669 14         34 my $config = $self->config;
670 14         29 my $wiki = $self->wiki;
671              
672 14   100     40 my $from = $ENV{HTTP_REFERER} || "";
673 14         38 my $url_base = $config->script_url . $config->script_name;
674 14 100       160 if ( $from !~ /^$url_base/ ) {
675 12         16 $from = "";
676             }
677              
678 14         47 my %tt_vars = (
679             not_editable => 1,
680             show_form => 1,
681             not_deletable => 1,
682             return_to_url => $from,
683             );
684 14 100       39 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         82 );
693 12 50       6111 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 17761 my ($self, %args) = @_;
708 37         116 my $config = $self->config;
709 37         89 my $wiki = $self->wiki;
710 37         113 my $minor_edits = $self->get_cookie( "show_minor_edits_in_rc" );
711 37   66     166 my $id = $args{id} || $self->config->home_name;
712 37   100     373 my $return_output = $args{return_output} || 0;
713 37         46 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         197 my $q = CGI->new;
717 37   66     6724 my $since = $args{since} || $q->param("since");
718 37 100       383 if ( $since ) {
719 6         8 $tt_vars{since} = $since;
720 6         13 my $t = localtime($since); # overloaded by Time::Piece
721 6         220 $tt_vars{since_string} = $t->strftime;
722 6         98 my %criteria = ( since => $since );
723 6 100       16 $criteria{metadata_was} = { edit_type => "Normal edit" }
724             unless $minor_edits;
725 6         13 my @rc = $self->_get_recent_changes(
726             config => $config, criteria => \%criteria );
727 6 100       15 if ( scalar @rc ) {
728 5         15 $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         42 my %seen;
734 31         125 for my $days ( [0, 1], [1, 7], [7, 14], [14, 30] ) {
735 124         217 my %criteria = ( between_days => $days );
736 124 100       362 $criteria{metadata_was} = { edit_type => "Normal edit" }
737             unless $minor_edits;
738 124         265 my @rc = $self->_get_recent_changes(
739             config => $config, criteria => \%criteria );
740 124         164 my @filtered;
741 124         170 foreach my $node ( @rc ) {
742 54 100       144 next if $seen{$node->{name}};
743 47         71 $seen{$node->{name}}++;
744 47         73 push @filtered, $node;
745             }
746 124 100       360 if ( scalar @filtered ) {
747 35         119 $recent_changes{$days->[1]} = \@filtered;
748             }
749             }
750             }
751 37         110 $tt_vars{not_editable} = 1;
752 37         75 $tt_vars{recent_changes} = \%recent_changes;
753 37         134 my %processing_args = (
754             id => $id,
755             template => "recent_changes.tt",
756             tt_vars => \%tt_vars,
757             );
758 37 100 100     211 if ( !$since && $self->get_cookie("track_recent_changes_views") ) {
759 9         29 my $cookie =
760             OpenGuides::CGI->make_recent_changes_cookie(config => $config );
761 9         20 $processing_args{cookies} = $cookie;
762 9         30 $tt_vars{last_viewed} = OpenGuides::CGI->get_last_recent_changes_visit_from_cookie( config => $config );
763             }
764 37 100       161 return %tt_vars if $args{return_tt_vars};
765 29         122 my $output = $self->process_template( %processing_args );
766 29 50       19655 return $output if $return_output;
767 0         0 print $output;
768             }
769              
770             sub _get_recent_changes {
771 130     130   233 my ( $self, %args ) = @_;
772 130         220 my $wiki = $self->wiki;
773 130         335 my $formatter = $wiki->formatter;
774 130         463 my $config = $self->config;
775 130         120 my %criteria = %{ $args{criteria} };
  130         305  
776              
777 130         343 my @rc = $wiki->list_recent_changes( %criteria );
778 130         87123 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       1214 if ( $criteria{metadata_was} ) {
783 67         61 my %seen;
784             my @filtered;
785 67         92 foreach my $node ( @rc ) {
786 38 100       94 next if $seen{$node->{name}};
787 33         56 $seen{$node->{name}}++;
788 33         39 push @filtered, $node;
789             }
790 67         127 @rc = @filtered;
791             }
792              
793             @rc = map {
794 130         162 my $url = $base_url
795 63         1624 . CGI->escape($formatter->node_name_to_node_param($_->{name}));
796             # CGI->escape escapes commas in URLs. This is annoying.
797 63         1808 $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         202 edit_type => CGI->escapeHTML($_->{metadata}{edit_type}[0]),
810             url => $url
811             }
812             } @rc;
813 130         4207 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 236438 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         18 );
850 4         48812 $diff_vars{not_deletable} = 1;
851 4         9 $diff_vars{not_editable} = 1;
852 4         7 $diff_vars{deter_robots} = 1;
853 4 50       13 return %diff_vars if $args{return_tt_vars};
854             my $output = $self->process_template(
855             id => $args{id},
856 4         21 template => "differences.tt",
857             tt_vars => \%diff_vars
858             );
859 4 50       3239 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 187596 my ($self, %args) = @_;
990 35         117 my $wiki = $self->wiki;
991 35         140 my $formatter = $wiki->formatter;
992 35         165 my $use_leaflet = $self->config->use_leaflet;
993 35         269 my %tt_vars;
994             my @selnodes;
995              
996 35 100 66     152 if ( $args{type} and $args{value} ) {
997 2 50       7 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         8 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     140 my $cat = $args{cat} || "";
1012 33   100     111 my $loc = $args{loc} || "";
1013 33         49 my ( $type, $value, @names, @criteria );
1014 33 100 100     135 if ( !$cat && !$loc ) {
1015 1         5 @selnodes = $wiki->list_all_nodes();
1016             } else {
1017 32         40 my ( @catnodes, @locnodes );
1018 32 100       77 if ( $cat ) {
1019 17         70 @catnodes = $wiki->list_nodes_by_metadata(
1020             metadata_type => "category",
1021             metadata_value => $cat,
1022             ignore_case => 1
1023             );
1024 17         6360 my $name = "Category $cat";
1025 17         144 $name =~ s/(\s\w)/\U$1/g;
1026 17         98 push @criteria, {
1027             type => "category",
1028             value => $cat,
1029             name => $name,
1030             param => $formatter->node_name_to_node_param( $name ),
1031             };
1032 17         441 push @names, $name;
1033             }
1034 32 100       88 if ( $loc ) {
1035 23         94 @locnodes = $wiki->list_nodes_by_metadata(
1036             metadata_type => "locale",
1037             metadata_value => $loc,
1038             ignore_case => 1
1039             );
1040 23         7708 my $name = "Locale $loc";
1041 23         190 $name =~ s/(\s\w)/\U$1/g;
1042 23         131 push @criteria, {
1043             type => "locale",
1044             value => $loc,
1045             name => $name,
1046             param => $formatter->node_name_to_node_param( $name ),
1047             };
1048 23         580 push @names, $name;
1049             }
1050 32 100 100     259 if ( $cat && !$loc ) {
    100 66        
1051 9         20 @selnodes = @catnodes;
1052             } elsif ( $loc && !$cat ) {
1053 15         40 @selnodes = @locnodes;
1054             } else {
1055             # Intersect the category and locale results.
1056 8         16 my %count = ();
1057 8         17 foreach my $node ( @catnodes, @locnodes ) { $count{$node}++; }
  28         41  
1058 8         19 foreach my $node ( keys %count ) {
1059 20 100       47 push @selnodes, $node if $count{$node} > 1;
1060             }
1061             }
1062 32         110 $tt_vars{criteria_title} = join( " and ", @names );
1063 32         70 $tt_vars{criteria} = \@criteria;
1064 32         67 $tt_vars{not_editable} = 1;
1065             }
1066              
1067             $tt_vars{page_description} =
1068             OpenGuides::Utils->get_index_page_description(
1069 33   100     707 format => $args{format} || "",
1070             criteria => \@criteria,
1071             );
1072              
1073 33         75 my $feed_base = $self->config->script_url
1074             . $self->config->script_name . "?action=index";
1075 33         259 foreach my $criterion ( @criteria ) {
1076 40 100       132 if ( $criterion->{type} eq "category" ) {
    50          
1077 17         56 $feed_base .= ";cat=" . lc( $criterion->{value} );
1078             } elsif ( $criterion->{type} eq "locale" ) {
1079 23         67 $feed_base .= ";loc=" . lc( $criterion->{value} );
1080             }
1081             }
1082 33         273 my @dropdowns = OpenGuides::CGI->make_index_form_dropdowns(
1083             guide => $self,
1084             selected => \@criteria );
1085 33         69 $tt_vars{index_form_fields} = \@dropdowns;
1086 33         77 $tt_vars{feed_base} = $feed_base;
1087             }
1088              
1089             my @nodes = map {
1090 33         81 {
1091 62         27079 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         35467 my $nodes_on_map;
1099 33         136 for(my $i=0; $i
1100 62         77 my $node = $nodes[$i];
1101 62 50       124 if($node) {
1102 62         56 my %metadata = %{$node->{node_data}->{metadata}};
  62         474  
1103 62         99 my ($wgs84_long, $wgs84_lat);
1104 62         71 eval {
1105             ($wgs84_long, $wgs84_lat) = OpenGuides::Utils->get_wgs84_coords(
1106             longitude => $metadata{longitude}[0],
1107 62         238 latitude => $metadata{latitude}[0],
1108             config => $self->config);
1109             };
1110 62 50       178 warn $@." on ".$metadata{latitude}[0]." ".$metadata{longitude}[0] if $@;
1111              
1112 62         61 push @{$nodes[$i]->{node_data}->{metadata}->{wgs84_long}}, $wgs84_long;
  62         182  
1113 62         333 push @{$nodes[$i]->{node_data}->{metadata}->{wgs84_lat}}, $wgs84_lat;
  62         133  
1114 62 100       145 if ( $use_leaflet ) {
1115 48 50 100     425 if ( defined $wgs84_lat && $wgs84_lat =~ /^[-.\d]+$/
      66        
      66        
1116             && defined $wgs84_long && $wgs84_long =~ /^[-.\d]+$/ ) {
1117 19         37 $node->{has_geodata} = 1;
1118 19         28 $node->{wgs84_lat} = $wgs84_lat;
1119 19         24 $node->{wgs84_long} = $wgs84_long;
1120 19         77 $nodes_on_map++;
1121             }
1122             }
1123             }
1124             }
1125              
1126 33         72 $tt_vars{nodes} = \@nodes;
1127              
1128 33         38 my ($template, %conf);
1129              
1130 33 100       74 if ( $args{format} ) {
1131 23 100 66     154 if ( $args{format} eq "rdf" ) {
    100          
    50          
    100          
    50          
1132 2         4 $template = "rdf_index.tt";
1133 2         5 $conf{content_type} = "application/rdf+xml";
1134             } elsif ( $args{format} eq "json" ) {
1135 1         3 $template = "json_index.tt";
1136 1         2 $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         37 $tt_vars{display_google_maps} = 1; # override for this page
1142 18 100       44 if ( $use_leaflet ) {
1143 17 100       32 if ( $nodes_on_map ) {
1144             my @points = map {
1145 9         16 { wgs84_lat =>
1146             $_->{node_data}->{metadata}->{wgs84_lat}[0],
1147             wgs84_long =>
1148 29         79 $_->{node_data}->{metadata}->{wgs84_long}[0]
1149             }
1150             } @nodes;
1151 9         39 my %minmaxdata = OpenGuides::Utils->get_wgs84_min_max(
1152             nodes => \@points );
1153 9         95 %tt_vars = ( %tt_vars, %minmaxdata );
1154             } else {
1155 8         18 $tt_vars{no_nodes_on_map} = 1;
1156             }
1157 17         43 $template = "map_index_leaflet.tt";
1158             } else {
1159 1         41 my $q = CGI->new;
1160 1   50     192 $tt_vars{zoom} = $q->param('zoom') || '';
1161 1   50     17 $tt_vars{lat} = $q->param('lat') || '';
1162 1   50     16 $tt_vars{long} = $q->param('long') || '';
1163 1   50     13 $tt_vars{map_type} = $q->param('map_type') || '';
1164 1         13 $tt_vars{centre_long} = $self->config->centre_long;
1165 1         8 $tt_vars{centre_lat} = $self->config->centre_lat;
1166             $tt_vars{default_gmaps_zoom}
1167 1         7 = $self->config->default_gmaps_zoom;
1168 1         9 $tt_vars{enable_gmaps} = 1;
1169 1         3 $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         11 my ($feed,$content_type) = $self->get_feed_and_content_type($feed_type);
1175 2         3 my ($name, $params );
1176 2 50       6 if ( $args{cat} ) {
1177 2         5 $name = "Index of Category $args{cat}";
1178 2         4 $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         7 $feed->set_feed_name_and_url_params( $name, $params );
1184              
1185             # Grab the actual node data out of @nodes
1186 2         2 my @node_data;
1187 2         5 foreach my $node (@nodes) {
1188 4         9 $node->{node_data}->{name} = $node->{name};
1189 4         7 push @node_data, $node->{node_data};
1190             }
1191              
1192 2         6 my $output = "Content-Type: ".$content_type."\n";
1193 2         9 $output .= $feed->build_feed_for_nodes($feed_type, @node_data);
1194              
1195 2 50       42 return $output if $args{return_output};
1196 0         0 print $output;
1197 0         0 return;
1198             }
1199             } else {
1200 10         14 $template = "site_index.tt";
1201             }
1202              
1203 31 100       206 return %tt_vars if $args{return_tt_vars};
1204              
1205 24         90 %conf = (
1206             %conf,
1207             template => $template,
1208             tt_vars => \%tt_vars,
1209             );
1210              
1211 24 50 33     138 if ( $args{return_output} && !$args{intercept_redirect} ) {
1212 24         39 $conf{noheaders} = $args{noheaders};
1213             }
1214              
1215 24         89 my $output = $self->process_template( %conf );
1216 24 50       11796 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   5 my ( $self, %args ) = @_;
1223 2 50 33     8 if ( ( $args{return_output} || $args{return_tt_vars} ) ) {
1224 2 50       3 if ( $args{intercept_redirect} ) {
1225 2         7 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 5683 my ($self, %args) = @_;
1332 4   50     16 my $return_output = $args{return_output} || 0;
1333 4         9 my $node = $args{id};
1334 4         13 my %curr_data = $self->wiki->retrieve_node($node);
1335 4         4166 my $curr_version = $curr_data{version};
1336 4         6 my @history;
1337 4         94 for my $version ( 1 .. $curr_version ) {
1338 4         12 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       3524 } if $node_data{version};
1350             }
1351 4         8 @history = reverse @history;
1352 4         28 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       15 return %tt_vars if $args{return_tt_vars};
1361 4         22 my $output = $self->process_template(
1362             id => $node,
1363             template => "node_history.tt",
1364             tt_vars => \%tt_vars,
1365             );
1366 4 50       2860 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 11 my ($self, $feed_type) = @_;
1381              
1382 8         27 my $feed = OpenGuides::Feed->new(
1383             wiki => $self->wiki,
1384             config => $self->config,
1385             og_version => $VERSION,
1386             );
1387              
1388 8         34 my $content_type = $feed->default_content_type($feed_type);
1389              
1390 8         15 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 18977 my ($self, %args) = @_;
1426              
1427 6         14 my $feed_type = $args{feed_type};
1428 6 50       19 croak "No feed type given" unless $feed_type;
1429              
1430 6         11 my $feed_listing = $args{feed_listing};
1431 6 50       16 croak "No feed listing given" unless $feed_listing;
1432              
1433 6 50       18 my $return_output = $args{return_output} ? 1 : 0;
1434              
1435             # Basic criteria, whatever the feed listing type is
1436 6         21 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       23 if($feed_listing eq "recent_changes") {
    50          
1444 2   50     9 $criteria{items} = $args{items} || "";
1445 2   50     14 $criteria{days} = $args{days} || "";
1446 2 50       7 $criteria{ignore_minor_edits} = $args{ignore_minor_edits} ? 1 : 0;
1447              
1448 2   50     7 my $username = $args{username} || "";
1449 2   50     11 my $category = $args{category} || "";
1450 2   50     9 my $locale = $args{locale} || "";
1451              
1452 2         3 my %filter;
1453 2 50       7 $filter{username} = $username if $username;
1454 2 50       6 $filter{category} = $category if $category;
1455 2 50       5 $filter{locale} = $locale if $locale;
1456 2 50       8 if ( scalar keys %filter ) {
1457 2         6 $criteria{filter_on_metadata} = \%filter;
1458             }
1459             }
1460             elsif($feed_listing eq "node_all_versions") {
1461 4         5 $criteria{name} = $args{name};
1462             }
1463              
1464              
1465             # Get the feed object, and the content type
1466 6         19 my ($feed,$content_type) = $self->get_feed_and_content_type($feed_type);
1467              
1468 6         13 my $output = "Content-Type: ".$content_type;
1469 6 50       11 if($self->config->http_charset) {
1470 6         47 $output .= "; charset=".$self->config->http_charset;
1471             }
1472 6         36 $output .= "\n";
1473              
1474             # Get the feed, and the timestamp, in one go
1475 6         28 my ($feed_output, $feed_timestamp) =
1476             $feed->make_feed( %criteria );
1477 6         626 my $maker = $feed->fetch_maker($feed_type);
1478              
1479 6         18 $output .= "Last-Modified: " . ($maker->parse_feed_timestamp($feed_timestamp))->strftime('%a, %d %b %Y %H:%M:%S +0000') . "\n\n";
1480 6         257 $output .= $feed_output;
1481              
1482 6 50       46 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 1060 my ($self, %args) = @_;
1496              
1497 3         4 my $output;
1498              
1499 3 100 100     21 if ($args{format} && $args{format} =~ /^rdf$/i) {
    100 66        
1500 1         5 $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         3 my $site_name = $self->config->site_name;
1561 1         8 my $search_url = $self->config->script_url . 'search.cgi';
1562 1         3 my $contact_email = $self->config->contact_email;
1563 1         9 $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         2 my $site_name = $self->config->{site_name};
1582 1         2 my $script_name = $self->config->{script_name};
1583 1         9 $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       10 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 4069679 my ($self, %args) = @_;
1703 355         667 my $node = $args{id};
1704 355         627 my $q = $args{cgi_obj};
1705 355         489 my $return_output = $args{return_output};
1706 355         822 my $wiki = $self->wiki;
1707 355         757 my $config = $self->config;
1708              
1709 355         1029 my $content = $q->param("content");
1710 355         5634 $content =~ s/\r\n/\n/gs;
1711 355         817 my $checksum = $q->param("checksum");
1712              
1713 355         5951 my %new_metadata = OpenGuides::Template->extract_metadata_vars(
1714             wiki => $wiki,
1715             config => $config,
1716             cgi_obj => $q
1717             );
1718              
1719 355 50       1332 delete $new_metadata{website} if $new_metadata{website} eq 'http://';
1720              
1721 355   100     1045 $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       6773 if $new_metadata{latitude_unmunged};
1727             $new_metadata{longitude} = delete $new_metadata{longitude_unmunged}
1728 355 100       884 if $new_metadata{longitude_unmunged};
1729              
1730 355         711 foreach my $var ( qw( summary username comment edit_type ) ) {
1731 1420   100     15260 $new_metadata{$var} = $q->param($var) || "";
1732             }
1733 355         4896 $new_metadata{host} = $ENV{REMOTE_ADDR};
1734              
1735             # Wiki::Toolkit::Plugin::RSS::ModWiki wants "major_change" to be set.
1736 355 100       1178 $new_metadata{major_change} = ( $new_metadata{edit_type} eq "Normal edit" )
1737             ? 1
1738             : 0;
1739              
1740             # General validation
1741 355         2640 my $fails = OpenGuides::Utils->validate_edit(
1742             cgi_obj => $q
1743             );
1744              
1745 355 100 66     517 if ( scalar @{$fails} or $config->read_only ) {
  355         1955  
1746 1         5 my %vars = (
1747             validate_failed => $fails
1748             );
1749              
1750 1         8 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       13 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         3849 my $spam_detector = $config->spam_detector_module;
1767 354         1940 my $is_spam;
1768 354 100       813 if ( $spam_detector ) {
1769 2         4 eval {
1770 2         188 eval "require $spam_detector";
1771 2         18 $is_spam = $spam_detector->looks_like_spam(
1772             node => $node,
1773             content => $content,
1774             metadata => \%new_metadata,
1775             );
1776             };
1777             }
1778              
1779 354 100       852 if ( $is_spam ) {
1780 1         4 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       631 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         1344 my $needs_moderation = $wiki->node_required_moderation($node);
1797             my $in_moderate_whitelist
1798 353         180433 = OpenGuides::Utils->in_moderate_whitelist($self->config, $new_metadata{host});
1799              
1800 353 100 100     3530 if ( $in_moderate_whitelist or not $needs_moderation ) {
1801 352         1454 $self->_autoCreateCategoryLocale(
1802             id => $node,
1803             metadata => \%new_metadata
1804             );
1805             }
1806              
1807 353         1664177 my $written = $wiki->write_node( $node, $content, $checksum,
1808             \%new_metadata );
1809              
1810 353 100       27900514 if ($written) {
1811 351 100       1484 if ( $needs_moderation ) {
1812 2 100       11 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         14 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         8 eval {
1825 1         8 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       241 warn $@ if $@;
1834             }
1835             }
1836              
1837 351         22177 my $output = $self->redirect_to_node($node);
1838 351 100       132569 return $output if $return_output;
1839 42         13117 print $output;
1840             } else {
1841 2         12 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   8 my ($self, %args) = @_;
1852 2   50     8 my $return_output = $args{return_output} || 0;
1853 2         6 my $config = $self->config;
1854 2         6 my $wiki = $self->wiki;
1855 2         4 my $node = $args{id};
1856 2         3 my $content = $args{content};
1857 2         3 my %new_metadata = %{$args{new_metadata}};
  2         22  
1858              
1859 2         9 my %node_data = $wiki->retrieve_node($node);
1860             my %tt_vars = ( checksum => $node_data{checksum},
1861             new_content => $content,
1862 2         2346 content => $node_data{content} );
1863             my %old_metadata = OpenGuides::Template->extract_metadata_vars(
1864             wiki => $wiki,
1865             config => $config,
1866 2         13 metadata => $node_data{metadata} );
1867             # Make sure we look at all variables.
1868 2         21 my @tmp = (keys %new_metadata, keys %old_metadata );
1869 2         6 my %tmp_hash = map { $_ => 1; } @tmp;
  102         86  
1870 2         16 my @all_vars = keys %tmp_hash;
1871              
1872 2         22 foreach my $mdvar ( keys %new_metadata ) {
1873 46 100 100     190 if ($mdvar eq "locales") {
    100 100        
    100          
1874 2         3 $tt_vars{$mdvar} = $old_metadata{locales};
1875 2         6 $tt_vars{"new_$mdvar"} = $new_metadata{locale};
1876             } elsif ($mdvar eq "categories") {
1877 2         4 $tt_vars{$mdvar} = $old_metadata{categories};
1878 2         5 $tt_vars{"new_$mdvar"} = $new_metadata{category};
1879             } elsif ($mdvar eq "username" or $mdvar eq "comment"
1880             or $mdvar eq "edit_type" ) {
1881 6         8 $tt_vars{$mdvar} = $new_metadata{$mdvar};
1882             } else {
1883 36         39 $tt_vars{$mdvar} = $old_metadata{$mdvar};
1884 36         63 $tt_vars{"new_$mdvar"} = $new_metadata{$mdvar};
1885             }
1886             }
1887              
1888 2         6 $tt_vars{coord_field_1} = $old_metadata{coord_field_1};
1889 2         4 $tt_vars{coord_field_2} = $old_metadata{coord_field_2};
1890 2         2 $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         5 = $new_metadata{$old_metadata{coord_field_1}};
1894             $tt_vars{"new_coord_field_2_value"}
1895 2         4 = $new_metadata{$old_metadata{coord_field_2}};
1896              
1897 2         5 $tt_vars{conflict} = 1;
1898 2 50       6 return %tt_vars if $args{return_tt_vars};
1899 2         10 my $output = $self->process_template(
1900             id => $node,
1901             template => "edit_form.tt",
1902             tt_vars => \%tt_vars,
1903             );
1904 2 50       1162 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   958 my ($self, %args) = @_;
1943              
1944 353         1003 my $wiki = $self->wiki;
1945 353         630 my $id = $args{'id'};
1946 353         731 my %metadata = %{$args{'metadata'}};
  353         3309  
1947              
1948             # Check to make sure all the indexable nodes are created
1949 353         900 my $config = $self->config;
1950 353         1218 my $template_path = $config->template_path;
1951 353   100     2810 my $custom_template_path = $config->custom_template_path || "";
1952 353         5685 my $tt = Template->new( { INCLUDE_PATH =>
1953             "$custom_template_path:$template_path" } );
1954              
1955 353         962561 foreach my $type (qw(Category Locale)) {
1956 706         2056737 my $lctype = lc($type);
1957 706         746 foreach my $index (@{$metadata{$lctype}}) {
  706         3372  
1958 170         1265065 $index =~ s/(.*)/\u$1/;
1959 170         447 my $node = $type . " " . $index;
1960             # Uppercase the node name before checking for existence
1961 170         702 $node = $wiki->formatter->_do_freeupper( $node );
1962 170 100       2157 unless ( $wiki->node_exists($node) ) {
1963 86 100       44651 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         278 my $blurb;
1967 86         479 my %tt_vars = (
1968             index_type => $type,
1969             index_value => $index,
1970             node_name => $node,
1971             );
1972 86         778 my $ok = $tt->process( "custom_autocreate_content.tt",
1973             \%tt_vars, \$blurb );
1974 86 100       24679 if ( !$ok ) {
1975 83         270 $ok = $tt->process( "autocreate_content.tt",
1976             \%tt_vars, \$blurb );
1977             }
1978 86 50       6085 if ( !$ok ) {
1979 0         0 $blurb = "\@INDEX_LINK [[$node]]";
1980             }
1981             $wiki->write_node(
1982 86         751 $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       12 my $node = $args{id} or croak "No node ID supplied for deletion";
2021 2   50     17 my $return_tt_vars = $args{return_tt_vars} || 0;
2022 2   50     8 my $return_output = $args{return_output} || 0;
2023              
2024 2         11 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         5 my $password = $args{password};
2032              
2033 2 50       9 if ($password) {
2034 2 50       9 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         59265 my %check = $self->wiki->retrieve_node( name => $node );
2050 2 50       812 $tt_vars{other_versions_remain} = 1 if $check{version};
2051 2 50       7 return %tt_vars if $return_tt_vars;
2052 2         14 my $output = $self->process_template(
2053             id => $node,
2054             template => "delete_done.tt",
2055             tt_vars => \%tt_vars,
2056             );
2057 2 50       1577 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 184643 my ($self, %args) = @_;
2089 7 50       21 my $node = $args{id} or croak "No node ID supplied for node moderation";
2090 7   50     29 my $return_tt_vars = $args{return_tt_vars} || 0;
2091 7   100     19 my $return_output = $args{return_output} || 0;
2092              
2093             # Get the moderation flag into something sane
2094 7 100 66     59 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         2 $args{moderation_flag} = 1;
2097             } else {
2098 6         8 $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         33 );
2110              
2111 7         8 my $password = $args{password};
2112              
2113 7 100       12 if ($password) {
2114 6 100       13 if ($password ne $self->config->admin_pass) {
2115 1 50       11 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       406 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         34 );
2128 5         25630 my $moderation_flag = "changed";
2129 5 100       14 unless($worked) {
2130 1         2 $moderation_flag = "unknown_node";
2131 1         72 warn("Tried to set moderation status on node '$node', which doesn't exist");
2132             }
2133              
2134             # Send back to the admin interface
2135 5         15 my $script_url = $self->config->script_url;
2136 5         22 my $script_name = $self->config->script_name;
2137 5         37 my $q = CGI->new;
2138 5         827 my $output = $q->redirect( $script_url.$script_name."?action=admin;moderation=".$moderation_flag );
2139 5 100       1396 return $output if $return_output;
2140 3         133 print $output;
2141             }
2142             } else {
2143 1 50       5 return %tt_vars if $return_tt_vars;
2144 1         6 my $output = $self->process_template(
2145             id => $node,
2146             template => "moderate_confirm.tt",
2147             tt_vars => \%tt_vars,
2148             );
2149 1 50       486 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 12 my ($self, %args) = @_;
2172 1 50       5 my $node = $args{id} or croak "No node ID supplied for node moderation";
2173 1 50       3 my $version = $args{version} or croak "No node version supplied for node moderation";
2174 1   50     5 my $return_tt_vars = $args{return_tt_vars} || 0;
2175 1   50     4 my $return_output = $args{return_output} || 0;
2176              
2177             # Set up the TT variables
2178 1         6 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         2 my $password = $args{password};
2188 1 50       2 unless($self->config->moderation_requires_password) {
2189 0         0 $password = $self->config->admin_pass;
2190             }
2191              
2192 1 50       8 if ($password) {
2193 1 50       2 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         7 $self->wiki->moderate_node(
2204             name => $node,
2205             version => $version
2206             );
2207              
2208             # Create any categories or locales for it
2209 1         12978 my %details = $self->wiki->retrieve_node(
2210             name => $node,
2211             version => $version
2212             );
2213             $self->_autoCreateCategoryLocale(
2214             id => $node,
2215 1         1205 metadata => $details{'metadata'}
2216             );
2217              
2218             # Send back to the admin interface
2219 1         44046 my $script_url = $self->config->script_url;
2220 1         2 my $script_name = $self->config->script_name;
2221 1         12 my $q = CGI->new;
2222 1         190 my $output = $q->redirect( $script_url.$script_name."?action=admin;moderation=moderated" );
2223 1 50       309 return $output if $return_output;
2224 1         254 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 45917 my ($self, %args) = @_;
2247 14   100     82 my $return_tt_vars = $args{return_tt_vars} || 0;
2248 14   100     47 my $return_output = $args{return_output} || 0;
2249              
2250 14         138 my $wiki = $self->wiki;
2251 14         26 my $formatter = $self->wiki->formatter;
2252 14         65 my $script_name = $self->config->script_name;
2253 14         142 my $use_leaflet = $self->config->use_leaflet;
2254              
2255             my ( $metadata_type, $metadata_value, $exclude_locales,
2256             $exclude_categories, $format)
2257 14         145 = @args{ qw( metadata_type metadata_value exclude_locales
2258             exclude_categories format ) };
2259 14   100     46 $format ||= "";
2260              
2261 14         15 my @nodes;
2262 14         17 my $done_search = 0;
2263 14         15 my $nodes_on_map;
2264              
2265             # Only search if they supplied at least a metadata type
2266 14 100       34 if($metadata_type) {
2267 10         12 $done_search = 1;
2268 10         46 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         5855 foreach my $node ( sort @all_nodes ) {
2276 29 100 100     91 next if ( $exclude_locales && $node =~ /^Locale / );
2277 28 100 100     85 next if ( $exclude_categories && $node =~ /^Category / );
2278 27         82 my %data = $wiki->retrieve_node( $node );
2279             next if OpenGuides::Utils->detect_redirect(
2280 27 100       25664 content => $data{content} );
2281 23         93 my $node_param = $formatter->node_name_to_node_param( $node );
2282             my %this_node = (
2283             name => $node,
2284             param => $node_param,
2285 23         642 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     93 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         35 longitude => $data{metadata}{longitude}[0],
2294             config => $self->config );
2295 7 100       20 if ( defined $wgs84_lat ) {
2296 4         8 $this_node{has_geodata} = 1;
2297 4         6 $this_node{wgs84_lat} = $wgs84_lat;
2298 4         9 $this_node{wgs84_long} = $wgs84_long;
2299 4         6 $nodes_on_map++;
2300             }
2301             }
2302 23         148 push @nodes, \%this_node;
2303             }
2304             }
2305              
2306             # Set up our TT variables, including the search parameters
2307 14         106 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       37 if ( $format eq "map" ) {
2323 5 100       16 if ( $use_leaflet ) {
2324 4         23 my %minmaxdata = OpenGuides::Utils->get_wgs84_min_max(
2325             nodes => \@nodes );
2326 4 100       13 if ( scalar %minmaxdata ) {
2327 2         21 %tt_vars = ( %tt_vars, %minmaxdata );
2328             }
2329 4         14 $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         10 $tt_vars{show_map} = 1;
2334             }
2335              
2336 14 100       65 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     56 noheaders => $args{noheaders} || 0,
2344             );
2345 10 50       6817 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 5558 my ($self, %args) = @_;
2358              
2359 9   100     46 my $password = $args{password} || '';
2360 9   50     24 my $return_tt_vars = $args{return_tt_vars} || 0;
2361 9   50     35 my $return_output = $args{return_output} || 0;
2362              
2363 9         21 my $wiki = $self->wiki;
2364 9         16 my $formatter = $self->wiki->formatter;
2365 9         41 my $script_name = $self->config->script_name;
2366              
2367 9         79 my ($type,$value);
2368 9 50       24 if($args{'username'}) {
2369 9         20 ($type,$value) = ('username', $args{'username'});
2370             }
2371 9 50       19 if($args{'host'}) {
2372 0         0 ($type,$value) = ('host', $args{'host'});
2373             }
2374 9 50 33     38 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         18 my @user_edits = $self->wiki->list_recent_changes(
2380             since => 1,
2381             metadata_was => { $type => $value },
2382             );
2383              
2384 9 100       10820 if ($password) {
2385 3 50       9 if ($password ne $self->config->admin_pass) {
2386 0         0 croak("Bad password supplied");
2387             } else {
2388             # Delete all these versions
2389 3         29 foreach my $edit (@user_edits) {
2390             $self->wiki->delete_node(
2391             name => $edit->{name},
2392             version => $edit->{version},
2393 4         50582 );
2394             }
2395              
2396             # Grab new list
2397 3         152287 @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         2385 by_type => $type,
2416             by => $value,
2417              
2418             script_name => $script_name
2419             );
2420 9 50       101 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 2490 my ($self, %args) = @_;
2441 2   100     11 my $return_tt_vars = $args{return_tt_vars} || 0;
2442 2   100     6 my $return_output = $args{return_output} || 0;
2443              
2444 2         4 my $wiki = $self->wiki;
2445 2         5 my $formatter = $self->wiki->formatter;
2446 2         7 my $script_name = $self->config->script_name;
2447              
2448             # Grab all the recent nodes
2449 2         17 my @all_nodes = $wiki->list_recent_changes(last_n_changes => 100);
2450              
2451             # Split into nodes, Locales and Categories
2452 2         5397 my @nodes;
2453             my @categories;
2454 0         0 my @locales;
2455 2         4 for my $node (@all_nodes) {
2456             # Add moderation status
2457 10         23 $node->{'moderate'} = $wiki->node_required_moderation($node->{'name'});
2458              
2459             # Make the URLs
2460 10         8398 my $node_param = uri_escape( $formatter->node_name_to_node_param( $node->{'name'} ) );
2461 10         274 $node->{'view_url'} = $script_name . "?id=" . $node_param;
2462 10         18 $node->{'versions_url'} = $script_name .
2463             "?action=list_all_versions;id=" . $node_param;
2464 10         19 $node->{'moderation_url'} = $script_name .
2465             "?action=set_moderation;id=" . $node_param;
2466             $node->{'revert_user_url'} = $script_name . "?action=revert_user" .
2467 10         24 ";username=".$node->{metadata}->{username}->[0];
2468              
2469             # Filter
2470 10 100       34 if($node->{'name'} =~ /^Category /) {
    100          
2471 4         5 $node->{'page_name'} = $node->{'name'};
2472 4         7 $node->{'name'} =~ s/^Category //;
2473 4         8 push @categories, $node;
2474             } elsif($node->{'name'} =~ /^Locale /) {
2475 2         3 $node->{'page_name'} = $node->{'name'};
2476 2         4 $node->{'name'} =~ s/^Locale //;
2477 2         5 push @locales, $node;
2478             } else {
2479 4         7 push @nodes, $node;
2480             }
2481             }
2482              
2483             # Handle completed notice for actions
2484 2         3 my $completed_action = "";
2485 2 50       5 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         10 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       11 return %tt_vars if $return_tt_vars;
2508 1         5 my $output = $self->process_template(
2509             id => "",
2510             template => "admin_home.tt",
2511             tt_vars => \%tt_vars,
2512             );
2513 1 50       447 return $output if $return_output;
2514 0         0 print $output;
2515             }
2516              
2517             sub process_template {
2518 178     178 0 621 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 178         501 );
2529 178 100       500 if ( $args{content_type} ) {
2530 3         5 $output_conf{content_type} = $args{content_type};
2531             }
2532 178         1250 return OpenGuides::Template->output( %output_conf );
2533             }
2534              
2535             # Redirection for legacy URLs.
2536             sub redirect_index_search {
2537 2     2 0 4 my ( $self, %args ) = @_;
2538 2   50     7 my $type = lc( $args{type} || "" );
2539 2   50     5 my $value = lc( $args{value} || "" );
2540 2   100     8 my $format = lc( $args{format} || "" );
2541              
2542 2         3 my $script_url = $self->config->script_url;
2543 2         5 my $script_name = $self->config->script_name;
2544              
2545 2         13 my $url = "$script_url$script_name?action=index";
2546              
2547 2 100       11 if ( $type eq "category" ) {
    50          
2548 1         4 $url .= ";cat=$value";
2549             } elsif ( $type eq "locale" ) {
2550 1         3 $url .= ";loc=$value";
2551             }
2552 2 100       4 if ( $format ) {
2553 1         2 $url .= ";format=$format";
2554             }
2555 2         18 return CGI->redirect( -uri => $url, -status => 301 );
2556             }
2557              
2558             sub redirect_to_node {
2559 359     359 0 886 my ($self, $node, $redirected_from) = @_;
2560              
2561 359         1499 my $script_url = $self->config->script_url;
2562 359         926 my $script_name = $self->config->script_name;
2563 359         3171 my $formatter = $self->wiki->formatter;
2564              
2565 359         2910 my $id = $formatter->node_name_to_node_param( $node );
2566 359         10987 my $oldid;
2567 359 100       1155 $oldid = $formatter->node_name_to_node_param( $redirected_from ) if $redirected_from;
2568              
2569 359         1115 my $redir_param = "$script_url$script_name?";
2570 359 100       941 $redir_param .= 'id=' if $oldid;
2571 359         620 $redir_param .= $id;
2572 359 100       928 $redir_param .= ";oldid=$oldid" if $oldid;
2573              
2574 359         2972 my $q = CGI->new;
2575 359         76218 return $q->redirect( $redir_param );
2576             }
2577              
2578             sub get_cookie {
2579 185     185 0 17712 my $self = shift;
2580 185         402 my $config = $self->config;
2581 185 50       512 my $pref_name = shift or return "";
2582 185         690 my %cookie_data = OpenGuides::CGI->get_prefs_from_cookie(config=>$config);
2583 185         1034 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;