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