line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Wiki::Toolkit; |
2
|
|
|
|
|
|
|
|
3
|
51
|
|
|
51
|
|
46070
|
use strict; |
|
51
|
|
|
|
|
58
|
|
|
51
|
|
|
|
|
1316
|
|
4
|
|
|
|
|
|
|
|
5
|
51
|
|
|
51
|
|
157
|
use vars qw( $VERSION ); |
|
51
|
|
|
|
|
54
|
|
|
51
|
|
|
|
|
2581
|
|
6
|
|
|
|
|
|
|
$VERSION = '0.85'; |
7
|
|
|
|
|
|
|
|
8
|
51
|
|
|
51
|
|
180
|
use Carp qw(croak carp); |
|
51
|
|
|
|
|
59
|
|
|
51
|
|
|
|
|
2291
|
|
9
|
51
|
|
|
51
|
|
176
|
use Digest::MD5 "md5_hex"; |
|
51
|
|
|
|
|
61
|
|
|
51
|
|
|
|
|
2757
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
# first, detect if Encode is available - it's not under 5.6. If we _are_ |
12
|
|
|
|
|
|
|
# under 5.6, give up - we'll just have to hope that nothing explodes. This |
13
|
|
|
|
|
|
|
# is the current 0.54 behaviour, so that's ok. |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
my $CAN_USE_ENCODE; |
16
|
|
|
|
|
|
|
BEGIN { |
17
|
51
|
|
|
51
|
|
2447
|
eval " use Encode "; |
|
51
|
|
|
51
|
|
23708
|
|
|
51
|
|
|
|
|
353234
|
|
|
51
|
|
|
|
|
2608
|
|
18
|
51
|
50
|
|
|
|
77019
|
$CAN_USE_ENCODE = $@ ? 0 : 1; |
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 NAME |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
Wiki::Toolkit - A toolkit for building Wikis. |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 DESCRIPTION |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
Helps you develop Wikis quickly by taking care of the boring bits for |
28
|
|
|
|
|
|
|
you. You will still need to write some code - this isn't an instant Wiki. |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head1 SYNOPSIS |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# Set up a wiki object with an SQLite storage backend, and an |
33
|
|
|
|
|
|
|
# inverted index/DB_File search backend. This store/search |
34
|
|
|
|
|
|
|
# combination can be used on systems with no access to an actual |
35
|
|
|
|
|
|
|
# database server. |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
my $store = Wiki::Toolkit::Store::SQLite->new( |
38
|
|
|
|
|
|
|
dbname => "/home/wiki/store.db" ); |
39
|
|
|
|
|
|
|
my $indexdb = Search::InvertedIndex::DB::DB_File_SplitHash->new( |
40
|
|
|
|
|
|
|
-map_name => "/home/wiki/indexes.db", |
41
|
|
|
|
|
|
|
-lock_mode => "EX" ); |
42
|
|
|
|
|
|
|
my $search = Wiki::Toolkit::Search::SII->new( |
43
|
|
|
|
|
|
|
indexdb => $indexdb ); |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
my $wiki = Wiki::Toolkit->new( store => $store, |
46
|
|
|
|
|
|
|
search => $search ); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# Do all the CGI stuff. |
49
|
|
|
|
|
|
|
my $q = CGI->new; |
50
|
|
|
|
|
|
|
my $action = $q->param("action"); |
51
|
|
|
|
|
|
|
my $node = $q->param("node"); |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
if ($action eq 'display') { |
54
|
|
|
|
|
|
|
my $raw = $wiki->retrieve_node($node); |
55
|
|
|
|
|
|
|
my $cooked = $wiki->format($raw); |
56
|
|
|
|
|
|
|
print_page(node => $node, |
57
|
|
|
|
|
|
|
content => $cooked); |
58
|
|
|
|
|
|
|
} elsif ($action eq 'preview') { |
59
|
|
|
|
|
|
|
my $submitted_content = $q->param("content"); |
60
|
|
|
|
|
|
|
my $preview_html = $wiki->format($submitted_content); |
61
|
|
|
|
|
|
|
print_editform(node => $node, |
62
|
|
|
|
|
|
|
content => $submitted_content, |
63
|
|
|
|
|
|
|
preview => $preview_html); |
64
|
|
|
|
|
|
|
} elsif ($action eq 'commit') { |
65
|
|
|
|
|
|
|
my $submitted_content = $q->param("content"); |
66
|
|
|
|
|
|
|
my $cksum = $q->param("checksum"); |
67
|
|
|
|
|
|
|
my $written = $wiki->write_node($node, $submitted_content, $cksum); |
68
|
|
|
|
|
|
|
if ($written) { |
69
|
|
|
|
|
|
|
print_success($node); |
70
|
|
|
|
|
|
|
} else { |
71
|
|
|
|
|
|
|
handle_conflict($node, $submitted_content); |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=head1 METHODS |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=over 4 |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=item B |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
# Set up store, search and formatter objects. |
82
|
|
|
|
|
|
|
my $store = Wiki::Toolkit::Store::SQLite->new( |
83
|
|
|
|
|
|
|
dbname => "/home/wiki/store.db" ); |
84
|
|
|
|
|
|
|
my $indexdb = Search::InvertedIndex::DB::DB_File_SplitHash->new( |
85
|
|
|
|
|
|
|
-map_name => "/home/wiki/indexes.db", |
86
|
|
|
|
|
|
|
-lock_mode => "EX" ); |
87
|
|
|
|
|
|
|
my $search = Wiki::Toolkit::Search::SII->new( |
88
|
|
|
|
|
|
|
indexdb => $indexdb ); |
89
|
|
|
|
|
|
|
my $formatter = My::HomeMade::Formatter->new; |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
my $wiki = Wiki::Toolkit->new( |
92
|
|
|
|
|
|
|
store => $store, # mandatory |
93
|
|
|
|
|
|
|
search => $search, # defaults to undef |
94
|
|
|
|
|
|
|
formatter => $formatter # defaults to something suitable |
95
|
|
|
|
|
|
|
); |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
C must be an object of type C and |
98
|
|
|
|
|
|
|
C if supplied must be of type C (though |
99
|
|
|
|
|
|
|
this isn't checked yet - FIXME). If C isn't supplied, it |
100
|
|
|
|
|
|
|
defaults to an object of class L. |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
You can get a searchable Wiki up and running on a system without an |
103
|
|
|
|
|
|
|
actual database server by using the SQLite storage backend with the |
104
|
|
|
|
|
|
|
SII/DB_File search backend - cut and paste the lines above for a quick |
105
|
|
|
|
|
|
|
start, and see L, L, |
106
|
|
|
|
|
|
|
and L when you want to |
107
|
|
|
|
|
|
|
learn the details. |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
C can be any object that behaves in the right way; this |
110
|
|
|
|
|
|
|
essentially means that it needs to provide a C method which |
111
|
|
|
|
|
|
|
takes in raw text and returns the formatted version. See |
112
|
|
|
|
|
|
|
L for a simple example. Note that you can |
113
|
|
|
|
|
|
|
create a suitable object from a sub very quickly by using |
114
|
|
|
|
|
|
|
L like so: |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
my $formatter = Test::MockObject->new(); |
117
|
|
|
|
|
|
|
$formatter->mock( 'format', sub { my ($self, $raw) = @_; |
118
|
|
|
|
|
|
|
return uc( $raw ); |
119
|
|
|
|
|
|
|
} ); |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
I'm not sure whether to put this in the module or not - it'd let you |
122
|
|
|
|
|
|
|
just supply a sub instead of an object as the formatter, but it feels |
123
|
|
|
|
|
|
|
wrong to be using a Test::* module in actual code. |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=cut |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub new { |
128
|
1
|
|
|
1
|
1
|
13
|
my ($class, @args) = @_; |
129
|
1
|
|
|
|
|
3
|
my $self = {}; |
130
|
1
|
|
|
|
|
2
|
bless $self, $class; |
131
|
1
|
0
|
|
|
|
6
|
$self->_init(@args) or return undef; |
132
|
0
|
|
|
|
|
0
|
return $self; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
sub _init { |
136
|
1
|
|
|
1
|
|
3
|
my ($self, %args) = @_; |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
# Check for scripts written with old versions of Wiki::Toolkit |
139
|
1
|
|
|
|
|
3
|
foreach my $obsolete_param ( qw( storage_backend search_backend ) ) { |
140
|
|
|
|
|
|
|
carp "You seem to be using a script written for a pre-0.10 version " |
141
|
|
|
|
|
|
|
. "of Wiki::Toolkit - the $obsolete_param parameter is no longer used. " |
142
|
|
|
|
|
|
|
. "Please read the documentation with 'perldoc Wiki::Toolkit'" |
143
|
2
|
50
|
|
|
|
7
|
if $args{$obsolete_param}; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
1
|
50
|
|
|
|
215
|
croak "No store supplied" unless $args{store}; |
147
|
|
|
|
|
|
|
|
148
|
0
|
|
|
|
|
|
foreach my $k ( qw( store search formatter ) ) { |
149
|
0
|
|
|
|
|
|
$self->{"_".$k} = $args{$k}; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
# Make a default formatter object if none was actually supplied. |
153
|
0
|
0
|
|
|
|
|
unless ( $args{formatter} ) { |
154
|
0
|
|
|
|
|
|
require Wiki::Toolkit::Formatter::Default; |
155
|
|
|
|
|
|
|
# Ensure backwards compatibility - versions prior to 0.11 allowed the |
156
|
|
|
|
|
|
|
# following options to alter the default behaviour of Text::WikiFormat. |
157
|
0
|
|
|
|
|
|
my %config; |
158
|
0
|
|
|
|
|
|
foreach ( qw( extended_links implicit_links allowed_tags |
159
|
|
|
|
|
|
|
macros node_prefix ) ) { |
160
|
0
|
0
|
|
|
|
|
$config{$_} = $args{$_} if defined $args{$_}; |
161
|
|
|
|
|
|
|
} |
162
|
0
|
|
|
|
|
|
$self->{_formatter} = Wiki::Toolkit::Formatter::Default->new( %config ); |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# Make a place to store plugins. |
166
|
0
|
|
|
|
|
|
$self->{_registered_plugins} = [ ]; |
167
|
|
|
|
|
|
|
|
168
|
0
|
|
|
|
|
|
return $self; |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=item B |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
my $content = $wiki->retrieve_node($node); |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# Or get additional data about the node as well. |
176
|
|
|
|
|
|
|
my %node = $wiki->retrieve_node("HomePage"); |
177
|
|
|
|
|
|
|
print "Current Version: " . $node{version}; |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
# Maybe we stored some of our own custom metadata too. |
180
|
|
|
|
|
|
|
my $categories = $node{metadata}{category}; |
181
|
|
|
|
|
|
|
print "Categories: " . join(", ", @$categories); |
182
|
|
|
|
|
|
|
print "Postcode: $node{metadata}{postcode}[0]"; |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
# Or get an earlier version: |
185
|
|
|
|
|
|
|
my %node = $wiki->retrieve_node( name => "HomePage", |
186
|
|
|
|
|
|
|
version => 2, |
187
|
|
|
|
|
|
|
); |
188
|
|
|
|
|
|
|
print $node{content}; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
In scalar context, returns the current (raw Wiki language) contents of |
191
|
|
|
|
|
|
|
the specified node. In list context, returns a hash containing the |
192
|
|
|
|
|
|
|
contents of the node plus additional data: |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=over 4 |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=item B |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=item B |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=item B |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=item B - a reference to a hash containing any caller-supplied |
203
|
|
|
|
|
|
|
metadata sent along the last time the node was written |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=back |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
The C parameter is mandatory. The C parameter is |
208
|
|
|
|
|
|
|
optional and defaults to the newest version. If the node hasn't been |
209
|
|
|
|
|
|
|
created yet, it is considered to exist but be empty (this behaviour |
210
|
|
|
|
|
|
|
might change). |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
B on metadata - each hash value is returned as an array ref, |
213
|
|
|
|
|
|
|
even if that type of metadata only has one value. |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
=cut |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
sub retrieve_node { |
218
|
0
|
|
|
0
|
1
|
|
my ($self, @rawargs) = @_; |
219
|
|
|
|
|
|
|
|
220
|
0
|
0
|
|
|
|
|
my %args = scalar @rawargs == 1 ? ( name => $rawargs[0] ) : @rawargs; |
221
|
|
|
|
|
|
|
|
222
|
0
|
|
|
|
|
|
my @plugins = $self->get_registered_plugins; |
223
|
0
|
0
|
|
|
|
|
$args{plugins} = \@plugins if scalar @plugins; |
224
|
|
|
|
|
|
|
|
225
|
0
|
|
|
|
|
|
$self->store->retrieve_node( %args ); |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=item B |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
my $ok = $wiki->moderate_node(name => $node, version => $version); |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
Marks the given version of the node as moderated. If this is the |
233
|
|
|
|
|
|
|
highest moderated version, then update the node's contents to hold |
234
|
|
|
|
|
|
|
this version. |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=cut |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
sub moderate_node { |
239
|
0
|
|
|
0
|
1
|
|
my ($self, %args) = @_; |
240
|
0
|
|
|
|
|
|
my @plugins = $self->get_registered_plugins; |
241
|
0
|
0
|
|
|
|
|
$args{plugins} = \@plugins if scalar @plugins; |
242
|
|
|
|
|
|
|
|
243
|
0
|
|
|
|
|
|
my $ret = $self->store->moderate_node( %args ); |
244
|
0
|
0
|
|
|
|
|
if($ret == -1) { return $ret; } |
|
0
|
|
|
|
|
|
|
245
|
0
|
|
|
|
|
|
return 1; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=item B |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
my $ok = $wiki->set_node_moderation(name => $node, required => $required); |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
Sets if a node requires moderation or not. |
253
|
|
|
|
|
|
|
(Moderation is required when $required is true). |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
When moderation is required, new versions of a node will sit about |
256
|
|
|
|
|
|
|
until they're tagged as moderated, when they will become the new node. |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=cut |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
sub set_node_moderation { |
261
|
0
|
|
|
0
|
1
|
|
my ($self, @args) = @_; |
262
|
0
|
|
|
|
|
|
return $self->store->set_node_moderation( @args ); |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=item B |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
my $ok = $wiki->rename_node(old_name => $old_name, new_name => $new_name, create_new_versions => $create_new_versions ); |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
Renames a node, updating any references to it as required. |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
Uses the internal_links table to identify the nodes that link to this |
272
|
|
|
|
|
|
|
one, and re-writes any wiki links in these to point to the new name. If |
273
|
|
|
|
|
|
|
required, it can mark these updates to other pages as a new version. |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
=cut |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
sub rename_node { |
278
|
0
|
|
|
0
|
1
|
|
my ($self, @argsarray) = @_; |
279
|
0
|
|
|
|
|
|
my %args = @argsarray; |
280
|
0
|
0
|
0
|
|
|
|
if ((scalar @argsarray) == 2 || (scalar @argsarray) == 3) { |
281
|
|
|
|
|
|
|
# Missing keys |
282
|
0
|
|
|
|
|
|
%args = ( |
283
|
|
|
|
|
|
|
old_name => $argsarray[0], |
284
|
|
|
|
|
|
|
new_name => $argsarray[1], |
285
|
|
|
|
|
|
|
create_new_versions => $argsarray[2] |
286
|
|
|
|
|
|
|
); |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
0
|
|
|
|
|
|
my @plugins = $self->get_registered_plugins; |
290
|
0
|
0
|
|
|
|
|
$args{plugins} = \@plugins if scalar @plugins; |
291
|
0
|
|
|
|
|
|
$args{wiki} = $self; |
292
|
|
|
|
|
|
|
|
293
|
0
|
|
|
|
|
|
my $ret = $self->store->rename_node( %args ); |
294
|
|
|
|
|
|
|
|
295
|
0
|
0
|
0
|
|
|
|
if ($ret && $ret == -1) { |
296
|
0
|
|
|
|
|
|
return $ret; |
297
|
|
|
|
|
|
|
} |
298
|
0
|
|
|
|
|
|
return 1; |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
=item B |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
my $ok = $wiki->verify_checksum($node, $checksum); |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
Sees whether your checksum is current for the given node. Returns true |
306
|
|
|
|
|
|
|
if so, false if not. |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
B Be aware that when called directly and without locking, this |
309
|
|
|
|
|
|
|
might not be accurate, since there is a small window between the |
310
|
|
|
|
|
|
|
checking and the returning where the node might be changed, so |
311
|
|
|
|
|
|
|
B rely on it for safe commits; use C for that. It |
312
|
|
|
|
|
|
|
can however be useful when previewing edits, for example. |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
=cut |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
sub verify_checksum { |
317
|
0
|
|
|
0
|
1
|
|
my ($self, @args) = @_; |
318
|
0
|
|
|
|
|
|
$self->store->verify_checksum( @args ); |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
=item B |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
# List all nodes that link to the Home Page. |
324
|
|
|
|
|
|
|
my @links = $wiki->list_backlinks( node => "Home Page" ); |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
=cut |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
sub list_backlinks { |
329
|
0
|
|
|
0
|
1
|
|
my ($self, @args) = @_; |
330
|
0
|
|
|
|
|
|
$self->store->list_backlinks( @args ); |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
=item B |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
# List all nodes that have been linked to from other nodes but don't |
336
|
|
|
|
|
|
|
# yet exist. |
337
|
|
|
|
|
|
|
my @links = $wiki->list_dangling_links; |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
Each node is returned once only, regardless of how many other nodes |
340
|
|
|
|
|
|
|
link to it. |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
=cut |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
sub list_dangling_links { |
345
|
0
|
|
|
0
|
1
|
|
my ($self, @args) = @_; |
346
|
0
|
|
|
|
|
|
$self->store->list_dangling_links( @args ); |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
=item B |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
my @nodes = $wiki->list_all_nodes; |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
Returns a list containing the name of every existing node. The list |
354
|
|
|
|
|
|
|
won't be in any kind of order; do any sorting in your calling script. |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
=cut |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
sub list_all_nodes { |
359
|
0
|
|
|
0
|
1
|
|
my ($self, @args) = @_; |
360
|
0
|
|
|
|
|
|
$self->store->list_all_nodes( @args ); |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
=item B |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
# All documentation nodes. |
366
|
|
|
|
|
|
|
my @nodes = $wiki->list_nodes_by_metadata( |
367
|
|
|
|
|
|
|
metadata_type => "category", |
368
|
|
|
|
|
|
|
metadata_value => "documentation", |
369
|
|
|
|
|
|
|
ignore_case => 1, # optional but recommended (see below) |
370
|
|
|
|
|
|
|
); |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
# All pubs in Hammersmith. |
373
|
|
|
|
|
|
|
my @pubs = $wiki->list_nodes_by_metadata( |
374
|
|
|
|
|
|
|
metadata_type => "category", |
375
|
|
|
|
|
|
|
metadata_value => "Pub", |
376
|
|
|
|
|
|
|
); |
377
|
|
|
|
|
|
|
my @hsm = $wiki->list_nodes_by_metadata( |
378
|
|
|
|
|
|
|
metadata_type => "category", |
379
|
|
|
|
|
|
|
metadata_value => "Hammersmith", |
380
|
|
|
|
|
|
|
); |
381
|
|
|
|
|
|
|
my @results = my_l33t_method_for_ANDing_arrays( \@pubs, \@hsm ); |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
Returns a list containing the name of every node whose caller-supplied |
384
|
|
|
|
|
|
|
metadata matches the criteria given in the parameters. |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
By default, the case-sensitivity of both C and |
387
|
|
|
|
|
|
|
C depends on your database - if it will return rows |
388
|
|
|
|
|
|
|
with an attribute value of "Pubs" when you asked for "pubs", or not. |
389
|
|
|
|
|
|
|
If you supply a true value to the C parameter, then you |
390
|
|
|
|
|
|
|
can be sure of its being case-insensitive. This is recommended. |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
If you don't supply any criteria then you'll get an empty list. |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
This is a really really really simple way of finding things; if you |
395
|
|
|
|
|
|
|
want to be more complicated then you'll need to call the method |
396
|
|
|
|
|
|
|
multiple times and combine the results yourself, or write a plugin. |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
=cut |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
sub list_nodes_by_metadata { |
401
|
0
|
|
|
0
|
1
|
|
my ($self, @args) = @_; |
402
|
0
|
|
|
|
|
|
$self->store->list_nodes_by_metadata( @args ); |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=item B |
406
|
|
|
|
|
|
|
Returns nodes where either the metadata doesn't exist, or is blank |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
Unlike list_nodes_by_metadata(), the metadata value is optional (the |
409
|
|
|
|
|
|
|
metadata type is required). |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
# All nodes missing documentation |
412
|
|
|
|
|
|
|
my @nodes = $store->list_nodes_by_missing_metadata( |
413
|
|
|
|
|
|
|
metadata_type => "category", |
414
|
|
|
|
|
|
|
metadata_value => "documentation", |
415
|
|
|
|
|
|
|
ignore_case => 1, # optional but recommended (see below) |
416
|
|
|
|
|
|
|
); |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
# All nodes which don't have a latitude defined |
419
|
|
|
|
|
|
|
my @nodes = $store->list_nodes_by_missing_metadata( |
420
|
|
|
|
|
|
|
metadata_type => "latitude" |
421
|
|
|
|
|
|
|
); |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
=cut |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
sub list_nodes_by_missing_metadata { |
426
|
0
|
|
|
0
|
1
|
|
my ($self, @args) = @_; |
427
|
0
|
|
|
|
|
|
$self->store->list_nodes_by_missing_metadata( @args ); |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
=item B |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
This is documented in L; see there for |
433
|
|
|
|
|
|
|
parameters and return values. All parameters are passed through |
434
|
|
|
|
|
|
|
directly to the store object, so, for example, |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
my @nodes = $wiki->list_recent_changes( days => 7 ); |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
does exactly the same thing as |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
my @nodes = $wiki->store->list_recent_changes( days => 7 ); |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
=cut |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
sub list_recent_changes { |
445
|
0
|
|
|
0
|
1
|
|
my ($self, @args) = @_; |
446
|
0
|
|
|
|
|
|
$self->store->list_recent_changes( @args ); |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
=item B |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
my @nodes = $wiki->list_unmoderated_nodes(); |
452
|
|
|
|
|
|
|
my @nodes = $wiki->list_unmoderated_nodes( |
453
|
|
|
|
|
|
|
only_where_latest => 1 |
454
|
|
|
|
|
|
|
); |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
$nodes[0]->{'name'} # The name of the node |
457
|
|
|
|
|
|
|
$nodes[0]->{'node_id'} # The id of the node |
458
|
|
|
|
|
|
|
$nodes[0]->{'version'} # The version in need of moderation |
459
|
|
|
|
|
|
|
$nodes[0]->{'moderated_version'} # The newest moderated version |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
Fetches details of all the node versions that require moderation (id, |
462
|
|
|
|
|
|
|
name, version, and latest moderated version). |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
If only_where_latest is set, then only the latest version of nodes where |
465
|
|
|
|
|
|
|
the latest version needs moderating are returned. |
466
|
|
|
|
|
|
|
Otherwise, all node versions (including old ones, and possibly multiple |
467
|
|
|
|
|
|
|
per node) are returned. |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
=cut |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
sub list_unmoderated_nodes { |
472
|
0
|
|
|
0
|
1
|
|
my ($self, @args) = @_; |
473
|
0
|
|
|
|
|
|
$self->store->list_unmoderated_nodes( @args ); |
474
|
|
|
|
|
|
|
} |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
=item B |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
my @versions = $wiki->list_node_all_versions("HomePage"); |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
my @versions = $wiki->list_node_all_versions( |
481
|
|
|
|
|
|
|
name => 'HomePage', |
482
|
|
|
|
|
|
|
with_content => 1, |
483
|
|
|
|
|
|
|
with_metadata => 0 |
484
|
|
|
|
|
|
|
); |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
Returns all the versions of a node, optionally including the content |
487
|
|
|
|
|
|
|
and metadata, as an array of hashes (newest versions first). |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
=cut |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
sub list_node_all_versions { |
492
|
0
|
|
|
0
|
1
|
|
my ($self,@argsarray) = @_; |
493
|
|
|
|
|
|
|
|
494
|
0
|
|
|
|
|
|
my %args; |
495
|
0
|
0
|
|
|
|
|
if(scalar @argsarray == 1) { |
496
|
0
|
|
|
|
|
|
$args{'name'} = $argsarray[0]; |
497
|
|
|
|
|
|
|
} else { |
498
|
0
|
|
|
|
|
|
%args = @argsarray; |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
|
501
|
0
|
|
|
|
|
|
return $self->store->list_node_all_versions(%args); |
502
|
|
|
|
|
|
|
} |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
=item B |
505
|
|
|
|
|
|
|
List the last version of every node before a given date. |
506
|
|
|
|
|
|
|
If no version existed before that date, will return undef for version. |
507
|
|
|
|
|
|
|
Returns a hash of id, name, version and date |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
my @nv = $wiki->list_last_version_before('2007-01-02 10:34:11') |
510
|
|
|
|
|
|
|
foreach my $data (@nv) { |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
=cut |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
sub list_last_version_before { |
517
|
0
|
|
|
0
|
1
|
|
my ($self,@argsarray) = @_; |
518
|
0
|
|
|
|
|
|
return $self->store->list_last_version_before(@argsarray); |
519
|
|
|
|
|
|
|
} |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
=item B |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
my $ok = $wiki->node_exists( "Wombat Defenestration" ); |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
# or ignore case - optional but recommended |
526
|
|
|
|
|
|
|
my $ok = $wiki->node_exists( |
527
|
|
|
|
|
|
|
name => "monkey brains", |
528
|
|
|
|
|
|
|
ignore_case => 1, |
529
|
|
|
|
|
|
|
); |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
Returns true if the node has ever been created (even if it is |
532
|
|
|
|
|
|
|
currently empty), and false otherwise. |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
By default, the case-sensitivity of C depends on your |
535
|
|
|
|
|
|
|
store backend. If you supply a true value to the C |
536
|
|
|
|
|
|
|
parameter, then you can be sure of its being case-insensitive. This |
537
|
|
|
|
|
|
|
is recommended. |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
=cut |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
sub node_exists { |
542
|
0
|
|
|
0
|
1
|
|
my ($self, @args) = @_; |
543
|
0
|
|
|
|
|
|
$self->store->node_exists( @args ); |
544
|
|
|
|
|
|
|
} |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
=item B |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
my $needs = $wiki->node_required_moderation( "Wombat Defenestration" ); |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
Returns true if the node exists and requires moderation, and false otherwise. |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
=cut |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
sub node_required_moderation { |
555
|
0
|
|
|
0
|
1
|
|
my ($self, @args) = @_; |
556
|
0
|
|
|
|
|
|
my %node = $self->retrieve_node(@args); |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
# Return false if it doesn't exist |
559
|
0
|
0
|
|
|
|
|
unless(%node) { |
560
|
0
|
|
|
|
|
|
return 0; |
561
|
|
|
|
|
|
|
} |
562
|
0
|
0
|
|
|
|
|
unless($node{node_requires_moderation}) { |
563
|
0
|
|
|
|
|
|
return 0; |
564
|
|
|
|
|
|
|
} |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
# Otherwise return the state of the flag |
567
|
0
|
|
|
|
|
|
return $node{node_requires_moderation}; |
568
|
|
|
|
|
|
|
} |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
=item B |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
$wiki->delete_node( name => "Home Page", version => 15 ); |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
C is optional. If it is supplied then only that version of |
575
|
|
|
|
|
|
|
the node will be deleted. Otherwise the node and all its history will |
576
|
|
|
|
|
|
|
be completely deleted. |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
Doesn't do any locking though - to fix? You probably don't want to let |
579
|
|
|
|
|
|
|
anyone except Wiki admins call this. You may not want to use it at |
580
|
|
|
|
|
|
|
all. |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
Croaks on error, silently does nothing if the node or version doesn't |
583
|
|
|
|
|
|
|
exist, returns true if no error. |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
=cut |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
sub delete_node { |
588
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
589
|
|
|
|
|
|
|
# Backwards compatibility. |
590
|
0
|
0
|
|
|
|
|
my %args = ( scalar @_ == 1 ) ? ( name => $_[0] ) : @_; |
591
|
|
|
|
|
|
|
|
592
|
0
|
|
|
|
|
|
my @plugins = $self->get_registered_plugins; |
593
|
0
|
0
|
|
|
|
|
my $plugins_ref = \@plugins if scalar @plugins; |
594
|
|
|
|
|
|
|
|
595
|
0
|
0
|
|
|
|
|
return 1 unless $self->node_exists( $args{name} ); |
596
|
|
|
|
|
|
|
$self->store->delete_node( |
597
|
|
|
|
|
|
|
name => $args{name}, |
598
|
|
|
|
|
|
|
version => $args{version}, |
599
|
0
|
|
|
|
|
|
wiki => $self, |
600
|
|
|
|
|
|
|
plugins => $plugins_ref, |
601
|
|
|
|
|
|
|
); |
602
|
|
|
|
|
|
|
|
603
|
0
|
0
|
|
|
|
|
if ( my $search = $self->search_obj ) { |
604
|
|
|
|
|
|
|
# Remove old data. |
605
|
0
|
|
|
|
|
|
$search->delete_node( $args{name} ); |
606
|
|
|
|
|
|
|
# If we have any versions left, index the new latest version. |
607
|
0
|
|
|
|
|
|
my %new_current_data = $self->retrieve_node( $args{name } ); |
608
|
|
|
|
|
|
|
# Nonexistent nodes will return blank content. |
609
|
0
|
0
|
|
|
|
|
if ( $new_current_data{content} ) { |
610
|
|
|
|
|
|
|
$search->index_node( $args{name}, $new_current_data{content}, |
611
|
0
|
|
|
|
|
|
$new_current_data{metadata} ); |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
} |
614
|
|
|
|
|
|
|
|
615
|
0
|
|
|
|
|
|
return 1; |
616
|
|
|
|
|
|
|
} |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
=item B |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
# Find all the nodes which contain the word 'expert'. |
621
|
|
|
|
|
|
|
my %results = $wiki->search_nodes('expert'); |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
Returns a (possibly empty) hash whose keys are the node names and |
624
|
|
|
|
|
|
|
whose values are the scores in some kind of relevance-scoring system I |
625
|
|
|
|
|
|
|
haven't entirely come up with yet. For OR searches, this could |
626
|
|
|
|
|
|
|
initially be the number of terms that appear in the node, perhaps. |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
Defaults to AND searches (if $and_or is not supplied, or is anything |
629
|
|
|
|
|
|
|
other than C or C). |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
Searches are case-insensitive. |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
Croaks if you haven't defined a search backend. |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
=cut |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
sub search_nodes { |
638
|
0
|
|
|
0
|
1
|
|
my ($self, @args) = @_; |
639
|
0
|
|
|
|
|
|
my @terms = map { $self->store->charset_encode($_) } @args; |
|
0
|
|
|
|
|
|
|
640
|
0
|
0
|
|
|
|
|
if ( $self->search_obj ) { |
641
|
0
|
|
|
|
|
|
$self->search_obj->search_nodes( @terms ); |
642
|
|
|
|
|
|
|
} else { |
643
|
0
|
|
|
|
|
|
croak "No search backend defined."; |
644
|
|
|
|
|
|
|
} |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
=item B |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
if ( $wiki->supports_phrase_searches ) { |
650
|
|
|
|
|
|
|
return $wiki->search_nodes( '"fox in socks"' ); |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
Returns true if your chosen search backend supports phrase searching, |
654
|
|
|
|
|
|
|
and false otherwise. |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
=cut |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
sub supports_phrase_searches { |
659
|
0
|
|
|
0
|
1
|
|
my ($self, @args) = @_; |
660
|
0
|
0
|
|
|
|
|
$self->search_obj->supports_phrase_searches( @args ) if $self->search_obj; |
661
|
|
|
|
|
|
|
} |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
=item B |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
if ( $wiki->supports_fuzzy_searches ) { |
666
|
|
|
|
|
|
|
return $wiki->fuzzy_title_match( 'Kings Cross, St Pancreas' ); |
667
|
|
|
|
|
|
|
} |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
Returns true if your chosen search backend supports fuzzy title searching, |
670
|
|
|
|
|
|
|
and false otherwise. |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
=cut |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
sub supports_fuzzy_searches { |
675
|
0
|
|
|
0
|
1
|
|
my ($self, @args) = @_; |
676
|
0
|
0
|
|
|
|
|
$self->search_obj->supports_fuzzy_searches( @args ) if $self->search_obj; |
677
|
|
|
|
|
|
|
} |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
=item B |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
B This section of the documentation assumes you are using a |
682
|
|
|
|
|
|
|
search engine which supports fuzzy matching. (See above.) The |
683
|
|
|
|
|
|
|
L backend in particular does not. |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
$wiki->write_node( "King's Cross St Pancras", "A station." ); |
686
|
|
|
|
|
|
|
my %matches = $wiki->fuzzy_title_match( "Kings Cross St. Pancras" ); |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
Returns a (possibly empty) hash whose keys are the node names and |
689
|
|
|
|
|
|
|
whose values are the scores in some kind of relevance-scoring system I |
690
|
|
|
|
|
|
|
haven't entirely come up with yet. |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
Note that even if an exact match is found, any other similar enough |
693
|
|
|
|
|
|
|
matches will also be returned. However, any exact match is guaranteed |
694
|
|
|
|
|
|
|
to have the highest relevance score. |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
The matching is done against "canonicalised" forms of the search |
697
|
|
|
|
|
|
|
string and the node titles in the database: stripping vowels, repeated |
698
|
|
|
|
|
|
|
letters and non-word characters, and lowercasing. |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
Croaks if you haven't defined a search backend. |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
=cut |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
sub fuzzy_title_match { |
705
|
0
|
|
|
0
|
1
|
|
my ($self, @args) = @_; |
706
|
0
|
0
|
|
|
|
|
if ( $self->search_obj ) { |
707
|
0
|
0
|
|
|
|
|
if ($self->search_obj->supports_fuzzy_searches) { |
708
|
0
|
|
|
|
|
|
$self->search_obj->fuzzy_title_match( @args ); |
709
|
|
|
|
|
|
|
} else { |
710
|
0
|
|
|
|
|
|
croak "Search backend doesn't support fuzzy searches"; |
711
|
|
|
|
|
|
|
} |
712
|
|
|
|
|
|
|
} else { |
713
|
0
|
|
|
|
|
|
croak "No search backend defined."; |
714
|
|
|
|
|
|
|
} |
715
|
|
|
|
|
|
|
} |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
=item B |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
my $plugin = Wiki::Toolkit::Plugin::Foo->new; |
720
|
|
|
|
|
|
|
$wiki->register_plugin( plugin => $plugin ); |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
Registers the plugin with the wiki as one that needs to be informed |
723
|
|
|
|
|
|
|
when we write a node. |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
If the plugin C L, calls the methods set up by |
726
|
|
|
|
|
|
|
that parent class to let it know about the backend store, search and |
727
|
|
|
|
|
|
|
formatter objects. |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
Finally, calls the plugin class's C method, which should |
730
|
|
|
|
|
|
|
be used to check tables are set up etc. Note that because of the order |
731
|
|
|
|
|
|
|
these things are done in, C for L |
732
|
|
|
|
|
|
|
subclasses can use the C, C and C |
733
|
|
|
|
|
|
|
methods as it needs to. |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
=cut |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
sub register_plugin { |
738
|
0
|
|
|
0
|
1
|
|
my ($self, %args) = @_; |
739
|
0
|
|
0
|
|
|
|
my $plugin = $args{plugin} || ""; |
740
|
0
|
0
|
|
|
|
|
croak "no plugin supplied" unless $plugin; |
741
|
0
|
0
|
|
|
|
|
if ( $plugin->isa( "Wiki::Toolkit::Plugin" ) ) { |
742
|
0
|
|
|
|
|
|
$plugin->wiki( $self ); |
743
|
0
|
|
|
|
|
|
$plugin->datastore( $self->store ); |
744
|
0
|
|
|
|
|
|
$plugin->indexer( $self->search_obj ); |
745
|
0
|
|
|
|
|
|
$plugin->formatter( $self->formatter ); |
746
|
|
|
|
|
|
|
} |
747
|
0
|
0
|
|
|
|
|
if ( $plugin->can( "on_register" ) ) { |
748
|
0
|
|
|
|
|
|
$plugin->on_register; |
749
|
|
|
|
|
|
|
} |
750
|
0
|
|
|
|
|
|
push @{ $self->{_registered_plugins} }, $plugin; |
|
0
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
} |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
=item B |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
my @plugins = $wiki->get_registered_plugins; |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
Returns an array of plugin objects. |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
=cut |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
sub get_registered_plugins { |
762
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
763
|
0
|
|
|
|
|
|
my $ref = $self->{_registered_plugins}; |
764
|
0
|
0
|
|
|
|
|
return wantarray ? @$ref : $ref; |
765
|
|
|
|
|
|
|
} |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
=item B |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
my $written = $wiki->write_node($node, $content, $checksum, \%metadata, $requires_moderation); |
770
|
|
|
|
|
|
|
if ($written) { |
771
|
|
|
|
|
|
|
display_node($node); |
772
|
|
|
|
|
|
|
} else { |
773
|
|
|
|
|
|
|
handle_conflict(); |
774
|
|
|
|
|
|
|
} |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
Writes the specified content into the specified node in the backend |
777
|
|
|
|
|
|
|
storage; and indexes/reindexes the node in the search indexes (if a |
778
|
|
|
|
|
|
|
search is set up); calls C on any registered plugins. |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
Note that you can blank out a node without deleting it by passing the |
781
|
|
|
|
|
|
|
empty string as $content, if you want to. |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
If you expect the node to already exist, you must supply a checksum, |
784
|
|
|
|
|
|
|
and the node is write-locked until either your checksum has been |
785
|
|
|
|
|
|
|
proved old, or your checksum has been accepted and your change |
786
|
|
|
|
|
|
|
committed. If no checksum is supplied, and the node is found to |
787
|
|
|
|
|
|
|
already exist and be nonempty, a conflict will be raised. |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
The first two parameters are mandatory, the others optional. If you |
790
|
|
|
|
|
|
|
want to supply metadata but have no checksum (for a newly-created |
791
|
|
|
|
|
|
|
node), supply a checksum of C. |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
The final parameter, $requires_moderation (which defaults to false), |
794
|
|
|
|
|
|
|
is ignored except on new nodes. For existing nodes, use |
795
|
|
|
|
|
|
|
$wiki->toggle_node_moderation to change the node moderation flag. |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
Returns the version of the updated node on success, 0 on conflict, croaks on |
798
|
|
|
|
|
|
|
error. |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
B on the metadata hashref: Any data in here that you wish to |
801
|
|
|
|
|
|
|
access directly later must be a key-value pair in which the value is |
802
|
|
|
|
|
|
|
either a scalar or a reference to an array of scalars. For example: |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
$wiki->write_node( "Calthorpe Arms", "nice pub", $checksum, |
805
|
|
|
|
|
|
|
{ category => [ "Pubs", "Bloomsbury" ], |
806
|
|
|
|
|
|
|
postcode => "WC1X 8JR" } ); |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
# and later |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
my @nodes = $wiki->list_nodes_by_metadata( |
811
|
|
|
|
|
|
|
metadata_type => "category", |
812
|
|
|
|
|
|
|
metadata_value => "Pubs" ); |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
For more advanced usage (passing data through to registered plugins) |
815
|
|
|
|
|
|
|
you may if you wish pass key-value pairs in which the value is a |
816
|
|
|
|
|
|
|
hashref or an array of hashrefs. The data in the hashrefs will not be |
817
|
|
|
|
|
|
|
stored as metadata; it will be checksummed and the checksum will be |
818
|
|
|
|
|
|
|
stored instead. Such data can I be accessed via plugins. |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
=cut |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
sub write_node { |
823
|
0
|
|
|
0
|
1
|
|
my ($self, $node, $content, $checksum, $metadata, $requires_moderation) = @_; |
824
|
0
|
0
|
|
|
|
|
croak "No valid node name supplied for writing" unless $node; |
825
|
0
|
0
|
|
|
|
|
croak "No content parameter supplied for writing" unless defined $content; |
826
|
0
|
0
|
|
|
|
|
$checksum = md5_hex("") unless defined $checksum; |
827
|
|
|
|
|
|
|
|
828
|
0
|
|
|
|
|
|
my $formatter = $self->{_formatter}; |
829
|
|
|
|
|
|
|
|
830
|
0
|
|
|
|
|
|
my @links_to; |
831
|
0
|
0
|
|
|
|
|
if ( $formatter->can( "find_internal_links" ) ) { |
832
|
|
|
|
|
|
|
# Supply $metadata to formatter in case it's needed to alter the |
833
|
|
|
|
|
|
|
# behaviour of the formatter, eg for Wiki::Toolkit::Formatter::Multiple. |
834
|
0
|
|
|
|
|
|
my @all_links_to = $formatter->find_internal_links($content,$metadata); |
835
|
0
|
|
|
|
|
|
my %unique = map { $_ => 1 } @all_links_to; |
|
0
|
|
|
|
|
|
|
836
|
0
|
|
|
|
|
|
@links_to = keys %unique; |
837
|
|
|
|
|
|
|
} |
838
|
|
|
|
|
|
|
|
839
|
0
|
|
|
|
|
|
my %data = ( node => $node, |
840
|
|
|
|
|
|
|
content => $content, |
841
|
|
|
|
|
|
|
checksum => $checksum, |
842
|
|
|
|
|
|
|
metadata => $metadata, |
843
|
|
|
|
|
|
|
requires_moderation => $requires_moderation ); |
844
|
0
|
0
|
|
|
|
|
$data{links_to} = \@links_to if scalar @links_to; |
845
|
0
|
|
|
|
|
|
my @plugins = $self->get_registered_plugins; |
846
|
0
|
0
|
|
|
|
|
$data{plugins} = \@plugins if scalar @plugins; |
847
|
|
|
|
|
|
|
|
848
|
0
|
|
|
|
|
|
my $store = $self->store; |
849
|
0
|
0
|
|
|
|
|
my $ret = $store->check_and_write_node( %data ) or return 0; |
850
|
0
|
0
|
|
|
|
|
if($ret == -1) { |
851
|
0
|
|
|
|
|
|
return -1; |
852
|
|
|
|
|
|
|
} |
853
|
|
|
|
|
|
|
|
854
|
0
|
|
|
|
|
|
my $search = $self->{_search}; |
855
|
0
|
0
|
0
|
|
|
|
if ($search and $content) { |
856
|
0
|
|
|
|
|
|
$search->index_node( $node, $store->charset_encode( $content ), |
857
|
|
|
|
|
|
|
$metadata ); |
858
|
|
|
|
|
|
|
} |
859
|
0
|
|
|
|
|
|
return $ret; |
860
|
|
|
|
|
|
|
} |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
=item B |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
my $cooked = $wiki->format($raw, $metadata); |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
Passed straight through to your chosen formatter object. You do not |
867
|
|
|
|
|
|
|
I to supply the C<$metadata> hashref, but if your formatter |
868
|
|
|
|
|
|
|
allows node metadata to affect the rendering of the node then you |
869
|
|
|
|
|
|
|
will want to. |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
=cut |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
sub format { |
874
|
0
|
|
|
0
|
1
|
|
my ( $self, $raw, $metadata ) = @_; |
875
|
0
|
|
|
|
|
|
my $formatter = $self->{_formatter}; |
876
|
|
|
|
|
|
|
# Add on $self to the call so the formatter can access things like whether |
877
|
|
|
|
|
|
|
# a linked-to node exists, etc. |
878
|
0
|
|
|
|
|
|
my $result = $formatter->format( $raw, $self, $metadata ); |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
# Nasty hack to work around an HTML::Parser deficiency |
881
|
|
|
|
|
|
|
# see http://rt.cpan.org/NoAuth/Bug.html?id=7014 |
882
|
0
|
0
|
|
|
|
|
if ($CAN_USE_ENCODE) { |
883
|
0
|
0
|
|
|
|
|
if (Encode::is_utf8($raw)) { |
884
|
0
|
|
|
|
|
|
Encode::_utf8_on( $result ); |
885
|
|
|
|
|
|
|
} |
886
|
|
|
|
|
|
|
} |
887
|
|
|
|
|
|
|
|
888
|
0
|
|
|
|
|
|
return $result; |
889
|
|
|
|
|
|
|
} |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
=item B |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
my $store = $wiki->store; |
894
|
|
|
|
|
|
|
my $dbname = eval { $wiki->store->dbname; } |
895
|
|
|
|
|
|
|
or warn "Not a DB backend"; |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
Returns the storage backend object. |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
=cut |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
sub store { |
902
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
903
|
0
|
|
|
|
|
|
return $self->{_store}; |
904
|
|
|
|
|
|
|
} |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
=item B |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
my $search_obj = $wiki->search_obj; |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
Returns the search backend object. |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
=cut |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
sub search_obj { |
915
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
916
|
0
|
|
|
|
|
|
return $self->{_search}; |
917
|
|
|
|
|
|
|
} |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
=item B |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
my $formatter = $wiki->formatter; |
922
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
Returns the formatter backend object. |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
=cut |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
sub formatter { |
928
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
929
|
0
|
|
|
|
|
|
return $self->{_formatter}; |
930
|
|
|
|
|
|
|
} |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
=back |
933
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
=head1 SEE ALSO |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
For a very quick Wiki startup without any of that icky programming |
937
|
|
|
|
|
|
|
stuff, see Tom Insam's L, an instant wiki based on |
938
|
|
|
|
|
|
|
Wiki::Toolkit. |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
Or for the specialised application of a wiki about a city, see the |
941
|
|
|
|
|
|
|
L distribution. |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
L allows you to use different formatting modules. |
944
|
|
|
|
|
|
|
L might be useful for anyone wanting to write a |
945
|
|
|
|
|
|
|
custom formatter. Existing formatters include: |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
=over 4 |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
=item * L (in this distro) |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
=item * L |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
=item * L |
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
=back |
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
There's currently a choice of three storage backends - all |
958
|
|
|
|
|
|
|
database-backed. |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
=over 4 |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
=item * L (in this distro) |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
=item * L (in this distro) |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
=item * L (in this distro) |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
=item * L (parent class for the above - in this distro) |
969
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
=back |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
A search backend is optional: |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
=over 4 |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
=item * L (in this distro, uses L) |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
=item * L (in this distro, uses L) |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
=back |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
Standalone plugins can also be written - currently they should only |
983
|
|
|
|
|
|
|
read from the backend storage, but write access guidelines are coming |
984
|
|
|
|
|
|
|
soon. Plugins written so far and available from CPAN: |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
=over 4 |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
=item * L |
989
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
=item * L |
991
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
=item * L |
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
=item * L |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
=back |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
If writing a plugin you might want an easy way to run tests for it on |
999
|
|
|
|
|
|
|
all possible backends: |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
=over 4 |
1002
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
=item * L (in this distro) |
1004
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
=back |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
Other ways to implement Wikis in Perl include: |
1008
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
=over 4 |
1010
|
|
|
|
|
|
|
|
1011
|
|
|
|
|
|
|
=item * L (an instant wiki) |
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
=item * L |
1014
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
=item * L |
1016
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
=item * L |
1018
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
=item * UseModWiki L |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
=item * Chiq Chaq L |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
=back |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
=head1 AUTHOR |
1026
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
Kake Pugh (kake@earth.li) and the Wiki::Toolkit team (including Nick Burch |
1028
|
|
|
|
|
|
|
and Dominic Hargreaves) |
1029
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
=head1 SUPPORT |
1031
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
Questions should go to cgi-wiki-dev@earth.li. |
1033
|
|
|
|
|
|
|
|
1034
|
|
|
|
|
|
|
=head1 COPYRIGHT |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
Copyright (C) 2002-2004 Kake Pugh. All Rights Reserved. |
1037
|
|
|
|
|
|
|
Copyright (C) 2006-2013 the Wiki::Toolkit team. All Rights Reserved. |
1038
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
This module is free software; you can redistribute it and/or modify it |
1040
|
|
|
|
|
|
|
under the same terms as Perl itself. |
1041
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
=head1 FEEDBACK |
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
The developer web site and bug tracker is at |
1045
|
|
|
|
|
|
|
http://www.wiki-toolkit.org/ - please file bugs there as appropriate. |
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
You could also subscribe to the dev list at |
1048
|
|
|
|
|
|
|
http://www.earth.li/cgi-bin/mailman/listinfo/cgi-wiki-dev |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
=head1 BUGS |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
Versions between 0.75 and 0.79 inclusive contain a bug which prevents |
1053
|
|
|
|
|
|
|
Recent Changes routines from working correctly if minor changes are excluded |
1054
|
|
|
|
|
|
|
. You may wish to avoid upgrading to |
1055
|
|
|
|
|
|
|
this version until it is fixed if this is important to you; the fix is |
1056
|
|
|
|
|
|
|
however not trivial so noone has been able to step up yet. |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
Other minor bugs are documented at |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
=head1 CREDITS |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
Various London.pm types helped out with code review, encouragement, |
1063
|
|
|
|
|
|
|
JFDI, style advice, code snippets, module recommendations, and so on; |
1064
|
|
|
|
|
|
|
far too many to name individually, but particularly Richard Clamp, |
1065
|
|
|
|
|
|
|
Tony Fisher, Mark Fowler, and Chris Ball. |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
blair christensen sent patches and gave me some good ideas. chromatic |
1068
|
|
|
|
|
|
|
continues to patiently apply my patches to L and |
1069
|
|
|
|
|
|
|
help me get it working in just the way I need. Paul Makepeace helped |
1070
|
|
|
|
|
|
|
me add support for connecting to non-local databases. Shevek has been |
1071
|
|
|
|
|
|
|
prodding me a lot lately. The L team keep me well-supplied |
1072
|
|
|
|
|
|
|
with encouragement and bug reports. |
1073
|
|
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
Nick Burch has been leading the way with development leading up to the |
1075
|
|
|
|
|
|
|
release under the Wiki::Toolkit name. |
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
=head1 GRATUITOUS PLUG |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
I'm only obsessed with Wikis because of the Open Guide to London -- |
1080
|
|
|
|
|
|
|
L |
1081
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
=cut |
1083
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
1; |