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 |
||||||
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 |
||||||
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 |
||||||
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 |
||||||
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 |
||||||
174 | |||||||
175 | Note that if you pass the C |
||||||
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 |
||||||
180 | parameter has no effect if the node isn't a redirect, or if the | ||||||
181 | C |
||||||
182 | |||||||
183 | (At the moment, C |
||||||
184 | parameter was passed.) | ||||||
185 | |||||||
186 | The C |
||||||
187 | and C |
||||||
188 | |||||||
189 | If you have specified the C |
||||||
190 | C |
||||||
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 |
||||||
194 | |||||||
195 | The C |
||||||
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 |
||||||
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 |
||||||
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 |
||||||
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 |
||||||
661 | the output or template variables, instead of printing the output to STDOUT. | ||||||
662 | The C |
||||||
663 | C |
||||||
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 |
||||||
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 |
||||||
889 | C |
||||||
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 |
||||||
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 |
||||||
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 |
||||||
979 | |||||||
980 | The C |
||||||
981 | or if the C |
||||||
982 | |||||||
983 | The C |
||||||
984 | and C |
||||||
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 |
||||||
1252 | C |
||||||
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 |
||||||
1414 | "rss" and "atom". | ||||||
1415 | |||||||
1416 | C |
||||||
1417 | are "recent_changes". (More values are coming soon though!) | ||||||
1418 | |||||||
1419 | As with other methods, the C |
||||||
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 | |
||||||
1508 | |||||||
1509 | |
||||||
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 | |
||||||
1531 | |
||||||
1532 | |||||||
1533 | |||||||
1534 | |||||||
1535 | |
||||||
1536 | |
||||||
1537 | |
||||||
1538 | |
||||||
1539 | |||||||
1540 | |||||||
1541 | |||||||
1542 | |
||||||
1543 | |
||||||
1544 | |
||||||
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 | |
||||||
1569 | |
||||||
1570 | |
||||||
1571 | |
||||||
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 | |
||||||
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 |
||||||
1663 | C |
||||||
1664 | printing the output to STDOUT. | ||||||
1665 | |||||||
1666 | If you have specified the C |
||||||
1667 | C |
||||||
1668 | method of that module to determine whether the edit is spam. If this | ||||||
1669 | method returns true, then the C |
||||||
1670 | used to display an error message. | ||||||
1671 | |||||||
1672 | The C |
||||||
1673 | content and metadata. | ||||||
1674 | |||||||
1675 | The geographical data that you should provide in the L |
||||||
1676 | depends on the handler you chose in C |
||||||
1677 | |||||||
1678 | =over | ||||||
1679 | |||||||
1680 | =item * | ||||||
1681 | |||||||
1682 | B |
||||||
1683 | C |
||||||
1684 | be converted to the other and both sets will be stored. | ||||||
1685 | |||||||
1686 | =item * | ||||||
1687 | |||||||
1688 | B |
||||||
1689 | C |
||||||
1690 | be converted to the other and both sets will be stored. | ||||||
1691 | |||||||
1692 | =item * | ||||||
1693 | |||||||
1694 | B |
||||||
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 |
||||||
2006 | node will be deleted; in other words the node will be entirely | ||||||
2007 | removed. | ||||||
2008 | |||||||
2009 | If C |
||||||
2010 | will be displayed. | ||||||
2011 | |||||||
2012 | As with other methods, parameters C |
||||||
2013 | C |
||||||
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 |
||||||
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 |
||||||
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 |
||||||
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 |
||||||
2600 | |||||||
2601 | =item * The list of live OpenGuides installs at L |
||||||
2602 | |||||||
2603 | =item * L |
||||||
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; |