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 52     52   223192 use strict;
  52         156  
  52         2051  
4              
5 52     52   322 use vars qw( $VERSION );
  52         108  
  52         4027  
6             $VERSION = '0.86';
7              
8 52     52   329 use Carp qw(croak carp);
  52         110  
  52         3272  
9 52     52   370 use Digest::MD5 "md5_hex";
  52         119  
  52         4550  
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   4247 eval " use Encode ";
  52     52   30430  
  52         555377  
  52         3240  
18 52 50       180816 $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 94 my ($class, @args) = @_;
132 1         3 my $self = {};
133 1         3 bless $self, $class;
134 1 0       6 $self->_init(@args) or return undef;
135 0         0 return $self;
136             }
137              
138             sub _init {
139 1     1   3 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       226 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;