blib/lib/CGI/Wiki/Simple.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 7 | 9 | 77.7 |
branch | n/a | ||
condition | n/a | ||
subroutine | 3 | 3 | 100.0 |
pod | n/a | ||
total | 10 | 12 | 83.3 |
line | stmt | bran | cond | sub | pod | time | code | |||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
1 | package CGI::Wiki::Simple; | |||||||||||||||||
2 | ||||||||||||||||||
3 | 13 | 13 | 356835 | use strict; | ||||||||||||||
13 | 37 | |||||||||||||||||
13 | 582 | |||||||||||||||||
4 | ||||||||||||||||||
5 | 13 | 13 | 11844 | use URI::Escape; | ||||||||||||||
13 | 30146 | |||||||||||||||||
13 | 1132 | |||||||||||||||||
6 | 13 | 13 | 7267 | use CGI::Wiki; | ||||||||||||||
0 | ||||||||||||||||||
0 | ||||||||||||||||||
7 | use CGI::Wiki::Simple::NoTemplates; | |||||||||||||||||
8 | ||||||||||||||||||
9 | use base qw[ CGI::Application ]; | |||||||||||||||||
10 | use Class::Delegation | |||||||||||||||||
11 | send => ['retrieve_node', 'retrieve_node_and_checksum', 'verify_checksum', | |||||||||||||||||
12 | 'list_all_nodes', 'list_recent_changes', 'node_exists', 'write_node', 'delete_node', | |||||||||||||||||
13 | 'search_nodes', 'supports_phrase_searches', | |||||||||||||||||
14 | 'format' ], | |||||||||||||||||
15 | to => sub { $_[0]->wiki }, | |||||||||||||||||
16 | ; | |||||||||||||||||
17 | ||||||||||||||||||
18 | use vars qw( $VERSION %magic_node ); | |||||||||||||||||
19 | ||||||||||||||||||
20 | $VERSION = '0.12'; | |||||||||||||||||
21 | ||||||||||||||||||
22 | =head1 NAME | |||||||||||||||||
23 | ||||||||||||||||||
24 | CGI::Wiki::Simple - A simple wiki application using CGI::Application. | |||||||||||||||||
25 | ||||||||||||||||||
26 | =head1 DESCRIPTION | |||||||||||||||||
27 | ||||||||||||||||||
28 | This is an instant wiki. | |||||||||||||||||
29 | ||||||||||||||||||
30 | =head1 SYNOPSIS | |||||||||||||||||
31 | ||||||||||||||||||
32 | =for example begin | |||||||||||||||||
33 | ||||||||||||||||||
34 | use strict; | |||||||||||||||||
35 | use CGI::Wiki::Simple; | |||||||||||||||||
36 | use CGI::Wiki::Simple::Setup; # currently only for SQLite | |||||||||||||||||
37 | ||||||||||||||||||
38 | # Change this to match your setup | |||||||||||||||||
39 | use CGI::Wiki::Store::SQLite; | |||||||||||||||||
40 | CGI::Wiki::Simple::Setup::setup_if_needed( dbname => "mywiki.db", | |||||||||||||||||
41 | dbtype => 'sqlite' ); | |||||||||||||||||
42 | my $store = CGI::Wiki::Store::SQLite->new( dbname => "mywiki.db" ); | |||||||||||||||||
43 | ||||||||||||||||||
44 | my $search = undef; | |||||||||||||||||
45 | my $wiki = CGI::Wiki::Simple->new( TMPL_PATH => "templates", | |||||||||||||||||
46 | PARAMS => { | |||||||||||||||||
47 | store => $store, | |||||||||||||||||
48 | })->run; | |||||||||||||||||
49 | ||||||||||||||||||
50 | =for example end | |||||||||||||||||
51 | ||||||||||||||||||
52 | =head1 EXAMPLE WITHOUT HTML::Template | |||||||||||||||||
53 | ||||||||||||||||||
54 | It might be the case that you don't want to use HTML::Template, | |||||||||||||||||
55 | and in fact, no templates at all. Then you can simple use the | |||||||||||||||||
56 | following example as your wiki, which does not rely on | |||||||||||||||||
57 | HTML::Template to prepare the content : | |||||||||||||||||
58 | ||||||||||||||||||
59 | =for example begin | |||||||||||||||||
60 | ||||||||||||||||||
61 | use strict; | |||||||||||||||||
62 | use CGI::Wiki::Simple::NoTemplates; | |||||||||||||||||
63 | use CGI::Wiki::Store::MySQL; # Change this to match your setup | |||||||||||||||||
64 | ||||||||||||||||||
65 | my $store = CGI::Wiki::Store::MySQL->new( dbname => "test", | |||||||||||||||||
66 | dbuser => "master", | |||||||||||||||||
67 | dbpass => "master" ); | |||||||||||||||||
68 | ||||||||||||||||||
69 | ||||||||||||||||||
70 | my $search = undef; | |||||||||||||||||
71 | my $wiki = CGI::Wiki::Simple::NoTemplates | |||||||||||||||||
72 | ->new( PARAMS => { | |||||||||||||||||
73 | store => $store, | |||||||||||||||||
74 | })->run; | |||||||||||||||||
75 | ||||||||||||||||||
76 | =for example end | |||||||||||||||||
77 | ||||||||||||||||||
78 | =head1 METHODS | |||||||||||||||||
79 | ||||||||||||||||||
80 | =over 4 | |||||||||||||||||
81 | ||||||||||||||||||
82 | =item B |
|||||||||||||||||
83 | ||||||||||||||||||
84 | C |
|||||||||||||||||
85 | If HTML::Template is not available, you'll automagically get a non-templated | |||||||||||||||||
86 | wiki in the subclass CGI::Wiki::Simple::NoTemplates. Note that CGI::Application | |||||||||||||||||
87 | lists HTML::Template as one of its prerequisites but also works without it. | |||||||||||||||||
88 | ||||||||||||||||||
89 | =cut | |||||||||||||||||
90 | ||||||||||||||||||
91 | { | |||||||||||||||||
92 | my $have_html_template; | |||||||||||||||||
93 | BEGIN { eval { require HTML::Template }; $have_html_template = ($@ eq '') }; | |||||||||||||||||
94 | ||||||||||||||||||
95 | sub new { | |||||||||||||||||
96 | my ($class) = shift; | |||||||||||||||||
97 | my $self = $class->SUPER::new(@_); | |||||||||||||||||
98 | ||||||||||||||||||
99 | bless $self, 'CGI::Wiki::Simple::NoTemplates' | |||||||||||||||||
100 | unless ($have_html_template); | |||||||||||||||||
101 | ||||||||||||||||||
102 | $self; | |||||||||||||||||
103 | }; | |||||||||||||||||
104 | }; | |||||||||||||||||
105 | ||||||||||||||||||
106 | =item B |
|||||||||||||||||
107 | ||||||||||||||||||
108 | The C |
|||||||||||||||||
109 | when the application should initialize itself and load all necessary | |||||||||||||||||
110 | parameters. The wiki decides here what to do and loads all needed values | |||||||||||||||||
111 | from the configuration or database respectively. These parameters are | |||||||||||||||||
112 | passed to the wiki via the C |
|||||||||||||||||
113 | C |
|||||||||||||||||
114 | ||||||||||||||||||
115 | =for example begin | |||||||||||||||||
116 | ||||||||||||||||||
117 | my $wiki = CGI::Wiki::Simple | |||||||||||||||||
118 | ->new( PARAMS => { | |||||||||||||||||
119 | header => " My custom header ", |
|||||||||||||||||
120 | store => $store, | |||||||||||||||||
121 | })->run; | |||||||||||||||||
122 | ||||||||||||||||||
123 | =for example end | |||||||||||||||||
124 | ||||||||||||||||||
125 | C |
|||||||||||||||||
126 | ||||||||||||||||||
127 | store => $store | |||||||||||||||||
128 | ||||||||||||||||||
129 | The store entry must be the CGI::Wiki::Store that this wiki resides in. | |||||||||||||||||
130 | ||||||||||||||||||
131 | header => " My own wiki " |
|||||||||||||||||
132 | ||||||||||||||||||
133 | This is the header that gets printed before every node. The default is | |||||||||||||||||
134 | some simplicistic table to contain the wiki content. This is only used | |||||||||||||||||
135 | if you don't use templates, that is, if the wiki C |
|||||||||||||||||
136 | ||||||||||||||||||
137 | footer => " This node was presented by me " |
|||||||||||||||||
138 | ||||||||||||||||||
139 | This is the footer that gets printed after every node. Also only used | |||||||||||||||||
140 | when no (other) templates are in use. | |||||||||||||||||
141 | ||||||||||||||||||
142 | style => "http://www.example.com/style.css", | |||||||||||||||||
143 | ||||||||||||||||||
144 | This is the stylesheet to use with your page. Also, this is only used | |||||||||||||||||
145 | if you don't use templates. The default is no style sheet. | |||||||||||||||||
146 | ||||||||||||||||||
147 | Most of the parameters to the constructor of CGI::Wiki can also be passed | |||||||||||||||||
148 | here and will be passed on to the CGI::Wiki object. | |||||||||||||||||
149 | ||||||||||||||||||
150 | =cut | |||||||||||||||||
151 | ||||||||||||||||||
152 | sub setup { | |||||||||||||||||
153 | my ($self) = @_; | |||||||||||||||||
154 | $self->run_modes( | |||||||||||||||||
155 | preview => 'render_editform', | |||||||||||||||||
156 | display => 'render_display', | |||||||||||||||||
157 | commit => 'render_commit', | |||||||||||||||||
158 | ); | |||||||||||||||||
159 | $self->mode_param( \&decode_runmode ); | |||||||||||||||||
160 | $self->start_mode("display"); | |||||||||||||||||
161 | ||||||||||||||||||
162 | my $q = $self->query; | |||||||||||||||||
163 | #open OUT, ">>", "query.log" | |||||||||||||||||
164 | # or die "Couldn't create query save file : $!"; | |||||||||||||||||
165 | #$q->save(*OUT); | |||||||||||||||||
166 | #close OUT; | |||||||||||||||||
167 | ||||||||||||||||||
168 | my %default_config = ( | |||||||||||||||||
169 | store => $self->param("store"), | |||||||||||||||||
170 | script_name => $q->script_name, | |||||||||||||||||
171 | extended_links => 1, | |||||||||||||||||
172 | implicit_links => 1, | |||||||||||||||||
173 | node_prefix => $q->script_name . '/display/', | |||||||||||||||||
174 | style => "", | |||||||||||||||||
175 | header => "
|
|||||||||||||||||
177 | footer => " |
|||||||||||||||||
178 | ||||||||||||||||||
179 | home | |||||||||||||||||
180 | | Powered by CGI::Wiki::Simple | |||||||||||||||||
181 | | | |||||||||||||||||
182 | ", | |||||||||||||||||
183 | ); | |||||||||||||||||
184 | ||||||||||||||||||
185 | my %args; | |||||||||||||||||
186 | $args{$_} = defined $self->param($_) ? $self->param($_) : $default_config{$_} | |||||||||||||||||
187 | for (keys %default_config); | |||||||||||||||||
188 | ||||||||||||||||||
189 | $self->param( $_ => $args{$_}) | |||||||||||||||||
190 | for qw( script_name ); | |||||||||||||||||
191 | ||||||||||||||||||
192 | for (qw( header footer style )) { | |||||||||||||||||
193 | $self->param("cgi_wiki_simple_$_", $self->param($_) || $args{$_}); | |||||||||||||||||
194 | }; | |||||||||||||||||
195 | ||||||||||||||||||
196 | $self->param(wiki => CGI::Wiki->new(%args)); | |||||||||||||||||
197 | ||||||||||||||||||
198 | # Maybe later add the connection to the database here... | |||||||||||||||||
199 | }; | |||||||||||||||||
200 | ||||||||||||||||||
201 | =item B |
|||||||||||||||||
202 | ||||||||||||||||||
203 | The C |
|||||||||||||||||
204 | program ends. Currently, it does nothing in CGI::Wiki::Simple. | |||||||||||||||||
205 | ||||||||||||||||||
206 | =cut | |||||||||||||||||
207 | ||||||||||||||||||
208 | sub teardown { | |||||||||||||||||
209 | my ($self) = @_; | |||||||||||||||||
210 | # Maybe later add the database disconnect here ... | |||||||||||||||||
211 | }; | |||||||||||||||||
212 | ||||||||||||||||||
213 | =item B |
|||||||||||||||||
214 | ||||||||||||||||||
215 | C |
|||||||||||||||||
216 | The arguments are : | |||||||||||||||||
217 | ||||||||||||||||||
218 | node => 'Node title' | |||||||||||||||||
219 | mode => 'display' # or 'edit' or 'commit' | |||||||||||||||||
220 | ||||||||||||||||||
221 | The default mode is C |
|||||||||||||||||
222 | ||||||||||||||||||
223 | =cut | |||||||||||||||||
224 | ||||||||||||||||||
225 | sub node_url { | |||||||||||||||||
226 | my ($self,%args) = @_; | |||||||||||||||||
227 | $args{mode} = 'display' | |||||||||||||||||
228 | unless exists $args{mode}; | |||||||||||||||||
229 | return $self->param('script_name') . "/$args{mode}/" . uri_escape($args{node}); | |||||||||||||||||
230 | }; | |||||||||||||||||
231 | ||||||||||||||||||
232 | =item B |
|||||||||||||||||
233 | ||||||||||||||||||
234 | C |
|||||||||||||||||
235 | The parameters are : | |||||||||||||||||
236 | ||||||||||||||||||
237 | title => 'Link title' | |||||||||||||||||
238 | target => 'Node name' | |||||||||||||||||
239 | node => 'Node name' # synonymous to target | |||||||||||||||||
240 | mode => 'display' # or 'edit' or 'commit' | |||||||||||||||||
241 | ||||||||||||||||||
242 | If C |
|||||||||||||||||
243 | C |
|||||||||||||||||
244 | is mostly intended for plugins. A possible API change might be a move of | |||||||||||||||||
245 | this function into L |
|||||||||||||||||
246 | ||||||||||||||||||
247 | =cut | |||||||||||||||||
248 | ||||||||||||||||||
249 | sub inside_link { | |||||||||||||||||
250 | my ($self,%args) = @_; | |||||||||||||||||
251 | $args{node} ||= $args{target}; | |||||||||||||||||
252 | $args{title} ||= $args{node}; | |||||||||||||||||
253 | ||||||||||||||||||
254 | "" . HTML::Entities::encode_entities($args{title}) . ""; | |||||||||||||||||
255 | }; | |||||||||||||||||
256 | ||||||||||||||||||
257 | =item B |
|||||||||||||||||
258 | ||||||||||||||||||
259 | This is the accessor method to the contained CGI::Wiki class. | |||||||||||||||||
260 | ||||||||||||||||||
261 | =cut | |||||||||||||||||
262 | ||||||||||||||||||
263 | sub wiki { $_[0]->param("wiki") }; | |||||||||||||||||
264 | ||||||||||||||||||
265 | sub load_tmpl { | |||||||||||||||||
266 | my ($self,$name) = @_; | |||||||||||||||||
267 | my $template = $self->SUPER::load_tmpl( $name, die_on_bad_params => 0 ); | |||||||||||||||||
268 | $template->param($_,$self->param($_)) for qw(node_title cgi_wiki_simple_style script_name node_prefix version content checksum); | |||||||||||||||||
269 | $self->header_props( -title => $self->param("node_title")); | |||||||||||||||||
270 | $template; | |||||||||||||||||
271 | }; | |||||||||||||||||
272 | ||||||||||||||||||
273 | sub load_actions { | |||||||||||||||||
274 | my ($self,$template,%actions) = @_; | |||||||||||||||||
275 | for (keys %actions) { | |||||||||||||||||
276 | $template->param($_, $actions{$_}); | |||||||||||||||||
277 | }; | |||||||||||||||||
278 | }; | |||||||||||||||||
279 | ||||||||||||||||||
280 | sub render { | |||||||||||||||||
281 | my ($self,$templatename,$actions,@params) = @_; | |||||||||||||||||
282 | my $template = $self->load_tmpl($templatename); | |||||||||||||||||
283 | #warn join "+",@$actions; | |||||||||||||||||
284 | $self->load_actions($template, map { $_ => 1 } @$actions ); | |||||||||||||||||
285 | $template->param( $_ => $self->param( $_ )) for @params; | |||||||||||||||||
286 | $template->output; | |||||||||||||||||
287 | }; | |||||||||||||||||
288 | ||||||||||||||||||
289 | sub render_display { | |||||||||||||||||
290 | my ($self) = @_; | |||||||||||||||||
291 | $self->render( "page_display.templ", [ 'preview' ] ); | |||||||||||||||||
292 | }; | |||||||||||||||||
293 | ||||||||||||||||||
294 | sub render_editform { | |||||||||||||||||
295 | my ($self) = @_; | |||||||||||||||||
296 | $self->render( "page_edit.templ", [ 'display','commit' ], qw( content raw ) ); | |||||||||||||||||
297 | }; | |||||||||||||||||
298 | ||||||||||||||||||
299 | sub render_conflict { | |||||||||||||||||
300 | my ($self) = @_; | |||||||||||||||||
301 | $self->render( "page_conflict.templ", [ 'display','commit' ], qw( content raw submitted_content )); | |||||||||||||||||
302 | }; | |||||||||||||||||
303 | ||||||||||||||||||
304 | =item render_commit | |||||||||||||||||
305 | ||||||||||||||||||
306 | Renders either the display page or a page indicating that | |||||||||||||||||
307 | there was a version conflict. | |||||||||||||||||
308 | ||||||||||||||||||
309 | =cut | |||||||||||||||||
310 | ||||||||||||||||||
311 | sub render_commit { | |||||||||||||||||
312 | my ($self) = @_; | |||||||||||||||||
313 | my $q = $self->query; | |||||||||||||||||
314 | my $node = $self->param("node_title"); | |||||||||||||||||
315 | my $submitted_content = $q->param("content"); | |||||||||||||||||
316 | ||||||||||||||||||
317 | $submitted_content =~ s/\r\n/\n/g; | |||||||||||||||||
318 | my $cksum = $q->param("checksum"); | |||||||||||||||||
319 | my $written; | |||||||||||||||||
320 | $written = $self->write_node($node, $submitted_content, $cksum) | |||||||||||||||||
321 | if $cksum; | |||||||||||||||||
322 | ||||||||||||||||||
323 | if ($written || not defined $cksum) { | |||||||||||||||||
324 | $self->header_type("redirect"); | |||||||||||||||||
325 | $self->header_props( -url => $self->node_url( node => $node, mode => 'display' )); | |||||||||||||||||
326 | } else { | |||||||||||||||||
327 | $self->param( submitted_content => $submitted_content ); | |||||||||||||||||
328 | return $self->render_conflict(); | |||||||||||||||||
329 | } | |||||||||||||||||
330 | }; | |||||||||||||||||
331 | ||||||||||||||||||
332 | =item B |
|||||||||||||||||
333 | ||||||||||||||||||
334 | C |
|||||||||||||||||
335 | initializes the following CGI::Application params : | |||||||||||||||||
336 | ||||||||||||||||||
337 | html_node_title | |||||||||||||||||
338 | url_node_title | |||||||||||||||||
339 | node_title | |||||||||||||||||
340 | ||||||||||||||||||
341 | version | |||||||||||||||||
342 | checksum | |||||||||||||||||
343 | content | |||||||||||||||||
344 | raw | |||||||||||||||||
345 | ||||||||||||||||||
346 | =cut | |||||||||||||||||
347 | ||||||||||||||||||
348 | sub decode_runmode { | |||||||||||||||||
349 | my ($self) = @_; | |||||||||||||||||
350 | my $q = $self->query; | |||||||||||||||||
351 | my $node_title = $q->param("node"); | |||||||||||||||||
352 | my $action = $q->param("action"); | |||||||||||||||||
353 | ||||||||||||||||||
354 | # Magic runmode decoding : | |||||||||||||||||
355 | my $runmodes = join "|", map { quotemeta } $self->run_modes; | |||||||||||||||||
356 | if ($q->path_info =~ m!^/($runmodes)/(.*)!) { | |||||||||||||||||
357 | $action = $1; | |||||||||||||||||
358 | $node_title ||= $2; | |||||||||||||||||
359 | $q->param("action",""); | |||||||||||||||||
360 | }; | |||||||||||||||||
361 | $action ||= 'display'; | |||||||||||||||||
362 | $node_title ||= "index"; | |||||||||||||||||
363 | $node_title = uri_unescape($node_title); | |||||||||||||||||
364 | ||||||||||||||||||
365 | $self->param(html_node_title => HTML::Entities::encode_entities($node_title)); | |||||||||||||||||
366 | $self->param(url_node_title => uri_escape($node_title)); | |||||||||||||||||
367 | $self->param(node_title => $node_title); | |||||||||||||||||
368 | ||||||||||||||||||
369 | my (%node,$raw); | |||||||||||||||||
370 | if (exists $CGI::Wiki::Simple::magic_node{$node_title}) { | |||||||||||||||||
371 | eval { %node = $CGI::Wiki::Simple::magic_node{$node_title}->($self,$node_title); }; | |||||||||||||||||
372 | die $@ if $@; | |||||||||||||||||
373 | $self->param(version => $node{version}); | |||||||||||||||||
374 | $self->param(checksum => $node{checksum}); | |||||||||||||||||
375 | $self->param(content => $node{content}); | |||||||||||||||||
376 | } else { | |||||||||||||||||
377 | %node = $self->retrieve_node($node_title); | |||||||||||||||||
378 | $raw = $node{content}; | |||||||||||||||||
379 | $self->param(raw => $raw); | |||||||||||||||||
380 | $self->param(content => $self->format($raw)); | |||||||||||||||||
381 | $self->param(checksum => $node{checksum}); | |||||||||||||||||
382 | }; | |||||||||||||||||
383 | ||||||||||||||||||
384 | $action = "display" | |||||||||||||||||
385 | unless defined $raw; | |||||||||||||||||
386 | ||||||||||||||||||
387 | $action; | |||||||||||||||||
388 | }; | |||||||||||||||||
389 | ||||||||||||||||||
390 | =back | |||||||||||||||||
391 | ||||||||||||||||||
392 | =cut | |||||||||||||||||
393 | ||||||||||||||||||
394 | 1; | |||||||||||||||||
395 | ||||||||||||||||||
396 | =head1 ACKNOWLEDGEMENTS | |||||||||||||||||
397 | ||||||||||||||||||
398 | Many thanks must go to Kate Pugh, for writing L |
|||||||||||||||||
399 | ||||||||||||||||||
400 | =head1 AUTHOR | |||||||||||||||||
401 | ||||||||||||||||||
402 | Max Maischein (corion@cpan.org) | |||||||||||||||||
403 | ||||||||||||||||||
404 | =head1 COPYRIGHT | |||||||||||||||||
405 | ||||||||||||||||||
406 | Copyright (C) 2003 Max Maischein. All Rights Reserved. | |||||||||||||||||
407 | ||||||||||||||||||
408 | This code is free software; you can redistribute it and/or modify it | |||||||||||||||||
409 | under the same terms as Perl itself. | |||||||||||||||||
410 | ||||||||||||||||||
411 | =head1 SEE ALSO | |||||||||||||||||
412 | ||||||||||||||||||
413 | L |