File Coverage

blib/lib/Wiki/Toolkit.pm
Criterion Covered Total %
statement 25 173 14.4
branch 3 82 3.6
condition 0 11 0.0
subroutine 8 36 22.2
pod 29 29 100.0
total 65 331 19.6


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;