source: wiki-toolkit/trunk/lib/Wiki/Toolkit/Store/Database.pm @ 304

Last change on this file since 304 was 304, checked in by Dominic Hargreaves, 14 years ago

Check for the schema version before trying to use the database (closes #5)

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 56.0 KB
Line 
1package Wiki::Toolkit::Store::Database;
2
3use strict;
4
5use vars qw( $VERSION $timestamp_fmt );
6$timestamp_fmt = "%Y-%m-%d %H:%M:%S";
7
8use DBI;
9use Time::Piece;
10use Time::Seconds;
11use Carp qw( carp croak );
12use Digest::MD5 qw( md5_hex );
13
14$VERSION = '0.27';
15my $SCHEMA_VER = 9;
16
17# first, detect if Encode is available - it's not under 5.6. If we _are_
18# under 5.6, give up - we'll just have to hope that nothing explodes. This
19# is the current 0.54 behaviour, so that's ok.
20
21my $CAN_USE_ENCODE;
22BEGIN {
23  eval " use Encode ";
24  $CAN_USE_ENCODE = $@ ? 0 : 1;
25}
26
27
28=head1 NAME
29
30Wiki::Toolkit::Store::Database - parent class for database storage backends
31for Wiki::Toolkit
32
33=head1 SYNOPSIS
34
35This is probably only useful for Wiki::Toolkit developers.
36
37  # See below for parameter details.
38  my $store = Wiki::Toolkit::Store::MySQL->new( %config );
39
40=head1 METHODS
41
42=over 4
43
44=item B<new>
45
46  my $store = Wiki::Toolkit::Store::MySQL->new( dbname  => "wiki",
47                                            dbuser  => "wiki",
48                                            dbpass  => "wiki",
49                                            dbhost  => "db.example.com",
50                                            charset => "iso-8859-1" );
51or
52
53  my $store = Wiki::Toolkit::Store::MySQL->new( dbh => $dbh );
54
55C<charset> is optional, defaults to C<iso-8859-1>, and does nothing
56unless you're using perl 5.8 or newer.
57
58If you do not provide an active database handle in C<dbh>, then
59C<dbname> is mandatory. C<dbpass>, C<dbuser> and C<dbhost> are
60optional, but you'll want to supply them unless your database's
61authentication method doesn't require it.
62
63If you do provide C<database> then it must have the following
64parameters set; otherwise you should just provide the connection
65information and let us create our own handle:
66
67=over 4
68
69=item *
70
71C<RaiseError> = 1
72
73=item *
74
75C<PrintError> = 0
76
77=item *
78
79C<AutoCommit> = 1
80
81=back
82
83=cut
84
85sub new {
86    my ($class, @args) = @_;
87    my $self = {};
88    bless $self, $class;
89    return $self->_init(@args);
90}
91
92sub _init {
93    my ($self, %args) = @_;
94
95    if ( $args{dbh} ) {
96        $self->{_dbh} = $args{dbh};
97        $self->{_external_dbh} = 1; # don't disconnect at DESTROY time
98    } else {
99        die "Must supply a dbname" unless defined $args{dbname};
100        $self->{_dbname} = $args{dbname};
101        $self->{_dbuser} = $args{dbuser} || "";
102        $self->{_dbpass} = $args{dbpass} || "";
103        $self->{_dbhost} = $args{dbhost} || "";
104        $self->{_charset} = $args{charset} || "iso-8859-1";
105
106        # Connect to database and store the database handle.
107        my ($dbname, $dbuser, $dbpass, $dbhost) =
108                               @$self{qw(_dbname _dbuser _dbpass _dbhost)};
109        my $dsn = $self->_dsn($dbname, $dbhost)
110            or croak "No data source string provided by class";
111        $self->{_dbh} = DBI->connect( $dsn, $dbuser, $dbpass,
112                                      { PrintError => 0, RaiseError => 1,
113                                        AutoCommit => 1 } )
114          or croak "Can't connect to database $dbname using $dsn: "
115                   . DBI->errstr;
116    }
117
118    my ($cur_ver, $db_ver) = $self->schema_current;
119    if ($db_ver < $cur_ver) {
120        croak "Database schema version $db_ver is too old (need $cur_ver)";
121    } elsif ($db_ver > $cur_ver) {
122        croak "Database schema version $db_ver is too new (need $cur_ver)";
123    }
124
125    return $self;
126}
127
128# Internal method, used to handle the logic of how to add up return
129#  values from pre_ plugins
130sub handle_pre_plugin_ret {
131        my ($running_total_ref,$result) = @_;
132
133        if(($result && $result == 0) || !$result) {
134                # No opinion, no need to change things
135        } elsif($result == -1 || $result == 1) {
136                # Increase or decrease as requested
137                $$running_total_ref += $result;
138        } else {
139                # Invalid return code
140                warn("Pre_ plugin returned invalid accept/deny value of '$result'");
141        }
142}
143
144
145=item B<retrieve_node>
146
147  my $content = $store->retrieve_node($node);
148
149  # Or get additional meta-data too.
150  my %node = $store->retrieve_node("HomePage");
151  print "Current Version: " . $node{version};
152
153  # Maybe we stored some metadata too.
154  my $categories = $node{metadata}{category};
155  print "Categories: " . join(", ", @$categories);
156  print "Postcode: $node{metadata}{postcode}[0]";
157
158  # Or get an earlier version:
159  my %node = $store->retrieve_node(name    => "HomePage",
160                                     version => 2 );
161  print $node{content};
162
163
164In scalar context, returns the current (raw Wiki language) contents of
165the specified node. In list context, returns a hash containing the
166contents of the node plus additional data:
167
168=over 4
169
170=item B<last_modified>
171
172=item B<version>
173
174=item B<checksum>
175
176=item B<metadata> - a reference to a hash containing any caller-supplied
177metadata sent along the last time the node was written
178
179The node parameter is mandatory. The version parameter is optional and
180defaults to the newest version. If the node hasn't been created yet,
181it is considered to exist but be empty (this behaviour might change).
182
183B<Note> on metadata - each hash value is returned as an array ref,
184even if that type of metadata only has one value.
185
186=cut
187
188sub retrieve_node {
189    my $self = shift;
190    my %args = scalar @_ == 1 ? ( name => $_[0] ) : @_;
191        unless($args{'version'}) { $args{'version'} = undef; }
192
193    # Call pre_retrieve on any plugins, in case they want to tweak anything
194    my @plugins = @{ $args{plugins} || [ ] };
195    foreach my $plugin (@plugins) {
196        if ( $plugin->can( "pre_retrieve" ) ) {
197            $plugin->pre_retrieve( 
198                                node     => \$args{'name'},
199                                version  => \$args{'version'}
200                        );
201        }
202    }
203
204    # Note _retrieve_node_data is sensitive to calling context.
205        unless(wantarray) {
206                # Scalar context, will return just the content
207                return $self->_retrieve_node_data( %args );
208        }
209
210    my %data = $self->_retrieve_node_data( %args );
211        $data{'checksum'} = $self->_checksum(%data);
212    return %data;
213}
214
215# Returns hash or scalar depending on calling context.
216sub _retrieve_node_data {
217    my ($self, %args) = @_;
218    my %data = $self->_retrieve_node_content( %args );
219        unless(wantarray) {
220                # Scalar context, return just the content
221                return $data{content};
222        }
223
224    # If we want additional data then get it.  Note that $data{version}
225    # will already have been set by C<_retrieve_node_content>, if it wasn't
226    # specified in the call.
227    my $dbh = $self->dbh;
228    my $sql = "SELECT metadata_type, metadata_value "
229         . "FROM node "
230         . "INNER JOIN metadata ON (node_id = id) "
231         . "WHERE name=? "
232         . "AND metadata.version=?";
233    my $sth = $dbh->prepare($sql);
234    $sth->execute($args{name},$data{version}) or croak $dbh->errstr;
235
236    my %metadata;
237    while ( my ($type, $val) = $self->charset_decode( $sth->fetchrow_array ) ) {
238        if ( defined $metadata{$type} ) {
239            push @{$metadata{$type}}, $val;
240        } else {
241            $metadata{$type} = [ $val ];
242        }
243    }
244    $data{metadata} = \%metadata;
245    return %data;
246}
247
248# $store->_retrieve_node_content( name    => $node_name,
249#                                 version => $node_version );
250# Params: 'name' is compulsory, 'version' is optional and defaults to latest.
251# Returns a hash of data for C<retrieve_node> - content, version, last modified
252sub _retrieve_node_content {
253    my ($self, %args) = @_;
254    croak "No valid node name supplied" unless $args{name};
255    my $dbh = $self->dbh;
256    my $sql;
257
258        my $version_sql_val;
259        my $text_source;
260    if ( $args{version} ) {
261                # Version given - get that version, and the content for that version
262                $version_sql_val = $dbh->quote($self->charset_encode($args{version}));
263                $text_source = "content";
264        } else {
265                # No version given, grab latest version (and content for that)
266                $version_sql_val = "node.version";
267                $text_source = "node";
268        }
269    $sql = "SELECT "
270         . "     $text_source.text, content.version, "
271         . "     content.modified, content.moderated, "
272         . "     node.moderate "
273         . "FROM node "
274         . "INNER JOIN content ON (id = node_id) "
275         . "WHERE name=" . $dbh->quote($self->charset_encode($args{name}))
276         . " AND content.version=" . $version_sql_val;
277    my @results = $self->charset_decode( $dbh->selectrow_array($sql) );
278    @results = ("", 0, "") unless scalar @results;
279    my %data;
280    @data{ qw( content version last_modified moderated node_requires_moderation ) } = @results;
281    return %data;
282}
283
284# Expects a hash as returned by ->retrieve_node
285sub _checksum {
286    my ($self, %node_data) = @_;
287    my $string = $node_data{content};
288    my %metadata = %{ $node_data{metadata} || {} };
289    foreach my $key ( sort keys %metadata ) {
290        $string .= "\0\0\0" . $key . "\0\0"
291                 . join("\0", sort @{$metadata{$key}} );
292    }
293    return md5_hex($self->charset_encode($string));
294}
295
296# Expects an array of hashes whose keys and values are scalars.
297sub _checksum_hashes {
298    my ($self, @hashes) = @_;
299    my @strings = "";
300    foreach my $hashref ( @hashes ) {
301        my %hash = %$hashref;
302        my $substring = "";
303        foreach my $key ( sort keys %hash ) {
304            $substring .= "\0\0" . $key . "\0" . $hash{$key};
305        }
306        push @strings, $substring;
307    }
308    my $string = join("\0\0\0", sort @strings);
309    return md5_hex($string);
310}
311
312=item B<node_exists>
313
314  my $ok = $store->node_exists( "Wombat Defenestration" );
315
316  # or ignore case - optional but recommended
317  my $ok = $store->node_exists(
318                                name        => "monkey brains",
319                                ignore_case => 1,
320                              ); 
321
322Returns true if the node has ever been created (even if it is
323currently empty), and false otherwise.
324
325By default, the case-sensitivity of C<node_exists> depends on your
326database.  If you supply a true value to the C<ignore_case> parameter,
327then you can be sure of its being case-insensitive.  This is
328recommended.
329
330=cut
331
332sub node_exists {
333    my $self = shift;
334    if ( scalar @_ == 1 ) {
335        my $node = shift;
336        return $self->_do_old_node_exists( $node );
337    } else {
338        my %args = @_;
339        return $self->_do_old_node_exists( $args{name} )
340          unless $args{ignore_case};
341        my $sql = $self->_get_node_exists_ignore_case_sql;
342        my $sth = $self->dbh->prepare( $sql );
343        $sth->execute( $args{name} );
344        my $found_name = $sth->fetchrow_array || "";
345        return lc($found_name) eq lc($args{name}) ? 1 : 0;
346    }
347}
348
349sub _do_old_node_exists {
350    my ($self, $node) = @_;
351    my %data = $self->retrieve_node($node) or return ();
352    return $data{version}; # will be 0 if node doesn't exist, >=1 otherwise
353}
354
355=item B<verify_checksum>
356
357  my $ok = $store->verify_checksum($node, $checksum);
358
359Sees whether your checksum is current for the given node. Returns true
360if so, false if not.
361
362B<NOTE:> Be aware that when called directly and without locking, this
363might not be accurate, since there is a small window between the
364checking and the returning where the node might be changed, so
365B<don't> rely on it for safe commits; use C<write_node> for that. It
366can however be useful when previewing edits, for example.
367
368=cut
369
370sub verify_checksum {
371    my ($self, $node, $checksum) = @_;
372#warn $self;
373    my %node_data = $self->_retrieve_node_data( name => $node );
374    return ( $checksum eq $self->_checksum( %node_data ) );
375}
376
377=item B<list_backlinks>
378
379  # List all nodes that link to the Home Page.
380  my @links = $store->list_backlinks( node => "Home Page" );
381
382=cut
383
384sub list_backlinks {
385    my ( $self, %args ) = @_;
386    my $node = $args{node};
387    croak "Must supply a node name" unless $node;
388    my $dbh = $self->dbh;
389    my $sql = "SELECT link_from FROM internal_links WHERE link_to="
390            . $dbh->quote($node);
391    my $sth = $dbh->prepare($sql);
392    $sth->execute or croak $dbh->errstr;
393    my @backlinks;
394    while ( my ($backlink) = $self->charset_decode( $sth->fetchrow_array ) ) {
395        push @backlinks, $backlink;
396    }
397    return @backlinks;
398}
399
400=item B<list_dangling_links>
401
402  # List all nodes that have been linked to from other nodes but don't
403  # yet exist.
404  my @links = $store->list_dangling_links;
405
406Each node is returned once only, regardless of how many other nodes
407link to it.
408
409=cut
410
411sub list_dangling_links {
412    my $self = shift;
413    my $dbh = $self->dbh;
414    my $sql = "SELECT DISTINCT internal_links.link_to
415               FROM internal_links LEFT JOIN node
416                                   ON node.name=internal_links.link_to
417               WHERE node.version IS NULL";
418    my $sth = $dbh->prepare($sql);
419    $sth->execute or croak $dbh->errstr;
420    my @links;
421    while ( my ($link) = $self->charset_decode( $sth->fetchrow_array ) ) {
422        push @links, $link;
423    }
424    return @links;
425}
426
427=item B<write_node_post_locking>
428
429  $store->write_node_post_locking( node     => $node,
430                                   content  => $content,
431                                   links_to => \@links_to,
432                                   metadata => \%metadata,
433                                   requires_moderation => $requires_moderation,
434                                   plugins  => \@plugins   )
435      or handle_error();
436
437Writes the specified content into the specified node, then calls
438C<post_write> on all supplied plugins, with arguments C<node>,
439C<version>, C<content>, C<metadata>.
440
441Making sure that locking/unlocking/transactions happen is left up to
442you (or your chosen subclass). This method shouldn't really be used
443directly as it might overwrite someone else's changes. Croaks on error
444but otherwise returns true.
445
446Supplying a ref to an array of nodes that this ones links to is
447optional, but if you do supply it then this node will be returned when
448calling C<list_backlinks> on the nodes in C<@links_to>. B<Note> that
449if you don't supply the ref then the store will assume that this node
450doesn't link to any others, and update itself accordingly.
451
452The metadata hashref is also optional, as is requires_moderation.
453
454B<Note> on the metadata hashref: Any data in here that you wish to
455access directly later must be a key-value pair in which the value is
456either a scalar or a reference to an array of scalars.  For example:
457
458  $wiki->write_node( "Calthorpe Arms", "nice pub", $checksum,
459                     { category => [ "Pubs", "Bloomsbury" ],
460                       postcode => "WC1X 8JR" } );
461
462  # and later
463
464  my @nodes = $wiki->list_nodes_by_metadata(
465      metadata_type  => "category",
466      metadata_value => "Pubs"             );
467
468For more advanced usage (passing data through to registered plugins)
469you may if you wish pass key-value pairs in which the value is a
470hashref or an array of hashrefs. The data in the hashrefs will not be
471stored as metadata; it will be checksummed and the checksum will be
472stored instead (as C<__metadatatypename__checksum>). Such data can
473I<only> be accessed via plugins.
474
475=cut
476
477sub write_node_post_locking {
478    my ($self, %args) = @_;
479    my ($node, $content, $links_to_ref, $metadata_ref, $requires_moderation) =
480             @args{ qw( node content links_to metadata requires_moderation) };
481    my $dbh = $self->dbh;
482
483    my $timestamp = $self->_get_timestamp();
484    my @links_to = @{ $links_to_ref || [] }; # default to empty array
485    my $version;
486        unless($requires_moderation) { $requires_moderation = 0; }
487
488    # Call pre_write on any plugins, in case they want to tweak anything
489    my @preplugins = @{ $args{plugins} || [ ] };
490        my $write_allowed = 1;
491    foreach my $plugin (@preplugins) {
492        if ( $plugin->can( "pre_write" ) ) {
493                        handle_pre_plugin_ret(
494                                \$write_allowed,
495                                $plugin->pre_write( 
496                                        node     => \$node,
497                                        content  => \$content,
498                                        metadata => \$metadata_ref )
499                        );
500        }
501    }
502        if($write_allowed < 1) {
503                # The plugins didn't want to allow this action
504                return -1;
505        }
506
507    # Either inserting a new page or updating an old one.
508    my $sql = "SELECT count(*) FROM node WHERE name=" . $dbh->quote($node);
509    my $exists = @{ $dbh->selectcol_arrayref($sql) }[0] || 0;
510
511
512        # If it doesn't exist, add it right now
513    if(! $exists) {
514                # Add in a new version
515        $version = 1;
516
517                # Handle initial moderation
518                my $node_content = $content;
519                if($requires_moderation) {
520                        $node_content = "=== This page has yet to be moderated. ===";
521                }
522
523                # Add the node and content
524        my $add_sql = 
525                         "INSERT INTO node "
526                        ."    (name, version, text, modified, moderate) "
527                        ."VALUES (?, ?, ?, ?, ?)";
528                my $add_sth = $dbh->prepare($add_sql);
529                $add_sth->execute(
530                        map{ $self->charset_encode($_) }
531                                ($node, $version, $node_content, $timestamp, $requires_moderation)
532                ) or croak "Error updating database: " . DBI->errstr;
533    }
534
535    # Get the ID of the node we've added / we're about to update
536        # Also get the moderation status for it
537    $sql = "SELECT id, moderate FROM node WHERE name=" . $dbh->quote($node);
538    my ($node_id,$node_requires_moderation) = $dbh->selectrow_array($sql);
539
540        # Only update node if it exists, and moderation isn't enabled on the node
541        # Whatever happens, if it exists, generate a new version number
542    if($exists) {
543                # Get the new version number
544        $sql = "SELECT max(content.version) FROM node
545                INNER JOIN content ON (id = node_id)
546                WHERE name=" . $dbh->quote($node);
547        $version = @{ $dbh->selectcol_arrayref($sql) }[0] || 0;
548        croak "Can't get version number" unless $version;
549        $version++;
550
551                # Update the node only if node doesn't require moderation
552                if(!$node_requires_moderation) {
553                        $sql = "UPDATE node SET version=" . $dbh->quote($version)
554                         . ", text=" . $dbh->quote($self->charset_encode($content))
555                         . ", modified=" . $dbh->quote($timestamp)
556                         . " WHERE name=" . $dbh->quote($self->charset_encode($node));
557                        $dbh->do($sql) or croak "Error updating database: " . DBI->errstr;
558                }
559
560                # You can't use this to enable moderation on an existing node
561        if($requires_moderation) {
562           warn("Moderation not added to existing node '$node', use normal moderation methods instead");
563        }
564        }
565
566
567    # Now node is updated (if required), add to the history
568    my $add_sql = 
569                 "INSERT INTO content "
570                ."      (node_id, version, text, modified, moderated) "
571                ."VALUES (?, ?, ?, ?, ?)";
572        my $add_sth = $dbh->prepare($add_sql);
573        $add_sth->execute(
574                map { $self->charset_encode($_) }
575                        ($node_id, $version, $content, $timestamp, (1-$node_requires_moderation))
576    ) or croak "Error updating database: " . DBI->errstr;
577
578
579    # Update the backlinks.
580    $dbh->do("DELETE FROM internal_links WHERE link_from="
581             . $dbh->quote($self->charset_encode($node)) ) or croak $dbh->errstr;
582    foreach my $links_to ( @links_to ) {
583        $sql = "INSERT INTO internal_links (link_from, link_to) VALUES ("
584             . join(", ", map { $dbh->quote($self->charset_encode($_)) } ( $node, $links_to ) ) . ")";
585        # Better to drop a backlink or two than to lose the whole update.
586        # Shevek wants a case-sensitive wiki, Jerakeen wants a case-insensitive
587        # one, MySQL compares case-sensitively on varchars unless you add
588        # the binary keyword.  Case-sensitivity to be revisited.
589        eval { $dbh->do($sql); };
590        carp "Couldn't index backlink: " . $dbh->errstr if $@;
591    }
592
593    # And also store any metadata.  Note that any entries already in the
594    # metadata table refer to old versions, so we don't need to delete them.
595    my %metadata = %{ $metadata_ref || {} }; # default to no metadata
596    foreach my $type ( keys %metadata ) {
597        my $val = $metadata{$type};
598
599        # We might have one or many values; make an array now to merge cases.
600        my @values = (ref $val and ref $val eq 'ARRAY') ? @$val : ( $val );
601
602        # Find out whether all values for this type are scalars.
603        my $all_scalars = 1;
604        foreach my $value (@values) {
605            $all_scalars = 0 if ref $value;
606        }
607
608        # For adding to metadata
609        my $add_sql = 
610              "INSERT INTO metadata "
611             ."   (node_id, version, metadata_type, metadata_value) "
612             ."VALUES (?, ?, ?, ?)";
613        my $add_sth = $dbh->prepare($add_sql);
614
615        # If all values for this type are scalars, strip out any duplicates
616        # and store the data.
617        if ( $all_scalars ) {
618            my %unique = map { $_ => 1 } @values;
619            @values = keys %unique;
620
621            foreach my $value ( @values ) {
622                                $add_sth->execute(
623                    map { $self->charset_encode($_) }
624                        ( $node_id, $version, $type, $value )
625                    ) or croak $dbh->errstr;
626            }
627            } else {
628            # Otherwise grab a checksum and store that.
629            my $type_to_store  = "__" . $type . "__checksum";
630            my $value_to_store = $self->_checksum_hashes( @values );
631            $add_sth->execute(
632                  map { $self->charset_encode($_) }
633                      ( $node_id, $version, $type_to_store, $value_to_store )
634            )  or croak $dbh->errstr;
635            }
636    }
637
638    # Finally call post_write on any plugins.
639    my @postplugins = @{ $args{plugins} || [ ] };
640    foreach my $plugin (@postplugins) {
641        if ( $plugin->can( "post_write" ) ) {
642            $plugin->post_write( 
643                                node     => $node,
644                                node_id  => $node_id,
645                                version  => $version,
646                                content  => $content,
647                                metadata => $metadata_ref );
648        }
649    }
650
651    return 1;
652}
653
654# Returns the timestamp of now, unless epoch is supplied.
655sub _get_timestamp {
656    my $self = shift;
657    # I don't care about no steenkin' timezones (yet).
658    my $time = shift || localtime; # Overloaded by Time::Piece.
659    unless( ref $time ) {
660        $time = localtime($time); # Make it into an object for strftime
661    }
662    return $time->strftime($timestamp_fmt); # global
663}
664
665=item B<rename_node>
666
667  $store->rename_node(
668                         old_name  => $node,
669                         new_name  => $new_node,
670                         wiki      => $wiki,
671                         create_new_versions => $create_new_versions,
672                       );
673
674Renames a node, updating any references to it as required (assuming your
675chosen formatter supports rename, that is).
676
677Uses the internal_links table to identify the nodes that link to this
678one, and re-writes any wiki links in these to point to the new name.
679=cut
680sub rename_node {
681    my ($self, %args) = @_;
682    my ($old_name,$new_name,$wiki,$create_new_versions) = 
683                @args{ qw( old_name new_name wiki create_new_versions ) };
684    my $dbh = $self->dbh;
685        my $formatter = $wiki->{_formatter};
686
687    my $timestamp = $self->_get_timestamp();
688
689    # Call pre_rename on any plugins, in case they want to tweak anything
690    my @preplugins = @{ $args{plugins} || [ ] };
691        my $rename_allowed = 1;
692    foreach my $plugin (@preplugins) {
693        if ( $plugin->can( "pre_rename" ) ) {
694                        handle_pre_plugin_ret(
695                                \$rename_allowed,
696                                $plugin->pre_rename( 
697                                        old_name => \$old_name,
698                                        new_name => \$new_name,
699                                        create_new_versions => \$create_new_versions,
700                                )
701                        );
702        }
703    }
704        if($rename_allowed < 1) {
705                # The plugins didn't want to allow this action
706                return -1;
707        }
708
709        # Get the ID of the node
710        my $sql = "SELECT id FROM node WHERE name=?";
711        my $sth = $dbh->prepare($sql);
712        $sth->execute($old_name);
713        my ($node_id) = $sth->fetchrow_array;
714
715
716        # If the formatter supports it, get a list of the internal
717        #  links to the page, which will have their links re-written
718        # (Do now before we update the name of the node, in case of
719        #  self links)
720        my @links;
721        if($formatter->can("rename_links")) {
722                # Get a list of the pages that link to the page
723                $sql = "SELECT id, name, version "
724                        ."FROM internal_links "
725                        ."INNER JOIN node "
726                        ."      ON (link_from = name) "
727                        ."WHERE link_to = ?";
728                $sth = $dbh->prepare($sql);
729                $sth->execute($old_name);
730
731                # Grab them all, then update, so no locking problems
732                while(my @l = $sth->fetchrow_array) { push (@links, \@l); }
733        }
734
735       
736        # Rename the node
737        $sql = "UPDATE node SET name=? WHERE id=?";
738        $sth = $dbh->prepare($sql);
739        $sth->execute($new_name,$node_id);
740
741
742        # Fix the internal links from this page
743        # (Otherwise write_node will get confused if we rename links later on)
744        $sql = "UPDATE internal_links SET link_from=? WHERE link_from=?";
745        $sth = $dbh->prepare($sql);
746        $sth->execute($new_name,$old_name);
747
748
749        # Update the text of internal links, if the formatter supports it
750        if($formatter->can("rename_links")) {
751                # Update the linked pages (may include renamed page)
752                foreach my $l (@links) {
753                        my ($page_id, $page_name, $page_version) = @$l;
754                        # Self link special case
755                        if($page_name eq $old_name) { $page_name = $new_name; }
756
757                        # Grab the latest version of that page
758                        my %page = $self->retrieve_node(
759                                        name=>$page_name, version=>$page_version
760                        );
761
762                        # Update the content of the page
763                        my $new_content = 
764                                $formatter->rename_links($old_name,$new_name,$page{'content'});
765
766                        # Did it change?
767                        if($new_content ne $page{'content'}) {
768                                # Write the updated page out
769                                if($create_new_versions) {
770                                        # Write out as a new version of the node
771                                        # (This will also fix our internal links)
772                                        $wiki->write_node(
773                                                                $page_name, 
774                                                                $new_content,
775                                                                $page{checksum},
776                                                                $page{metadata}
777                                        );
778                                } else {
779                                        # Just update the content
780                                        my $update_sql_a = "UPDATE node SET text=? WHERE id=?";
781                                        my $update_sql_b = "UPDATE content SET text=? ".
782                                                                           "WHERE node_id=? AND version=?";
783
784                                        my $u_sth = $dbh->prepare($update_sql_a);
785                                        $u_sth->execute($new_content,$page_id);
786                                        $u_sth = $dbh->prepare($update_sql_b);
787                                        $u_sth->execute($new_content,$page_id,$page_version);
788                                }
789                        }
790                }
791
792                # Fix the internal links if we didn't create new versions of the node
793                if(! $create_new_versions) {
794                        $sql = "UPDATE internal_links SET link_to=? WHERE link_to=?";
795                        $sth = $dbh->prepare($sql);
796                        $sth->execute($new_name,$old_name);
797                }
798        } else {
799                warn("Internal links not updated following node rename - unsupported by formatter");
800        }
801
802    # Call post_rename on any plugins, in case they want to do anything
803    my @postplugins = @{ $args{plugins} || [ ] };
804    foreach my $plugin (@postplugins) {
805        if ( $plugin->can( "post_rename" ) ) {
806            $plugin->post_rename( 
807                                old_name => $old_name,
808                                new_name => $new_name,
809                                node_id => $node_id,
810                        );
811        }
812    }
813}
814
815=item B<moderate_node>
816
817  $store->moderate_node(
818                         name    => $node,
819                         version => $version
820                       );
821
822Marks the given version of the node as moderated. If this is the
823highest moderated version, then update the node's contents to hold
824this version.
825=cut
826
827sub moderate_node {
828    my $self = shift;
829    my %args = scalar @_ == 2 ? ( name => $_[0], version => $_[1] ) : @_;
830    my $dbh = $self->dbh;
831
832        my ($name,$version) = ($args{name},$args{version});
833
834    # Call pre_moderate on any plugins.
835    my @plugins = @{ $args{plugins} || [ ] };
836        my $moderation_allowed = 1;
837    foreach my $plugin (@plugins) {
838        if ( $plugin->can( "pre_moderate" ) ) {
839                        handle_pre_plugin_ret(
840                                \$moderation_allowed,
841                                $plugin->pre_moderate( 
842                                        node     => \$name,
843                                        version  => \$version )
844                        );
845        }
846    }
847        if($moderation_allowed < 1) {
848                # The plugins didn't want to allow this action
849                return -1;
850        }
851
852        # Get the ID of this node
853    my $id_sql = "SELECT id FROM node WHERE name=?";
854    my $id_sth = $dbh->prepare($id_sql);
855    $id_sth->execute($name);
856        my ($node_id) = $id_sth->fetchrow_array;
857
858        # Check what the current highest moderated version is
859        my $hv_sql = 
860                 "SELECT max(version) "
861                ."FROM content "
862                ."WHERE node_id = ? "
863                ."AND moderated = ?";
864        my $hv_sth = $dbh->prepare($hv_sql);
865        $hv_sth->execute($node_id, "1") or croak $dbh->errstr;
866        my ($highest_mod_version) = $hv_sth->fetchrow_array;
867        unless($highest_mod_version) { $highest_mod_version = 0; }
868
869        # Mark this version as moderated
870        my $update_sql = 
871                 "UPDATE content "
872                ."SET moderated = ? "
873                ."WHERE node_id = ? "
874                ."AND version = ?";
875        my $update_sth = $dbh->prepare($update_sql);
876        $update_sth->execute("1", $node_id, $version) or croak $dbh->errstr;
877
878        # Are we now the highest moderated version?
879        if(int($version) > int($highest_mod_version)) {
880                # Newly moderated version is newer than previous moderated version
881                # So, make the current version the latest version
882                my %new_data = $self->retrieve_node( name => $name, version => $version );
883
884                # Make sure last modified is properly null, if not set
885                unless($new_data{last_modified}) { $new_data{last_modified} = undef; }
886
887                my $newv_sql = 
888                         "UPDATE node "
889                        ."SET version=?, text=?, modified=? "
890                        ."WHERE id = ?";
891                my $newv_sth = $dbh->prepare($newv_sql);
892                $newv_sth->execute(
893                        $version, $self->charset_encode($new_data{content}), 
894                        $new_data{last_modified}, $node_id
895                ) or croak $dbh->errstr;
896        } else {
897                # A higher version is already moderated, so don't change node
898        }
899
900        # TODO: Do something about internal links, if required
901
902    # Finally call post_moderate on any plugins.
903    @plugins = @{ $args{plugins} || [ ] };
904    foreach my $plugin (@plugins) {
905        if ( $plugin->can( "post_moderate" ) ) {
906            $plugin->post_moderate( 
907                                node     => $name,
908                                node_id  => $node_id,
909                                version  => $version );
910        }
911    }
912
913        return 1;
914}
915
916=item B<set_node_moderation>
917
918  $store->set_node_moderation(
919                         name     => $node,
920                         required => $required
921                       );
922
923Sets if new node versions will require moderation or not
924=cut
925
926sub set_node_moderation {
927    my $self = shift;
928    my %args = scalar @_ == 2 ? ( name => $_[0], required => $_[1] ) : @_;
929    my $dbh = $self->dbh;
930
931        my ($name,$required) = ($args{name},$args{required});
932
933        # Get the ID of this node
934    my $id_sql = "SELECT id FROM node WHERE name=?";
935    my $id_sth = $dbh->prepare($id_sql);
936    $id_sth->execute($name);
937        my ($node_id) = $id_sth->fetchrow_array;
938
939        # Mark it as requiring / not requiring moderation
940        my $mod_sql = 
941                 "UPDATE node "
942                ."SET moderate = ? "
943                ."WHERE id = ? ";
944        my $mod_sth = $dbh->prepare($mod_sql);
945        $mod_sth->execute("$required", $node_id) or croak $dbh->errstr;
946
947        return 1;
948}
949
950=item B<delete_node>
951
952  $store->delete_node(
953                       name    => $node,
954                       version => $version,
955                       wiki    => $wiki
956                     );
957
958C<version> is optional.  If it is supplied then only that version of
959the node will be deleted.  Otherwise the node and all its history will
960be completely deleted.
961
962C<wiki> is also optional, but if you care about updating the backlinks
963you want to include it.
964
965Again, doesn't do any locking. You probably don't want to let anyone
966except Wiki admins call this. You may not want to use it at all.
967
968Croaks on error, silently does nothing if the node or version doesn't
969exist, returns true if no error.
970
971=cut
972
973sub delete_node {
974    my $self = shift;
975    # Backwards compatibility.
976    my %args = ( scalar @_ == 1 ) ? ( name => $_[0] ) : @_;
977
978    my $dbh = $self->dbh;
979    my ($name, $version, $wiki) = @args{ qw( name version wiki ) };
980
981    # Grab the ID of this node
982    # (It will only ever have one entry in node, but might have entries
983    #  for other versions in metadata and content)
984    my $id_sql = "SELECT id FROM node WHERE name=?";
985    my $id_sth = $dbh->prepare($id_sql);
986    $id_sth->execute($name);
987        my ($node_id) = $id_sth->fetchrow_array;
988
989    # Trivial case - delete the whole node and all its history.
990    unless ( $version ) {
991        my $sql;
992        # Should start a transaction here.  FIXME.
993        # Do deletes
994        $sql = "DELETE FROM content WHERE node_id = $node_id";
995        $dbh->do($sql) or croak "Deletion failed: " . DBI->errstr;
996        $sql = "DELETE FROM internal_links WHERE link_from=".$dbh->quote($name);
997        $dbh->do($sql) or croak $dbh->errstr;
998        $sql = "DELETE FROM metadata WHERE node_id = $node_id";
999        $dbh->do($sql) or croak $dbh->errstr;
1000        $sql = "DELETE FROM node WHERE id = $node_id";
1001        $dbh->do($sql) or croak "Deletion failed: " . DBI->errstr;
1002
1003        # And finish it here.
1004                post_delete_node($name,$node_id,$version,$args{plugins});
1005        return 1;
1006    }
1007
1008    # Skip out early if we're trying to delete a nonexistent version.
1009    my %verdata = $self->retrieve_node( name => $name, version => $version );
1010        unless($verdata{version}) {
1011                warn("Asked to delete non existant version $version of node $node_id ($name)");
1012                return 1;
1013        }
1014
1015    # Reduce to trivial case if deleting the only version.
1016    my $sql = "SELECT COUNT(*) FROM content WHERE node_id = $node_id";
1017    my $sth = $dbh->prepare( $sql );
1018    $sth->execute() or croak "Deletion failed: " . $dbh->errstr;
1019    my ($count) = $sth->fetchrow_array;
1020        if($count == 1) {
1021                # Only one version, so can do the non version delete
1022            return $self->delete_node( name=>$name, plugins=>$args{plugins} );
1023        }
1024
1025    # Check whether we're deleting the latest (moderated) version.
1026    my %currdata = $self->retrieve_node( name => $name );
1027    if ( $currdata{version} == $version ) {
1028                # Deleting latest version, so need to update the copy in node
1029        # (Can't just grab version ($version - 1) since it may have been
1030        #  deleted itself, or might not be moderated.)
1031        my $try = $version - 1;
1032        my %prevdata;
1033        until ( $prevdata{version} && $prevdata{moderated} ) {
1034            %prevdata = $self->retrieve_node(
1035                                              name    => $name,
1036                                              version => $try,
1037                                            );
1038            $try--;
1039        }
1040
1041        # Move to new (old) version
1042        my $sql="UPDATE node
1043                 SET version=?, text=?, modified=?
1044                 WHERE name=?";
1045        my $sth = $dbh->prepare( $sql );
1046        $sth->execute( @prevdata{ qw( version content last_modified ) }, $name)
1047          or croak "Deletion failed: " . $dbh->errstr;
1048
1049                # Remove the current version from content
1050        $sql = "DELETE FROM content
1051                WHERE node_id = $node_id
1052                AND version = $version";
1053        $sth = $dbh->prepare( $sql );
1054        $sth->execute()
1055          or croak "Deletion failed: " . $dbh->errstr;
1056
1057                # Update the internal links to reflect the new version
1058        $sql = "DELETE FROM internal_links WHERE link_from=?";
1059        $sth = $dbh->prepare( $sql );
1060        $sth->execute( $name )
1061          or croak "Deletion failed: " . $dbh->errstr;
1062        my @links_to;
1063        my $formatter = $wiki->formatter;
1064        if ( $formatter->can( "find_internal_links" ) ) {
1065            # Supply $metadata to formatter in case it's needed to alter the
1066            # behaviour of the formatter, eg for Wiki::Toolkit::Formatter::Multiple
1067            my @all = $formatter->find_internal_links(
1068                                    $prevdata{content}, $prevdata{metadata} );
1069            my %unique = map { $_ => 1 } @all;
1070            @links_to = keys %unique;
1071        }
1072        $sql = "INSERT INTO internal_links (link_from, link_to) VALUES (?,?)";
1073        $sth = $dbh->prepare( $sql );
1074        foreach my $link ( @links_to ) {
1075            eval { $sth->execute( $name, $link ); };
1076            carp "Couldn't index backlink: " . $dbh->errstr if $@;
1077        }
1078
1079                # Delete the metadata for the old version
1080        $sql = "DELETE FROM metadata
1081                WHERE node_id = $node_id
1082                AND version = $version";
1083        $sth = $dbh->prepare( $sql );
1084        $sth->execute()
1085          or croak "Deletion failed: " . $dbh->errstr;
1086
1087                # All done
1088                post_delete_node($name,$node_id,$version,$args{plugins});
1089        return 1;
1090    }
1091
1092    # If we're still here, then we're deleting neither the latest
1093    # nor the only version.
1094    $sql = "DELETE FROM content
1095            WHERE node_id = $node_id
1096            AND version=?";
1097    $sth = $dbh->prepare( $sql );
1098    $sth->execute( $version )
1099      or croak "Deletion failed: " . $dbh->errstr;
1100    $sql = "DELETE FROM metadata
1101            WHERE node_id = $node_id
1102            AND version=?";
1103    $sth = $dbh->prepare( $sql );
1104    $sth->execute( $version )
1105      or croak "Deletion failed: " . $dbh->errstr;
1106
1107        # All done
1108        post_delete_node($name,$node_id,$version,$args{plugins});
1109    return 1;
1110}
1111
1112# Internal Method
1113sub post_delete_node {
1114        my ($name,$node_id,$version,$plugins) = @_;
1115
1116    # Call post_delete on any plugins, having done the delete
1117    my @plugins = @{ $plugins || [ ] };
1118    foreach my $plugin (@plugins) {
1119        if ( $plugin->can( "post_delete" ) ) {
1120            $plugin->post_delete( 
1121                                node     => $name,
1122                                node_id  => $node_id,
1123                                version  => $version );
1124        }
1125    }
1126}
1127
1128=item B<list_recent_changes>
1129
1130  # Nodes changed in last 7 days - each node listed only once.
1131  my @nodes = $store->list_recent_changes( days => 7 );
1132
1133  # All changes in last 7 days - nodes changed more than once will
1134  # be listed more than once.
1135  my @nodes = $store->list_recent_changes(
1136                                           days => 7,
1137                                           include_all_changes => 1,
1138                                         );
1139
1140  # Nodes changed between 1 and 7 days ago.
1141  my @nodes = $store->list_recent_changes( between_days => [ 1, 7 ] );
1142
1143  # Nodes changed since a given time.
1144  my @nodes = $store->list_recent_changes( since => 1036235131 );
1145
1146  # Most recent change and its details.
1147  my @nodes = $store->list_recent_changes( last_n_changes => 1 );
1148  print "Node:          $nodes[0]{name}";
1149  print "Last modified: $nodes[0]{last_modified}";
1150  print "Comment:       $nodes[0]{metadata}{comment}";
1151
1152  # Last 5 restaurant nodes edited.
1153  my @nodes = $store->list_recent_changes(
1154      last_n_changes => 5,
1155      metadata_is    => { category => "Restaurants" }
1156  );
1157
1158  # Last 5 nodes edited by Kake.
1159  my @nodes = $store->list_recent_changes(
1160      last_n_changes => 5,
1161      metadata_was   => { username => "Kake" }
1162  );
1163
1164  # All minor edits made by Earle in the last week.
1165  my @nodes = $store->list_recent_changes(
1166      days           => 7,
1167      metadata_was   => { username  => "Earle",
1168                          edit_type => "Minor tidying." }
1169  );
1170
1171  # Last 10 changes that weren't minor edits.
1172  my @nodes = $store->list_recent_changes(
1173      last_n_changes => 5,
1174      metadata_wasnt  => { edit_type => "Minor tidying" }
1175  );
1176
1177You I<must> supply one of the following constraints: C<days>
1178(integer), C<since> (epoch), C<last_n_changes> (integer).
1179
1180You I<may> also supply I<either> C<metadata_is> (and optionally
1181C<metadata_isnt>), I<or> C<metadata_was> (and optionally
1182C<metadata_wasnt>). Each of these should be a ref to a hash with
1183scalar keys and values.  If the hash has more than one entry, then
1184only changes satisfying I<all> criteria will be returned when using
1185C<metadata_is> or C<metadata_was>, but all changes which fail to
1186satisfy any one of the criteria will be returned when using
1187C<metadata_isnt> or C<metadata_is>.
1188
1189C<metadata_is> and C<metadata_isnt> look only at the metadata that the
1190node I<currently> has. C<metadata_was> and C<metadata_wasnt> take into
1191account the metadata of previous versions of a node.
1192
1193Returns results as an array, in reverse chronological order.  Each
1194element of the array is a reference to a hash with the following entries:
1195
1196=over 4
1197
1198=item * B<name>: the name of the node
1199
1200=item * B<version>: the latest version number
1201
1202=item * B<last_modified>: the timestamp of when it was last modified
1203
1204=item * B<metadata>: a ref to a hash containing any metadata attached
1205to the current version of the node
1206
1207=back
1208
1209Unless you supply C<include_all_changes>, C<metadata_was> or
1210C<metadata_wasnt>, each node will only be returned once regardless of
1211how many times it has been changed recently.
1212
1213By default, the case-sensitivity of both C<metadata_type> and
1214C<metadata_value> depends on your database - if it will return rows
1215with an attribute value of "Pubs" when you asked for "pubs", or not.
1216If you supply a true value to the C<ignore_case> parameter, then you
1217can be sure of its being case-insensitive.  This is recommended.
1218
1219=cut
1220
1221sub list_recent_changes {
1222    my $self = shift;
1223    my %args = @_;
1224    if ($args{since}) {
1225        return $self->_find_recent_changes_by_criteria( %args );
1226    } elsif ($args{between_days}) {
1227        return $self->_find_recent_changes_by_criteria( %args );
1228    } elsif ( $args{days} ) {
1229        my $now = localtime;
1230        my $then = $now - ( ONE_DAY * $args{days} );
1231        $args{since} = $then;
1232        delete $args{days};
1233        return $self->_find_recent_changes_by_criteria( %args );
1234    } elsif ( $args{last_n_changes} ) {
1235        $args{limit} = delete $args{last_n_changes};
1236        return $self->_find_recent_changes_by_criteria( %args );
1237    } else {
1238        croak "Need to supply some criteria to list_recent_changes.";
1239    }
1240}
1241
1242sub _find_recent_changes_by_criteria {
1243    my ($self, %args) = @_;
1244    my ($since, $limit, $between_days, $ignore_case,
1245        $metadata_is,  $metadata_isnt, $metadata_was, $metadata_wasnt ) =
1246         @args{ qw( since limit between_days ignore_case
1247                    metadata_is metadata_isnt metadata_was metadata_wasnt) };
1248    my $dbh = $self->dbh;
1249
1250    my @where;
1251    my @metadata_joins;
1252    my $main_table = $args{include_all_changes} ? "content" : "node";
1253    if ( $metadata_is || $metadata_isnt ) {
1254        if ( $metadata_is ) {
1255            my $i = 0;
1256            foreach my $type ( keys %$metadata_is ) {
1257                $i++;
1258                my $value  = $metadata_is->{$type};
1259                croak "metadata_is must have scalar values" if ref $value;
1260                my $mdt = "md_is_$i";
1261                push @metadata_joins, "LEFT JOIN metadata AS $mdt
1262                                 ON $main_table."
1263                                 . (($main_table eq "node") ? "id" : "node_id")
1264                                 . "=$mdt.node_id
1265                                 AND $main_table.version=$mdt.version\n";
1266                push @where, "( "
1267                         . $self->_get_comparison_sql(
1268                                          thing1      => "$mdt.metadata_type",
1269                                          thing2      => $dbh->quote($type),
1270                                          ignore_case => $ignore_case,
1271                                                     )
1272                         . " AND "
1273                         . $self->_get_comparison_sql(
1274                                          thing1      => "$mdt.metadata_value",
1275                                          thing2      => $dbh->quote( $self->charset_encode($value) ),
1276                                          ignore_case => $ignore_case,
1277                                                     )
1278                         . " )";
1279            }
1280        }
1281        if ( $metadata_isnt ) {
1282            foreach my $type ( keys %$metadata_isnt ) {
1283                my $value  = $metadata_isnt->{$type};
1284                croak "metadata_isnt must have scalar values" if ref $value;
1285            }
1286            my @omits = $self->_find_recent_changes_by_criteria(
1287                since        => $since,
1288                between_days => $between_days,
1289                metadata_is  => $metadata_isnt,
1290                ignore_case  => $ignore_case,
1291            );
1292            foreach my $omit ( @omits ) {
1293                push @where, "( node.name != " . $dbh->quote($omit->{name})
1294                     . "  OR node.version != " . $dbh->quote($omit->{version})
1295                     . ")";
1296            }
1297        }
1298    } else {
1299        if ( $metadata_was ) {
1300            $main_table = "content";
1301            my $i = 0;
1302            foreach my $type ( keys %$metadata_was ) {
1303                $i++;
1304                my $value  = $metadata_was->{$type};
1305                croak "metadata_was must have scalar values" if ref $value;
1306                my $mdt = "md_was_$i";
1307                push @metadata_joins, "LEFT JOIN metadata AS $mdt
1308                                 ON $main_table.node_id=$mdt.node_id
1309                                 AND $main_table.version=$mdt.version\n";
1310                push @where, "( "
1311                         . $self->_get_comparison_sql(
1312                                          thing1      => "$mdt.metadata_type",
1313                                          thing2      => $dbh->quote($type),
1314                                          ignore_case => $ignore_case,
1315                                                     )
1316                         . " AND "
1317                         . $self->_get_comparison_sql(
1318                                          thing1      => "$mdt.metadata_value",
1319                                          thing2      => $dbh->quote( $self->charset_encode($value) ),
1320                                          ignore_case => $ignore_case,
1321                                                     )
1322                         . " )";
1323            }
1324        }
1325        if ( $metadata_wasnt ) {
1326            $main_table = "content";
1327            foreach my $type ( keys %$metadata_wasnt ) {
1328                my $value  = $metadata_was->{$type};
1329                croak "metadata_was must have scalar values" if ref $value;
1330            }
1331            my @omits = $self->_find_recent_changes_by_criteria(
1332                since        => $since,
1333                between_days => $between_days,
1334                metadata_was => $metadata_wasnt,
1335                ignore_case  => $ignore_case,
1336            );
1337            foreach my $omit ( @omits ) {
1338                push @where, "( node.name != " . $dbh->quote($omit->{name})
1339                 . "  OR content.version != " . $dbh->quote($omit->{version})
1340                 . ")";
1341            }
1342        }
1343    }
1344
1345    if ( $since ) {
1346        my $timestamp = $self->_get_timestamp( $since );
1347        push @where, "$main_table.modified >= " . $dbh->quote($timestamp);
1348    } elsif ( $between_days ) {
1349        my $now = localtime;
1350        # Start is the larger number of days ago.
1351        my ($start, $end) = @$between_days;
1352        ($start, $end) = ($end, $start) if $start < $end;
1353        my $ts_start = $self->_get_timestamp( $now - (ONE_DAY * $start) ); 
1354        my $ts_end = $self->_get_timestamp( $now - (ONE_DAY * $end) ); 
1355        push @where, "$main_table.modified >= " . $dbh->quote($ts_start);
1356        push @where, "$main_table.modified <= " . $dbh->quote($ts_end);
1357    }
1358
1359    my $sql = "SELECT DISTINCT
1360                               node.name,
1361                               $main_table.version,
1362                               $main_table.modified
1363               FROM $main_table
1364              "
1365              . (
1366                  ($main_table ne "node") 
1367                    ? "INNER JOIN node ON (id = $main_table.node_id) "
1368                    : ""
1369              )
1370            . join("\n", @metadata_joins)
1371            . (
1372                scalar @where
1373                              ? " WHERE " . join(" AND ",@where) 
1374                              : ""
1375              )
1376            . " ORDER BY $main_table.modified DESC";
1377    if ( $limit ) {
1378        croak "Bad argument $limit" unless $limit =~ /^\d+$/;
1379        $sql .= " LIMIT $limit";
1380    }
1381#print "\n\n$sql\n\n";
1382    my $nodesref = $dbh->selectall_arrayref($sql);
1383    my @finds = map { { name          => $_->[0],
1384                        version       => $_->[1],
1385                        last_modified => $_->[2] }
1386                    } @$nodesref;
1387    foreach my $find ( @finds ) {
1388        my %metadata;
1389        my $sth = $dbh->prepare( "SELECT metadata_type, metadata_value
1390                                  FROM node
1391                                  INNER JOIN metadata
1392                                        ON (id = node_id)
1393                                  WHERE name=?
1394                                  AND metadata.version=?" );
1395        $sth->execute( $find->{name}, $find->{version} );
1396        while ( my ($type, $value) = $self->charset_decode( $sth->fetchrow_array ) ) {
1397            if ( defined $metadata{$type} ) {
1398                push @{$metadata{$type}}, $value;
1399            } else {
1400                $metadata{$type} = [ $value ];
1401            }
1402        }
1403        $find->{metadata} = \%metadata;
1404    }
1405    return @finds;
1406}
1407
1408=item B<list_all_nodes>
1409
1410  my @nodes = $store->list_all_nodes();
1411
1412Returns a list containing the name of every existing node.  The list
1413won't be in any kind of order; do any sorting in your calling script.
1414
1415=cut
1416
1417sub list_all_nodes {
1418    my $self = shift;
1419    my $dbh = $self->dbh;
1420    my $sql = "SELECT name FROM node;";
1421    my $nodes = $dbh->selectall_arrayref($sql); 
1422    return ( map { $self->charset_decode( $_->[0] ) } (@$nodes) );
1423}
1424
1425=item B<list_node_all_versions>
1426
1427  my @all_versions = $store->list_node_all_versions(
1428                                                                                name => 'HomePage',
1429                                                                                with_content => 1,
1430                                                                                with_metadata => 0
1431                                         );
1432
1433Returns all the versions of a node, optionally including the content
1434and metadata, as an array of hashes (newest versions first).
1435
1436=cut
1437
1438sub list_node_all_versions {
1439    my ($self, %args) = @_;
1440
1441        my ($node_id,$name,$with_content,$with_metadata) = 
1442                        @args{ qw( node_id name with_content with_metadata ) };
1443
1444    my $dbh = $self->dbh;
1445        my $sql;
1446
1447        # If they only gave us the node name, get the node id
1448    unless ($node_id) {
1449        $sql = "SELECT id FROM node WHERE name=" . $dbh->quote($name);
1450        $node_id = $dbh->selectrow_array($sql);
1451    }
1452
1453        # If they didn't tell us what they wanted / we couldn't find it,
1454        #  return an empty array
1455        return () unless($node_id);
1456
1457
1458        # Build up our SQL
1459        $sql = "SELECT id, name, content.version, content.modified ";
1460        if($with_content) {
1461                $sql .= ", content.text ";
1462        }
1463        if($with_metadata) {
1464                $sql .= ", metadata_type, metadata_value ";
1465        }
1466        $sql .= " FROM node INNER JOIN content ON (id = content.node_id) ";
1467        if($with_metadata) {
1468                $sql .= " LEFT OUTER JOIN metadata ON (id = metadata.node_id AND content.version = metadata.version) ";
1469        }
1470        $sql .= " WHERE id = ? ORDER BY content.version DESC";
1471
1472        # Do the fetch
1473    my $sth = $dbh->prepare( $sql );
1474    $sth->execute( $node_id );
1475
1476        # Need to hold onto the last row by hash ref, so we don't trash
1477        #  it every time
1478        my %first_data;
1479        my $dataref = \%first_data;
1480
1481        # Haul out the data
1482        my @versions;
1483        while(my @results = $sth->fetchrow_array) {
1484                my %data = %$dataref;
1485
1486                # Is it the same version as last time?
1487                if(%data && $data{'version'} != $results[2]) {
1488                        # New version
1489                        push @versions, $dataref;
1490                        %data = ();
1491                } else {
1492                        # Same version as last time, must be more metadata
1493                }
1494
1495                # Grab the core data (will be the same on multi-row for metadata)
1496                @data{ qw( node_id name version last_modified ) } = @results;
1497
1498                my $i = 4;
1499                if($with_content) {
1500                        $data{'content'} = $results[$i];
1501                        $i++;
1502                }
1503                if($with_metadata) {
1504                        my ($m_type,$m_value) = @results[$i,($i+1)];
1505                        unless($data{'metadata'}) { $data{'metadata'} = {}; }
1506                        if($m_type) {
1507                                $data{'metadata'}->{$m_type} = $m_value;
1508                        }
1509                }
1510
1511                # Save where we've got to
1512                $dataref = \%data;
1513        }
1514
1515        # Handle final row saving
1516        if($dataref) {
1517                push @versions, $dataref;
1518        }
1519
1520        # Return
1521        return @versions;
1522}
1523
1524=item B<list_nodes_by_metadata>
1525
1526  # All documentation nodes.
1527  my @nodes = $store->list_nodes_by_metadata(
1528      metadata_type  => "category",
1529      metadata_value => "documentation",
1530      ignore_case    => 1,   # optional but recommended (see below)
1531  );
1532
1533  # All pubs in Hammersmith.
1534  my @pubs = $store->list_nodes_by_metadata(
1535      metadata_type  => "category",
1536      metadata_value => "Pub",
1537  );
1538  my @hsm  = $store->list_nodes_by_metadata(
1539      metadata_type  => "category",
1540      metadata_value  => "Hammersmith",
1541  );
1542  my @results = my_l33t_method_for_ANDing_arrays( \@pubs, \@hsm );
1543
1544Returns a list containing the name of every node whose caller-supplied
1545metadata matches the criteria given in the parameters.
1546
1547By default, the case-sensitivity of both C<metadata_type> and
1548C<metadata_value> depends on your database - if it will return rows
1549with an attribute value of "Pubs" when you asked for "pubs", or not.
1550If you supply a true value to the C<ignore_case> parameter, then you
1551can be sure of its being case-insensitive.  This is recommended.
1552
1553If you don't supply any criteria then you'll get an empty list.
1554
1555This is a really really really simple way of finding things; if you
1556want to be more complicated then you'll need to call the method
1557multiple times and combine the results yourself, or write a plugin.
1558
1559=cut
1560
1561sub list_nodes_by_metadata {
1562    my ($self, %args) = @_;
1563    my ( $type, $value ) = @args{ qw( metadata_type metadata_value ) };
1564    return () unless $type;
1565
1566    my $dbh = $self->dbh;
1567    if ( $args{ignore_case} ) {
1568        $type  = lc( $type  );
1569        $value = lc( $value );
1570    }
1571    my $sql =
1572         $self->_get_list_by_metadata_sql( ignore_case => $args{ignore_case} );
1573    my $sth = $dbh->prepare( $sql );
1574    $sth->execute( $type, $self->charset_encode($value) );
1575    my @nodes;
1576    while ( my ($node) = $sth->fetchrow_array ) {
1577        push @nodes, $node;
1578    }
1579    return @nodes;
1580}
1581
1582sub _get_list_by_metadata_sql {
1583    # can be over-ridden by database-specific subclasses
1584    return "SELECT node.name "
1585                 . "FROM node "
1586                 . "INNER JOIN metadata "
1587                 . "    ON (node.id = metadata.node_id) "
1588                 . "WHERE node.version=metadata.version "
1589                 . "AND metadata.metadata_type = ? "
1590                 . "AND metadata.metadata_value = ? ";
1591}
1592
1593sub _get_comparison_sql {
1594    my ($self, %args) = @_;
1595    # can be over-ridden by database-specific subclasses
1596    return "$args{thing1} = $args{thing2}";
1597}
1598
1599sub _get_node_exists_ignore_case_sql {
1600    # can be over-ridden by database-specific subclasses
1601    return "SELECT name FROM node WHERE name = ? ";
1602}
1603
1604=item B<list_unmoderated_nodes>
1605
1606  my @nodes = $wiki->list_unmoderated_nodes();
1607  my @nodes = $wiki->list_unmoderated_nodes(
1608                                                only_where_latest => 1
1609                                            );
1610
1611  $nodes[0]->{'name'}              # The name of the node
1612  $nodes[0]->{'node_id'}           # The id of the node
1613  $nodes[0]->{'version'}           # The version in need of moderation
1614  $nodes[0]->{'moderated_version'} # The newest moderated version
1615
1616  With only_where_latest set, return the id, name and version of all the
1617   nodes where the most recent version needs moderation.
1618  Otherwise, returns the id, name and version of all node versions that need
1619   to be moderated.
1620
1621=cut
1622
1623sub list_unmoderated_nodes {
1624        my ($self,%args) = @_;
1625
1626        my $only_where_lastest = $args{'only_where_latest'};
1627
1628        my $sql =
1629                 "SELECT "
1630                ."      id, name, "
1631                ."      node.version AS last_moderated_version, "
1632                ."      content.version AS version "
1633                ."FROM content "
1634                ."INNER JOIN node "
1635                ."      ON (id = node_id) "
1636                ."WHERE moderated = ? "
1637        ;
1638        if($only_where_lastest) {
1639                $sql .= "AND node.version = content.version ";
1640        }
1641        $sql .= "ORDER BY name, content.version ";
1642
1643        # Query
1644    my $dbh = $self->dbh;
1645    my $sth = $dbh->prepare( $sql );
1646    $sth->execute( "0" );
1647
1648        my @nodes;
1649        while(my @results = $sth->fetchrow_array) {
1650                my %data;
1651                @data{ qw( node_id name moderated_version version ) } = @results;
1652                push @nodes, \%data;
1653        }
1654
1655        return @nodes;
1656}
1657
1658=item B<schema_current>
1659
1660  my ($code_version, $db_version) = $store->schema_current;
1661  if ($code_version == $db_version)
1662      # Do stuff
1663  } else {
1664      # Bail
1665  }
1666
1667=cut
1668
1669sub schema_current {
1670    my $self = shift;
1671    my $dbh = $self->dbh;
1672    my $sth;
1673    eval { $sth = $dbh->prepare("SELECT version FROM schema_info") };
1674    if ($@) {
1675        return ($SCHEMA_VER, 0);
1676    }
1677    eval { $sth->execute };
1678    if ($@) {
1679        return ($SCHEMA_VER, 0);
1680    }
1681    my $version;
1682    eval { $version = $sth->fetchrow_array };
1683    if ($@) {
1684        return ($SCHEMA_VER, 0);
1685    } else {
1686        return ($SCHEMA_VER, $version);
1687    }
1688}
1689
1690
1691=item B<dbh>
1692
1693  my $dbh = $store->dbh;
1694
1695Returns the database handle belonging to this storage backend instance.
1696
1697=cut
1698
1699sub dbh {
1700    my $self = shift;
1701    return $self->{_dbh};
1702}
1703
1704=item B<dbname>
1705
1706  my $dbname = $store->dbname;
1707
1708Returns the name of the database used for backend storage.
1709
1710=cut
1711
1712sub dbname {
1713    my $self = shift;
1714    return $self->{_dbname};
1715}
1716
1717=item B<dbuser>
1718
1719  my $dbuser = $store->dbuser;
1720
1721Returns the username used to connect to the database used for backend storage.
1722
1723=cut
1724
1725sub dbuser {
1726    my $self = shift;
1727    return $self->{_dbuser};
1728}
1729
1730=item B<dbpass>
1731
1732  my $dbpass = $store->dbpass;
1733
1734Returns the password used to connect to the database used for backend storage.
1735
1736=cut
1737
1738sub dbpass {
1739    my $self = shift;
1740    return $self->{_dbpass};
1741}
1742
1743=item B<dbhost>
1744
1745  my $dbhost = $store->dbhost;
1746
1747Returns the optional host used to connect to the database used for
1748backend storage.
1749
1750=cut
1751
1752sub dbhost {
1753    my $self = shift;
1754    return $self->{_dbhost};
1755}
1756
1757# Cleanup.
1758sub DESTROY {
1759    my $self = shift;
1760    return if $self->{_external_dbh};
1761    my $dbh = $self->dbh;
1762    $dbh->disconnect if $dbh;
1763}
1764
1765# decode a string of octets into perl's internal encoding, based on the
1766# charset parameter we were passed. Takes a list, returns a list.
1767sub charset_decode {
1768  my $self = shift;
1769  my @input = @_;
1770  if ($CAN_USE_ENCODE) {
1771    my @output;
1772    for (@input) {
1773      push( @output, Encode::decode( $self->{_charset}, $_ ) );
1774    }
1775    return @output;
1776  }
1777  return @input;
1778}
1779
1780# convert a perl string into a series of octets we can put into the database
1781# takes a list, returns a list
1782sub charset_encode {
1783  my $self = shift;
1784  my @input = @_;
1785  if ($CAN_USE_ENCODE) {
1786    my @output;
1787    for (@input) {
1788      push( @output, Encode::encode( $self->{_charset}, $_ ) );
1789    }
1790    return @output;
1791  }
1792  return @input;
1793}
1794
17951;
Note: See TracBrowser for help on using the repository browser.