source: wiki-toolkit/trunk/lib/Wiki/Toolkit.pm @ 424

Revision 424, 30.3 KB checked in by dom, 6 years ago (diff)

whitespace-only change to fix some POD bugs and generally make things read
more nicely. Tab-damage fixing still todo...

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