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

Last change on this file since 466 was 466, checked in by Dominic Hargreaves, 13 years ago

write_node: return the version of the node that was just committed, if successful (fixes #42)

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 70.2 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.29';
15my $SCHEMA_VER = 10;
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=head1 NAME
28
29Wiki::Toolkit::Store::Database - parent class for database storage backends
30for Wiki::Toolkit
31
32=head1 SYNOPSIS
33
34This is probably only useful for Wiki::Toolkit developers.
35
36  # See below for parameter details.
37  my $store = Wiki::Toolkit::Store::MySQL->new( %config );
38
39=head1 METHODS
40
41=over 4
42
43=item B<new>
44
45  my $store = Wiki::Toolkit::Store::MySQL->new( dbname  => "wiki",
46                        dbuser  => "wiki",
47                        dbpass  => "wiki",
48                        dbhost  => "db.example.com",
49                        dbport  => 1234,
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>, C<dbhost> and C<dbport>
60are optional, but you'll want to supply them unless your database's
61connection method doesn't require them.
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->{_dbport} = $args{dbport} || "";
105        $self->{_charset} = $args{charset} || "iso-8859-1";
106
107        # Connect to database and store the database handle.
108        my ($dbname, $dbuser, $dbpass, $dbhost, $dbport) =
109                           @$self{qw(_dbname _dbuser _dbpass _dbhost _dbport)};
110        my $dsn = $self->_dsn($dbname, $dbhost, $dbport)
111            or croak "No data source string provided by class";
112        $self->{_dbh} = DBI->connect( $dsn, $dbuser, $dbpass,
113                      { PrintError => 0, RaiseError => 1,
114                        AutoCommit => 1 } )
115            or croak "Can't connect to database $dbname using $dsn: "
116                   . DBI->errstr;
117    }
118
119    my ($cur_ver, $db_ver) = $self->schema_current;
120    if ($db_ver < $cur_ver) {
121        croak "Database schema version $db_ver is too old (need $cur_ver)";
122    } elsif ($db_ver > $cur_ver) {
123        croak "Database schema version $db_ver is too new (need $cur_ver)";
124    }
125
126    return $self;
127}
128
129# Internal method, used to handle the logic of how to add up return
130#  values from pre_ plugins
131sub handle_pre_plugin_ret {
132    my ($running_total_ref,$result) = @_;
133
134    if(($result && $result == 0) || !$result) {
135        # No opinion, no need to change things
136    } elsif($result == -1 || $result == 1) {
137        # Increase or decrease as requested
138        $$running_total_ref += $result;
139    } else {
140        # Invalid return code
141        warn("Pre_ plugin returned invalid accept/deny value of '$result'");
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        $sth->finish;
346        return lc($found_name) eq lc($args{name}) ? 1 : 0;
347    }
348}
349
350sub _do_old_node_exists {
351    my ($self, $node) = @_;
352    my %data = $self->retrieve_node($node) or return ();
353    return $data{version}; # will be 0 if node doesn't exist, >=1 otherwise
354}
355
356=item B<verify_checksum>
357
358  my $ok = $store->verify_checksum($node, $checksum);
359
360Sees whether your checksum is current for the given node. Returns true
361if so, false if not.
362
363B<NOTE:> Be aware that when called directly and without locking, this
364might not be accurate, since there is a small window between the
365checking and the returning where the node might be changed, so
366B<don't> rely on it for safe commits; use C<write_node> for that. It
367can however be useful when previewing edits, for example.
368
369=cut
370
371sub verify_checksum {
372    my ($self, $node, $checksum) = @_;
373#warn $self;
374    my %node_data = $self->_retrieve_node_data( name => $node );
375    return ( $checksum eq $self->_checksum( %node_data ) );
376}
377
378=item B<list_backlinks>
379
380  # List all nodes that link to the Home Page.
381  my @links = $store->list_backlinks( node => "Home Page" );
382
383=cut
384
385sub list_backlinks {
386    my ( $self, %args ) = @_;
387    my $node = $args{node};
388    croak "Must supply a node name" unless $node;
389    my $dbh = $self->dbh;
390    # XXX see comment in list_dangling_links
391    my $sql = "SELECT link_from FROM internal_links INNER JOIN
392               node AS node_from ON node_from.name=internal_links.link_from
393               WHERE link_to="
394            . $dbh->quote($node);
395    my $sth = $dbh->prepare($sql);
396    $sth->execute or croak $dbh->errstr;
397    my @backlinks;
398    while ( my ($backlink) = $self->charset_decode( $sth->fetchrow_array ) ) {
399        push @backlinks, $backlink;
400    }
401    return @backlinks;
402}
403
404=item B<list_dangling_links>
405
406  # List all nodes that have been linked to from other nodes but don't
407  # yet exist.
408  my @links = $store->list_dangling_links;
409
410Each node is returned once only, regardless of how many other nodes
411link to it.
412
413=cut
414
415sub list_dangling_links {
416    my $self = shift;
417    my $dbh = $self->dbh;
418    # XXX this is really hiding an inconsistency in the database;
419    # should really fix the constraints so that this inconsistency
420    # cannot be introduced; also rework this table completely so
421    # that it uses IDs, not node names (will simplify rename_node too)
422    my $sql = "SELECT DISTINCT internal_links.link_to
423               FROM internal_links INNER JOIN node AS node_from ON
424               node_from.name=internal_links.link_from LEFT JOIN node
425               AS node_to ON node_to.name=internal_links.link_to
426               WHERE node_to.version IS NULL";
427    my $sth = $dbh->prepare($sql);
428    $sth->execute or croak $dbh->errstr;
429    my @links;
430    while ( my ($link) = $self->charset_decode( $sth->fetchrow_array ) ) {
431        push @links, $link;
432    }
433    return @links;
434}
435
436=item B<write_node_post_locking>
437
438  $store->write_node_post_locking( node     => $node,
439                                   content  => $content,
440                                   links_to => \@links_to,
441                                   metadata => \%metadata,
442                                   requires_moderation => $requires_moderation,
443                                   plugins  => \@plugins   )
444      or handle_error();
445
446Writes the specified content into the specified node, then calls
447C<post_write> on all supplied plugins, with arguments C<node>,
448C<version>, C<content>, C<metadata>.
449
450Making sure that locking/unlocking/transactions happen is left up to
451you (or your chosen subclass). This method shouldn't really be used
452directly as it might overwrite someone else's changes. Croaks on error
453but otherwise returns the version number of the update just made.
454
455Supplying a ref to an array of nodes that this ones links to is
456optional, but if you do supply it then this node will be returned when
457calling C<list_backlinks> on the nodes in C<@links_to>. B<Note> that
458if you don't supply the ref then the store will assume that this node
459doesn't link to any others, and update itself accordingly.
460
461The metadata hashref is also optional, as is requires_moderation.
462
463B<Note> on the metadata hashref: Any data in here that you wish to
464access directly later must be a key-value pair in which the value is
465either a scalar or a reference to an array of scalars.  For example:
466
467  $wiki->write_node( "Calthorpe Arms", "nice pub", $checksum,
468                     { category => [ "Pubs", "Bloomsbury" ],
469                       postcode => "WC1X 8JR" } );
470
471  # and later
472
473  my @nodes = $wiki->list_nodes_by_metadata(
474      metadata_type  => "category",
475      metadata_value => "Pubs"             );
476
477For more advanced usage (passing data through to registered plugins)
478you may if you wish pass key-value pairs in which the value is a
479hashref or an array of hashrefs. The data in the hashrefs will not be
480stored as metadata; it will be checksummed and the checksum will be
481stored instead (as C<__metadatatypename__checksum>). Such data can
482I<only> be accessed via plugins.
483
484=cut
485
486sub write_node_post_locking {
487    my ($self, %args) = @_;
488    my ($node, $content, $links_to_ref, $metadata_ref, $requires_moderation) =
489             @args{ qw( node content links_to metadata requires_moderation) };
490    my $dbh = $self->dbh;
491
492    my $timestamp = $self->_get_timestamp();
493    my @links_to = @{ $links_to_ref || [] }; # default to empty array
494    my $version;
495    unless($requires_moderation) { $requires_moderation = 0; }
496
497    # Call pre_write on any plugins, in case they want to tweak anything
498    my @preplugins = @{ $args{plugins} || [ ] };
499    my $write_allowed = 1;
500    foreach my $plugin (@preplugins) {
501        if ( $plugin->can( "pre_write" ) ) {
502            handle_pre_plugin_ret(
503                \$write_allowed,
504                $plugin->pre_write( 
505                    node     => \$node,
506                    content  => \$content,
507                    metadata => \$metadata_ref )
508            );
509        }
510    }
511    if($write_allowed < 1) {
512        # The plugins didn't want to allow this action
513        return -1;
514    }
515
516    # Either inserting a new page or updating an old one.
517    my $sql = "SELECT count(*) FROM node WHERE name=" . $dbh->quote($node);
518    my $exists = @{ $dbh->selectcol_arrayref($sql) }[0] || 0;
519
520
521    # If it doesn't exist, add it right now
522    if(! $exists) {
523        # Add in a new version
524        $version = 1;
525
526        # Handle initial moderation
527        my $node_content = $content;
528        if($requires_moderation) {
529            $node_content = "=== This page has yet to be moderated. ===";
530        }
531
532        # Add the node and content
533        my $add_sql = 
534             "INSERT INTO node "
535            ."    (name, version, text, modified, moderate) "
536            ."VALUES (?, ?, ?, ?, ?)";
537        my $add_sth = $dbh->prepare($add_sql);
538        $add_sth->execute(
539            map{ $self->charset_encode($_) }
540                ($node, $version, $node_content, $timestamp, $requires_moderation)
541        ) or croak "Error updating database: " . DBI->errstr;
542    }
543
544    # Get the ID of the node we've added / we're about to update
545    # Also get the moderation status for it
546    $sql = "SELECT id, moderate FROM node WHERE name=" . $dbh->quote($node);
547    my ($node_id,$node_requires_moderation) = $dbh->selectrow_array($sql);
548
549    # Only update node if it exists, and moderation isn't enabled on the node
550    # Whatever happens, if it exists, generate a new version number
551    if($exists) {
552        # Get the new version number
553        $sql = "SELECT max(content.version) FROM node
554                INNER JOIN content ON (id = node_id)
555                WHERE name=" . $dbh->quote($node);
556        $version = @{ $dbh->selectcol_arrayref($sql) }[0] || 0;
557        croak "Can't get version number" unless $version;
558        $version++;
559
560        # Update the node only if node doesn't require moderation
561        if(!$node_requires_moderation) {
562            $sql = "UPDATE node SET version=" . $dbh->quote($version)
563             . ", text=" . $dbh->quote($self->charset_encode($content))
564             . ", modified=" . $dbh->quote($timestamp)
565             . " WHERE name=" . $dbh->quote($self->charset_encode($node));
566            $dbh->do($sql) or croak "Error updating database: " . DBI->errstr;
567        }
568
569        # You can't use this to enable moderation on an existing node
570        if($requires_moderation) {
571           warn("Moderation not added to existing node '$node', use normal moderation methods instead");
572        }
573    }
574
575
576    # Now node is updated (if required), add to the history
577    my $add_sql = 
578         "INSERT INTO content "
579        ."    (node_id, version, text, modified, moderated) "
580        ."VALUES (?, ?, ?, ?, ?)";
581    my $add_sth = $dbh->prepare($add_sql);
582    $add_sth->execute(
583        map { $self->charset_encode($_) }
584            ($node_id, $version, $content, $timestamp, (1-$node_requires_moderation))
585    ) or croak "Error updating database: " . DBI->errstr;
586
587
588    # Update the backlinks.
589    $dbh->do("DELETE FROM internal_links WHERE link_from="
590             . $dbh->quote($self->charset_encode($node)) ) or croak $dbh->errstr;
591    foreach my $links_to ( @links_to ) {
592        $sql = "INSERT INTO internal_links (link_from, link_to) VALUES ("
593             . join(", ", map { $dbh->quote($self->charset_encode($_)) } ( $node, $links_to ) ) . ")";
594        # Better to drop a backlink or two than to lose the whole update.
595        # Shevek wants a case-sensitive wiki, Jerakeen wants a case-insensitive
596        # one, MySQL compares case-sensitively on varchars unless you add
597        # the binary keyword.  Case-sensitivity to be revisited.
598        eval { $dbh->do($sql); };
599        carp "Couldn't index backlink: " . $dbh->errstr if $@;
600    }
601
602    # And also store any metadata.  Note that any entries already in the
603    # metadata table refer to old versions, so we don't need to delete them.
604    my %metadata = %{ $metadata_ref || {} }; # default to no metadata
605    foreach my $type ( keys %metadata ) {
606        my $val = $metadata{$type};
607
608        # We might have one or many values; make an array now to merge cases.
609        my @values = (ref $val and ref $val eq 'ARRAY') ? @$val : ( $val );
610
611        # Find out whether all values for this type are scalars.
612        my $all_scalars = 1;
613        foreach my $value (@values) {
614            $all_scalars = 0 if ref $value;
615        }
616
617        # For adding to metadata
618        my $add_sql = 
619              "INSERT INTO metadata "
620             ."   (node_id, version, metadata_type, metadata_value) "
621             ."VALUES (?, ?, ?, ?)";
622        my $add_sth = $dbh->prepare($add_sql);
623
624        # If all values for this type are scalars, strip out any duplicates
625        # and store the data.
626        if ( $all_scalars ) {
627            my %unique = map { $_ => 1 } @values;
628            @values = keys %unique;
629
630            foreach my $value ( @values ) {
631                $add_sth->execute(
632                    map { $self->charset_encode($_) }
633                        ( $node_id, $version, $type, $value )
634                ) or croak $dbh->errstr;
635            }
636        } else {
637            # Otherwise grab a checksum and store that.
638            my $type_to_store  = "__" . $type . "__checksum";
639            my $value_to_store = $self->_checksum_hashes( @values );
640            $add_sth->execute(
641                  map { $self->charset_encode($_) }
642                      ( $node_id, $version, $type_to_store, $value_to_store )
643            )  or croak $dbh->errstr;
644        }
645    }
646
647    # Finally call post_write on any plugins.
648    my @postplugins = @{ $args{plugins} || [ ] };
649    foreach my $plugin (@postplugins) {
650        if ( $plugin->can( "post_write" ) ) {
651            $plugin->post_write( 
652                node     => $node,
653                node_id  => $node_id,
654                version  => $version,
655                content  => $content,
656                metadata => $metadata_ref );
657        }
658    }
659
660    return $version;
661}
662
663# Returns the timestamp of now, unless epoch is supplied.
664sub _get_timestamp {
665    my $self = shift;
666    # I don't care about no steenkin' timezones (yet).
667    my $time = shift || localtime; # Overloaded by Time::Piece.
668    unless( ref $time ) {
669    $time = localtime($time); # Make it into an object for strftime
670    }
671    return $time->strftime($timestamp_fmt); # global
672}
673
674=item B<rename_node>
675
676  $store->rename_node(
677                         old_name  => $node,
678                         new_name  => $new_node,
679                         wiki      => $wiki,
680                         create_new_versions => $create_new_versions,
681                       );
682
683Renames a node, updating any references to it as required (assuming your
684chosen formatter supports rename, that is).
685
686Uses the internal_links table to identify the nodes that link to this
687one, and re-writes any wiki links in these to point to the new name.
688
689=cut
690
691sub rename_node {
692    my ($self, %args) = @_;
693    my ($old_name,$new_name,$wiki,$create_new_versions) = 
694        @args{ qw( old_name new_name wiki create_new_versions ) };
695    my $dbh = $self->dbh;
696    my $formatter = $wiki->{_formatter};
697
698    my $timestamp = $self->_get_timestamp();
699
700    # Call pre_rename on any plugins, in case they want to tweak anything
701    my @preplugins = @{ $args{plugins} || [ ] };
702    my $rename_allowed = 1;
703    foreach my $plugin (@preplugins) {
704        if ( $plugin->can( "pre_rename" ) ) {
705            handle_pre_plugin_ret(
706                \$rename_allowed,
707                $plugin->pre_rename( 
708                    old_name => \$old_name,
709                    new_name => \$new_name,
710                    create_new_versions => \$create_new_versions,
711                )
712            );
713        }
714    }
715    if($rename_allowed < 1) {
716        # The plugins didn't want to allow this action
717        return -1;
718    }
719
720    # Get the ID of the node
721    my $sql = "SELECT id FROM node WHERE name=?";
722    my $sth = $dbh->prepare($sql);
723    $sth->execute($old_name);
724    my ($node_id) = $sth->fetchrow_array;
725    $sth->finish;
726
727
728    # If the formatter supports it, get a list of the internal
729    #  links to the page, which will have their links re-written
730    # (Do now before we update the name of the node, in case of
731    #  self links)
732    my @links;
733    if($formatter->can("rename_links")) {
734        # Get a list of the pages that link to the page
735        $sql = "SELECT id, name, version "
736            ."FROM internal_links "
737            ."INNER JOIN node "
738            ."    ON (link_from = name) "
739            ."WHERE link_to = ?";
740        $sth = $dbh->prepare($sql);
741        $sth->execute($old_name);
742
743        # Grab them all, then update, so no locking problems
744        while(my @l = $sth->fetchrow_array) { push (@links, \@l); }
745    }
746
747   
748    # Rename the node
749    $sql = "UPDATE node SET name=? WHERE id=?";
750    $sth = $dbh->prepare($sql);
751    $sth->execute($new_name,$node_id);
752
753
754    # Fix the internal links from this page
755    # (Otherwise write_node will get confused if we rename links later on)
756    $sql = "UPDATE internal_links SET link_from=? WHERE link_from=?";
757    $sth = $dbh->prepare($sql);
758    $sth->execute($new_name,$old_name);
759
760
761    # Update the text of internal links, if the formatter supports it
762    if($formatter->can("rename_links")) {
763        # Update the linked pages (may include renamed page)
764        foreach my $l (@links) {
765            my ($page_id, $page_name, $page_version) = @$l;
766            # Self link special case
767            if($page_name eq $old_name) { $page_name = $new_name; }
768
769            # Grab the latest version of that page
770            my %page = $self->retrieve_node(
771                    name=>$page_name, version=>$page_version
772            );
773
774            # Update the content of the page
775            my $new_content = 
776                $formatter->rename_links($old_name,$new_name,$page{'content'});
777
778            # Did it change?
779            if($new_content ne $page{'content'}) {
780                # Write the updated page out
781                if($create_new_versions) {
782                    # Write out as a new version of the node
783                    # (This will also fix our internal links)
784                    $wiki->write_node(
785                                $page_name, 
786                                $new_content,
787                                $page{checksum},
788                                $page{metadata}
789                    );
790                } else {
791                    # Just update the content
792                    my $update_sql_a = "UPDATE node SET text=? WHERE id=?";
793                    my $update_sql_b = "UPDATE content SET text=? ".
794                                       "WHERE node_id=? AND version=?";
795
796                    my $u_sth = $dbh->prepare($update_sql_a);
797                    $u_sth->execute($new_content,$page_id);
798                    $u_sth = $dbh->prepare($update_sql_b);
799                    $u_sth->execute($new_content,$page_id,$page_version);
800                }
801            }
802        }
803
804        # Fix the internal links if we didn't create new versions of the node
805        if(! $create_new_versions) {
806            $sql = "UPDATE internal_links SET link_to=? WHERE link_to=?";
807            $sth = $dbh->prepare($sql);
808            $sth->execute($new_name,$old_name);
809        }
810    } else {
811        warn("Internal links not updated following node rename - unsupported by formatter");
812    }
813
814    # Call post_rename on any plugins, in case they want to do anything
815    my @postplugins = @{ $args{plugins} || [ ] };
816    foreach my $plugin (@postplugins) {
817        if ( $plugin->can( "post_rename" ) ) {
818            $plugin->post_rename( 
819                old_name => $old_name,
820                new_name => $new_name,
821                node_id => $node_id,
822            );
823        }
824    }
825}
826
827=item B<moderate_node>
828
829  $store->moderate_node(
830                         name    => $node,
831                         version => $version
832                       );
833
834Marks the given version of the node as moderated. If this is the
835highest moderated version, then update the node's contents to hold
836this version.
837
838=cut
839
840sub moderate_node {
841    my $self = shift;
842    my %args = scalar @_ == 2 ? ( name => $_[0], version => $_[1] ) : @_;
843    my $dbh = $self->dbh;
844
845    my ($name,$version) = ($args{name},$args{version});
846
847    # Call pre_moderate on any plugins.
848    my @plugins = @{ $args{plugins} || [ ] };
849    my $moderation_allowed = 1;
850    foreach my $plugin (@plugins) {
851        if ( $plugin->can( "pre_moderate" ) ) {
852            handle_pre_plugin_ret(
853                \$moderation_allowed,
854                $plugin->pre_moderate( 
855                    node     => \$name,
856                    version  => \$version )
857            );
858        }
859    }
860    if($moderation_allowed < 1) {
861        # The plugins didn't want to allow this action
862        return -1;
863    }
864
865    # Get the ID of this node
866    my $id_sql = "SELECT id FROM node WHERE name=?";
867    my $id_sth = $dbh->prepare($id_sql);
868    $id_sth->execute($name);
869    my ($node_id) = $id_sth->fetchrow_array;
870    $id_sth->finish;
871
872    # Check what the current highest moderated version is
873    my $hv_sql = 
874         "SELECT max(version) "
875        ."FROM content "
876        ."WHERE node_id = ? "
877        ."AND moderated = ?";
878    my $hv_sth = $dbh->prepare($hv_sql);
879    $hv_sth->execute($node_id, "1") or croak $dbh->errstr;
880    my ($highest_mod_version) = $hv_sth->fetchrow_array;
881    $hv_sth->finish;
882    unless($highest_mod_version) { $highest_mod_version = 0; }
883
884    # Mark this version as moderated
885    my $update_sql = 
886         "UPDATE content "
887        ."SET moderated = ? "
888        ."WHERE node_id = ? "
889        ."AND version = ?";
890    my $update_sth = $dbh->prepare($update_sql);
891    $update_sth->execute("1", $node_id, $version) or croak $dbh->errstr;
892
893    # Are we now the highest moderated version?
894    if(int($version) > int($highest_mod_version)) {
895        # Newly moderated version is newer than previous moderated version
896        # So, make the current version the latest version
897        my %new_data = $self->retrieve_node( name => $name, version => $version );
898
899        # Make sure last modified is properly null, if not set
900        unless($new_data{last_modified}) { $new_data{last_modified} = undef; }
901
902        my $newv_sql = 
903             "UPDATE node "
904            ."SET version=?, text=?, modified=? "
905            ."WHERE id = ?";
906        my $newv_sth = $dbh->prepare($newv_sql);
907        $newv_sth->execute(
908            $version, $self->charset_encode($new_data{content}), 
909            $new_data{last_modified}, $node_id
910        ) or croak $dbh->errstr;
911    } else {
912        # A higher version is already moderated, so don't change node
913    }
914
915    # TODO: Do something about internal links, if required
916
917    # Finally call post_moderate on any plugins.
918    @plugins = @{ $args{plugins} || [ ] };
919    foreach my $plugin (@plugins) {
920        if ( $plugin->can( "post_moderate" ) ) {
921            $plugin->post_moderate( 
922                node     => $name,
923                node_id  => $node_id,
924                version  => $version );
925        }
926    }
927
928    return 1;
929}
930
931=item B<set_node_moderation>
932
933  $store->set_node_moderation(
934                         name     => $node,
935                         required => $required
936                       );
937
938Sets if new node versions will require moderation or not
939
940=cut
941
942sub set_node_moderation {
943    my $self = shift;
944    my %args = scalar @_ == 2 ? ( name => $_[0], required => $_[1] ) : @_;
945    my $dbh = $self->dbh;
946
947    my ($name,$required) = ($args{name},$args{required});
948
949    # Get the ID of this node
950    my $id_sql = "SELECT id FROM node WHERE name=?";
951    my $id_sth = $dbh->prepare($id_sql);
952    $id_sth->execute($name);
953    my ($node_id) = $id_sth->fetchrow_array;
954    $id_sth->finish;
955
956    # Check we really got an ID
957    unless($node_id) {
958        return 0;
959    }
960
961    # Mark it as requiring / not requiring moderation
962    my $mod_sql = 
963         "UPDATE node "
964        ."SET moderate = ? "
965        ."WHERE id = ? ";
966    my $mod_sth = $dbh->prepare($mod_sql);
967    $mod_sth->execute("$required", $node_id) or croak $dbh->errstr;
968
969    return 1;
970}
971
972=item B<delete_node>
973
974  $store->delete_node(
975                       name    => $node,
976                       version => $version,
977                       wiki    => $wiki
978                     );
979
980C<version> is optional.  If it is supplied then only that version of
981the node will be deleted.  Otherwise the node and all its history will
982be completely deleted.
983
984C<wiki> is also optional, but if you care about updating the backlinks
985you want to include it.
986
987Again, doesn't do any locking. You probably don't want to let anyone
988except Wiki admins call this. You may not want to use it at all.
989
990Croaks on error, silently does nothing if the node or version doesn't
991exist, returns true if no error.
992
993=cut
994
995sub delete_node {
996    my $self = shift;
997    # Backwards compatibility.
998    my %args = ( scalar @_ == 1 ) ? ( name => $_[0] ) : @_;
999
1000    my $dbh = $self->dbh;
1001    my ($name, $version, $wiki) = @args{ qw( name version wiki ) };
1002
1003    # Grab the ID of this node
1004    # (It will only ever have one entry in node, but might have entries
1005    #  for other versions in metadata and content)
1006    my $id_sql = "SELECT id FROM node WHERE name=?";
1007    my $id_sth = $dbh->prepare($id_sql);
1008    $id_sth->execute($name);
1009    my ($node_id) = $id_sth->fetchrow_array;
1010    $id_sth->finish;
1011
1012    # Trivial case - delete the whole node and all its history.
1013    unless ( $version ) {
1014        my $sql;
1015        # Should start a transaction here.  FIXME.
1016        # Do deletes
1017        $sql = "DELETE FROM content WHERE node_id = $node_id";
1018        $dbh->do($sql) or croak "Deletion failed: " . DBI->errstr;
1019        $sql = "DELETE FROM internal_links WHERE link_from=".$dbh->quote($name);
1020        $dbh->do($sql) or croak $dbh->errstr;
1021        $sql = "DELETE FROM metadata WHERE node_id = $node_id";
1022        $dbh->do($sql) or croak $dbh->errstr;
1023        $sql = "DELETE FROM node WHERE id = $node_id";
1024        $dbh->do($sql) or croak "Deletion failed: " . DBI->errstr;
1025
1026        # And finish it here.
1027        post_delete_node($name,$node_id,$version,$args{plugins});
1028        return 1;
1029    }
1030
1031    # Skip out early if we're trying to delete a nonexistent version.
1032    my %verdata = $self->retrieve_node( name => $name, version => $version );
1033    unless($verdata{version}) {
1034        warn("Asked to delete non existant version $version of node $node_id ($name)");
1035        return 1;
1036    }
1037
1038    # Reduce to trivial case if deleting the only version.
1039    my $sql = "SELECT COUNT(*) FROM content WHERE node_id = $node_id";
1040    my $sth = $dbh->prepare( $sql );
1041    $sth->execute() or croak "Deletion failed: " . $dbh->errstr;
1042    my ($count) = $sth->fetchrow_array;
1043    $sth->finish;
1044    if($count == 1) {
1045        # Only one version, so can do the non version delete
1046        return $self->delete_node( name=>$name, plugins=>$args{plugins} );
1047    }
1048
1049    # Check whether we're deleting the latest (moderated) version.
1050    my %currdata = $self->retrieve_node( name => $name );
1051    if ( $currdata{version} == $version ) {
1052        # Deleting latest version, so need to update the copy in node
1053        # (Can't just grab version ($version - 1) since it may have been
1054        #  deleted itself, or might not be moderated.)
1055        my $try = $version - 1;
1056        my %prevdata;
1057        until ( $prevdata{version} && $prevdata{moderated} ) {
1058            %prevdata = $self->retrieve_node(
1059                                              name    => $name,
1060                                              version => $try,
1061                                            );
1062            $try--;
1063        }
1064
1065        # Move to new (old) version
1066        my $sql="UPDATE node
1067                 SET version=?, text=?, modified=?
1068                 WHERE name=?";
1069        my $sth = $dbh->prepare( $sql );
1070        $sth->execute( @prevdata{ qw( version content last_modified ) }, $name)
1071            or croak "Deletion failed: " . $dbh->errstr;
1072
1073        # Remove the current version from content
1074        $sql = "DELETE FROM content
1075                WHERE node_id = $node_id
1076                AND version = $version";
1077        $sth = $dbh->prepare( $sql );
1078        $sth->execute()
1079            or croak "Deletion failed: " . $dbh->errstr;
1080
1081        # Update the internal links to reflect the new version
1082        $sql = "DELETE FROM internal_links WHERE link_from=?";
1083        $sth = $dbh->prepare( $sql );
1084        $sth->execute( $name )
1085          or croak "Deletion failed: " . $dbh->errstr;
1086        my @links_to;
1087        my $formatter = $wiki->formatter;
1088        if ( $formatter->can( "find_internal_links" ) ) {
1089            # Supply $metadata to formatter in case it's needed to alter the
1090            # behaviour of the formatter, eg for Wiki::Toolkit::Formatter::Multiple
1091            my @all = $formatter->find_internal_links(
1092                                    $prevdata{content}, $prevdata{metadata} );
1093            my %unique = map { $_ => 1 } @all;
1094            @links_to = keys %unique;
1095        }
1096        $sql = "INSERT INTO internal_links (link_from, link_to) VALUES (?,?)";
1097        $sth = $dbh->prepare( $sql );
1098        foreach my $link ( @links_to ) {
1099            eval { $sth->execute( $name, $link ); };
1100            carp "Couldn't index backlink: " . $dbh->errstr if $@;
1101        }
1102
1103        # Delete the metadata for the old version
1104        $sql = "DELETE FROM metadata
1105                WHERE node_id = $node_id
1106                AND version = $version";
1107        $sth = $dbh->prepare( $sql );
1108        $sth->execute()
1109            or croak "Deletion failed: " . $dbh->errstr;
1110
1111        # All done
1112        post_delete_node($name,$node_id,$version,$args{plugins});
1113        return 1;
1114    }
1115
1116    # If we're still here, then we're deleting neither the latest
1117    # nor the only version.
1118    $sql = "DELETE FROM content
1119            WHERE node_id = $node_id
1120            AND version=?";
1121    $sth = $dbh->prepare( $sql );
1122    $sth->execute( $version )
1123        or croak "Deletion failed: " . $dbh->errstr;
1124    $sql = "DELETE FROM metadata
1125            WHERE node_id = $node_id
1126            AND version=?";
1127    $sth = $dbh->prepare( $sql );
1128    $sth->execute( $version )
1129        or croak "Deletion failed: " . $dbh->errstr;
1130
1131    # All done
1132    post_delete_node($name,$node_id,$version,$args{plugins});
1133    return 1;
1134}
1135
1136# Returns the name of the node with the given ID
1137# Not normally used except when doing low-level maintenance
1138sub node_name_for_id {
1139    my ($self, $node_id) = @_;
1140    my $dbh = $self->dbh;
1141
1142    my $name_sql = "SELECT name FROM node WHERE id=?";
1143    my $name_sth = $dbh->prepare($name_sql);
1144    $name_sth->execute($node_id);
1145    my ($name) = $name_sth->fetchrow_array;
1146    $name_sth->finish;
1147
1148    return $name;
1149}
1150
1151# Internal Method
1152sub post_delete_node {
1153    my ($name,$node_id,$version,$plugins) = @_;
1154
1155    # Call post_delete on any plugins, having done the delete
1156    my @plugins = @{ $plugins || [ ] };
1157    foreach my $plugin (@plugins) {
1158        if ( $plugin->can( "post_delete" ) ) {
1159            $plugin->post_delete( 
1160                node     => $name,
1161                node_id  => $node_id,
1162                version  => $version );
1163        }
1164    }
1165}
1166
1167=item B<list_recent_changes>
1168
1169  # Nodes changed in last 7 days - each node listed only once.
1170  my @nodes = $store->list_recent_changes( days => 7 );
1171
1172  # Nodes added in the last 7 days.
1173  my @nodes = $store->list_recent_changes(
1174                                           days     => 7,
1175                                           new_only => 1,
1176                                         );
1177
1178  # All changes in last 7 days - nodes changed more than once will
1179  # be listed more than once.
1180  my @nodes = $store->list_recent_changes(
1181                                           days => 7,
1182                                           include_all_changes => 1,
1183                                         );
1184
1185  # Nodes changed between 1 and 7 days ago.
1186  my @nodes = $store->list_recent_changes( between_days => [ 1, 7 ] );
1187
1188  # Nodes changed since a given time.
1189  my @nodes = $store->list_recent_changes( since => 1036235131 );
1190
1191  # Most recent change and its details.
1192  my @nodes = $store->list_recent_changes( last_n_changes => 1 );
1193  print "Node:          $nodes[0]{name}";
1194  print "Last modified: $nodes[0]{last_modified}";
1195  print "Comment:       $nodes[0]{metadata}{comment}";
1196
1197  # Last 5 restaurant nodes edited.
1198  my @nodes = $store->list_recent_changes(
1199      last_n_changes => 5,
1200      metadata_is    => { category => "Restaurants" }
1201  );
1202
1203  # Last 5 nodes edited by Kake.
1204  my @nodes = $store->list_recent_changes(
1205      last_n_changes => 5,
1206      metadata_was   => { username => "Kake" }
1207  );
1208
1209  # All minor edits made by Earle in the last week.
1210  my @nodes = $store->list_recent_changes(
1211      days           => 7,
1212      metadata_was   => { username  => "Earle",
1213                          edit_type => "Minor tidying." }
1214  );
1215
1216  # Last 10 changes that weren't minor edits.
1217  my @nodes = $store->list_recent_changes(
1218      last_n_changes => 10,
1219      metadata_wasnt  => { edit_type => "Minor tidying" }
1220  );
1221
1222You I<must> supply one of the following constraints: C<days>
1223(integer), C<since> (epoch), C<last_n_changes> (integer).
1224
1225You I<may> also supply moderation => 1 if you only want to see versions
1226that are moderated.
1227
1228Another optional parameter is C<new_only>, which if set to 1 will only
1229return newly added nodes.
1230
1231You I<may> also supply I<either> C<metadata_is> (and optionally
1232C<metadata_isnt>), I<or> C<metadata_was> (and optionally
1233C<metadata_wasnt>). Each of these should be a ref to a hash with
1234scalar keys and values.  If the hash has more than one entry, then
1235only changes satisfying I<all> criteria will be returned when using
1236C<metadata_is> or C<metadata_was>, but all changes which fail to
1237satisfy any one of the criteria will be returned when using
1238C<metadata_isnt> or C<metadata_is>.
1239
1240C<metadata_is> and C<metadata_isnt> look only at the metadata that the
1241node I<currently> has. C<metadata_was> and C<metadata_wasnt> take into
1242account the metadata of previous versions of a node.  Don't mix C<is>
1243with C<was> - there's no check for this, but the results are undefined.
1244
1245Returns results as an array, in reverse chronological order.  Each
1246element of the array is a reference to a hash with the following entries:
1247
1248=over 4
1249
1250=item * B<name>: the name of the node
1251
1252=item * B<version>: the latest version number
1253
1254=item * B<last_modified>: the timestamp of when it was last modified
1255
1256=item * B<metadata>: a ref to a hash containing any metadata attached
1257to the current version of the node
1258
1259=back
1260
1261Unless you supply C<include_all_changes>, C<metadata_was> or
1262C<metadata_wasnt>, each node will only be returned once regardless of
1263how many times it has been changed recently.
1264
1265By default, the case-sensitivity of both C<metadata_type> and
1266C<metadata_value> depends on your database - if it will return rows
1267with an attribute value of "Pubs" when you asked for "pubs", or not.
1268If you supply a true value to the C<ignore_case> parameter, then you
1269can be sure of its being case-insensitive.  This is recommended.
1270
1271=cut
1272
1273sub list_recent_changes {
1274    my $self = shift;
1275    my %args = @_;
1276    if ($args{since}) {
1277        return $self->_find_recent_changes_by_criteria( %args );
1278    } elsif ($args{between_days}) {
1279        return $self->_find_recent_changes_by_criteria( %args );
1280    } elsif ( $args{days} ) {
1281        my $now = localtime;
1282    my $then = $now - ( ONE_DAY * $args{days} );
1283        $args{since} = $then;
1284        delete $args{days};
1285        return $self->_find_recent_changes_by_criteria( %args );
1286    } elsif ( $args{last_n_changes} ) {
1287        $args{limit} = delete $args{last_n_changes};
1288        return $self->_find_recent_changes_by_criteria( %args );
1289    } else {
1290        croak "Need to supply some criteria to list_recent_changes.";
1291    }
1292}
1293
1294sub _find_recent_changes_by_criteria {
1295    my ($self, %args) = @_;
1296    my ($since, $limit, $between_days, $ignore_case, $new_only,
1297        $metadata_is,  $metadata_isnt, $metadata_was, $metadata_wasnt,
1298    $moderation, $include_all_changes ) =
1299         @args{ qw( since limit between_days ignore_case new_only
1300                    metadata_is metadata_isnt metadata_was metadata_wasnt
1301            moderation include_all_changes) };
1302    my $dbh = $self->dbh;
1303
1304    my @where;
1305    my @metadata_joins;
1306    my $use_content_table; # some queries won't need this
1307
1308    if ( $metadata_is ) {
1309        my $main_table = "node";
1310        if ( $include_all_changes ) {
1311            $main_table = "content";
1312            $use_content_table = 1;
1313        }
1314        my $i = 0;
1315        foreach my $type ( keys %$metadata_is ) {
1316            $i++;
1317            my $value  = $metadata_is->{$type};
1318            croak "metadata_is must have scalar values" if ref $value;
1319            my $mdt = "md_is_$i";
1320            push @metadata_joins, "LEFT JOIN metadata AS $mdt
1321                                   ON $main_table."
1322                                   . ( ($main_table eq "node") ? "id"
1323                                                               : "node_id" )
1324                                   . "=$mdt.node_id
1325                                   AND $main_table.version=$mdt.version\n";
1326            # Why is this inside 'if ( $metadata_is )'?
1327            # Shouldn't it apply to all cases?
1328            # What's it doing in @metadata_joins?
1329            if (defined $moderation) {
1330                push @metadata_joins, "AND $main_table.moderate=$moderation";
1331            }
1332            push @where, "( "
1333                         . $self->_get_comparison_sql(
1334                                          thing1      => "$mdt.metadata_type",
1335                                          thing2      => $dbh->quote($type),
1336                                          ignore_case => $ignore_case,
1337                                                     )
1338                         . " AND "
1339                         . $self->_get_comparison_sql(
1340                                          thing1      => "$mdt.metadata_value",
1341                                          thing2      => $dbh->quote( $self->charset_encode($value) ),
1342                                          Ignore_case => $ignore_case,
1343                                                     )
1344                         . " )";
1345    }
1346    }
1347
1348    if ( $metadata_isnt ) {
1349        foreach my $type ( keys %$metadata_isnt ) {
1350            my $value  = $metadata_isnt->{$type};
1351            croak "metadata_isnt must have scalar values" if ref $value;
1352    }
1353        my @omits = $self->_find_recent_changes_by_criteria(
1354            since        => $since,
1355            between_days => $between_days,
1356            metadata_is  => $metadata_isnt,
1357            ignore_case  => $ignore_case,
1358        );
1359        foreach my $omit ( @omits ) {
1360            push @where, "( node.name != " . $dbh->quote($omit->{name})
1361                 . "  OR node.version != " . $dbh->quote($omit->{version})
1362                 . ")";
1363    }
1364    }
1365
1366    if ( $metadata_was ) {
1367        $use_content_table = 1;
1368        my $i = 0;
1369        foreach my $type ( keys %$metadata_was ) {
1370            $i++;
1371            my $value  = $metadata_was->{$type};
1372            croak "metadata_was must have scalar values" if ref $value;
1373            my $mdt = "md_was_$i";
1374            push @metadata_joins, "LEFT JOIN metadata AS $mdt
1375                                   ON content.node_id=$mdt.node_id
1376                                   AND content.version=$mdt.version\n";
1377            push @where, "( "
1378                         . $self->_get_comparison_sql(
1379                                          thing1      => "$mdt.metadata_type",
1380                                          thing2      => $dbh->quote($type),
1381                                          ignore_case => $ignore_case,
1382                                                     )
1383                         . " AND "
1384                         . $self->_get_comparison_sql(
1385                                          thing1      => "$mdt.metadata_value",
1386                                          thing2      => $dbh->quote( $self->charset_encode($value) ),
1387                                          ignore_case => $ignore_case,
1388                                                     )
1389                         . " )";
1390        }
1391    }
1392
1393    if ( $metadata_wasnt ) {
1394        foreach my $type ( keys %$metadata_wasnt ) {
1395                my $value  = $metadata_was->{$type};
1396                croak "metadata_was must have scalar values" if ref $value;
1397    }
1398        my @omits = $self->_find_recent_changes_by_criteria(
1399                since        => $since,
1400                between_days => $between_days,
1401                metadata_was => $metadata_wasnt,
1402                ignore_case  => $ignore_case,
1403        );
1404        foreach my $omit ( @omits ) {
1405            push @where, "( node.name != " . $dbh->quote($omit->{name})
1406                 . "  OR content.version != " . $dbh->quote($omit->{version})
1407                 . ")";
1408    }
1409        $use_content_table = 1;
1410    }
1411
1412    # Figure out which table we should be joining to to check the dates and
1413    # versions - node or content.
1414    my $date_table = "node";
1415    if ( $include_all_changes || $new_only ) {
1416        $date_table = "content";
1417        $use_content_table = 1;
1418    }
1419    if ( $new_only ) {
1420        push @where, "content.version=1";
1421    }
1422
1423    if ( $since ) {
1424        my $timestamp = $self->_get_timestamp( $since );
1425        push @where, "$date_table.modified >= " . $dbh->quote($timestamp);
1426    } elsif ( $between_days ) {
1427        my $now = localtime;
1428        # Start is the larger number of days ago.
1429        my ($start, $end) = @$between_days;
1430        ($start, $end) = ($end, $start) if $start < $end;
1431        my $ts_start = $self->_get_timestamp( $now - (ONE_DAY * $start) ); 
1432        my $ts_end = $self->_get_timestamp( $now - (ONE_DAY * $end) ); 
1433        push @where, "$date_table.modified >= " . $dbh->quote($ts_start);
1434        push @where, "$date_table.modified <= " . $dbh->quote($ts_end);
1435    }
1436
1437    my $sql = "SELECT DISTINCT
1438                               node.name,
1439              ";
1440    if ( $include_all_changes || $new_only || $use_content_table ) {
1441        $sql .= " content.version, content.modified ";
1442    } else {
1443        $sql .= " node.version, node.modified ";
1444    }
1445    $sql .= " FROM node ";
1446    if ( $use_content_table ) {
1447        $sql .= " INNER JOIN content ON (node.id = content.node_id ) ";
1448    }
1449
1450    $sql .= join("\n", @metadata_joins)
1451            . (
1452                scalar @where
1453                              ? " WHERE " . join(" AND ",@where) 
1454                              : ""
1455              )
1456            . " ORDER BY "
1457            . ( $use_content_table ? "content" : "node" )
1458            . ".modified DESC";
1459    if ( $limit ) {
1460        croak "Bad argument $limit" unless $limit =~ /^\d+$/;
1461        $sql .= " LIMIT $limit";
1462    }
1463    my $nodesref = $dbh->selectall_arrayref($sql);
1464    my @finds = map { { name          => $_->[0],
1465                        version       => $_->[1],
1466                        last_modified => $_->[2] }
1467                    } @$nodesref;
1468    foreach my $find ( @finds ) {
1469        my %metadata;
1470        my $sth = $dbh->prepare( "SELECT metadata_type, metadata_value
1471                                  FROM node
1472                                  INNER JOIN metadata
1473                                  ON (id = node_id)
1474                                  WHERE name=?
1475                                  AND metadata.version=?" );
1476        $sth->execute( $find->{name}, $find->{version} );
1477        while ( my ($type, $value) = $self->charset_decode( $sth->fetchrow_array ) ) {
1478        if ( defined $metadata{$type} ) {
1479                push @{$metadata{$type}}, $value;
1480        } else {
1481                $metadata{$type} = [ $value ];
1482            }
1483    }
1484        $find->{metadata} = \%metadata;
1485    }
1486    return @finds;
1487}
1488
1489=item B<list_all_nodes>
1490
1491  my @nodes = $store->list_all_nodes();
1492  print "First node is $nodes[0]\n";
1493
1494  my @nodes = $store->list_all_nodes( with_details=> 1 );
1495  print "First node is ".$nodes[0]->{'name'}." at version ".$nodes[0]->{'version'}."\n";
1496
1497Returns a list containing the name of every existing node.  The list
1498won't be in any kind of order; do any sorting in your calling script.
1499
1500Optionally also returns the id, version and moderation flag.
1501
1502=cut
1503
1504sub list_all_nodes {
1505    my ($self,%args) = @_;
1506    my $dbh = $self->dbh;
1507    my @nodes;
1508
1509    if($args{with_details}) {
1510        my $sql = "SELECT id, name, version, moderate FROM node;";
1511        my $sth = $dbh->prepare( $sql );
1512        $sth->execute();
1513
1514        while(my @results = $sth->fetchrow_array) {
1515            my %data;
1516            @data{ qw( node_id name version moderate ) } = @results;
1517            push @nodes, \%data;
1518        }
1519    } else {
1520        my $sql = "SELECT name FROM node;";
1521        my $raw_nodes = $dbh->selectall_arrayref($sql); 
1522        @nodes = ( map { $self->charset_decode( $_->[0] ) } (@$raw_nodes) );
1523    }
1524    return @nodes;
1525}
1526
1527=item B<list_node_all_versions>
1528
1529  my @all_versions = $store->list_node_all_versions(
1530      name => 'HomePage',
1531      with_content => 1,
1532      with_metadata => 0
1533  );
1534
1535Returns all the versions of a node, optionally including the content
1536and metadata, as an array of hashes (newest versions first).
1537
1538=cut
1539
1540sub list_node_all_versions {
1541    my ($self, %args) = @_;
1542
1543    my ($node_id,$name,$with_content,$with_metadata) = 
1544                @args{ qw( node_id name with_content with_metadata ) };
1545
1546    my $dbh = $self->dbh;
1547    my $sql;
1548
1549    # If they only gave us the node name, get the node id
1550    unless ($node_id) {
1551        $sql = "SELECT id FROM node WHERE name=" . $dbh->quote($name);
1552        $node_id = $dbh->selectrow_array($sql);
1553    }
1554
1555    # If they didn't tell us what they wanted / we couldn't find it,
1556    #  return an empty array
1557    return () unless($node_id);
1558
1559    # Build up our SQL
1560    $sql = "SELECT id, name, content.version, content.modified ";
1561    if ( $with_content ) {
1562        $sql .= ", content.text ";
1563    }
1564    if ( $with_metadata ) {
1565        $sql .= ", metadata_type, metadata_value ";
1566    }
1567    $sql .= " FROM node INNER JOIN content ON (id = content.node_id) ";
1568    if ( $with_metadata ) {
1569        $sql .= " LEFT OUTER JOIN metadata ON "
1570           . "(id = metadata.node_id AND content.version = metadata.version) ";
1571    }
1572    $sql .= " WHERE id = ? ORDER BY content.version DESC";
1573
1574    # Do the fetch
1575    my $sth = $dbh->prepare( $sql );
1576    $sth->execute( $node_id );
1577
1578    # Need to hold onto the last row by hash ref, so we don't trash
1579    #  it every time
1580    my %first_data;
1581    my $dataref = \%first_data;
1582
1583    # Haul out the data
1584    my @versions;
1585    while ( my @results = $sth->fetchrow_array ) {
1586        my %data = %$dataref;
1587
1588        # Is it the same version as last time?
1589        if ( %data && $data{'version'} != $results[2] ) {
1590            # New version
1591            push @versions, $dataref;
1592            %data = ();
1593        } else {
1594            # Same version as last time, must be more metadata
1595        }
1596
1597        # Grab the core data (will be the same on multi-row for metadata)
1598        @data{ qw( node_id name version last_modified ) } = @results;
1599
1600        my $i = 4;
1601        if ( $with_content ) {
1602            $data{'content'} = $results[$i];
1603            $i++;
1604        }
1605        if ( $with_metadata ) {
1606            my ($m_type,$m_value) = @results[$i,($i+1)];
1607            unless ( $data{'metadata'} ) { $data{'metadata'} = {}; }
1608
1609            if ( $m_type ) {
1610                # If we have existing data, then put it into an array
1611                if ( $data{'metadata'}->{$m_type} ) {
1612                    unless ( ref($data{'metadata'}->{$m_type}) eq "ARRAY" ) {
1613                        $data{'metadata'}->{$m_type} =
1614                                             [ $data{'metadata'}->{$m_type} ];
1615                    }
1616                    push @{$data{'metadata'}->{$m_type}}, $m_value;
1617                } else {
1618                    # Otherwise, just store it in a normal string
1619                    $data{'metadata'}->{$m_type} = $m_value;
1620                }
1621            }
1622        }
1623
1624        # Save where we've got to
1625        $dataref = \%data;
1626    }
1627
1628    # Handle final row saving
1629    if ( $dataref ) {
1630        push @versions, $dataref;
1631    }
1632
1633    # Return
1634    return @versions;
1635}
1636
1637=item B<list_nodes_by_metadata>
1638
1639  # All documentation nodes.
1640  my @nodes = $store->list_nodes_by_metadata(
1641      metadata_type  => "category",
1642      metadata_value => "documentation",
1643      ignore_case    => 1,   # optional but recommended (see below)
1644  );
1645
1646  # All pubs in Hammersmith.
1647  my @pubs = $store->list_nodes_by_metadata(
1648      metadata_type  => "category",
1649      metadata_value => "Pub",
1650  );
1651  my @hsm  = $store->list_nodes_by_metadata(
1652      metadata_type  => "category",
1653      metadata_value  => "Hammersmith",
1654  );
1655  my @results = my_l33t_method_for_ANDing_arrays( \@pubs, \@hsm );
1656
1657Returns a list containing the name of every node whose caller-supplied
1658metadata matches the criteria given in the parameters.
1659
1660By default, the case-sensitivity of both C<metadata_type> and
1661C<metadata_value> depends on your database - if it will return rows
1662with an attribute value of "Pubs" when you asked for "pubs", or not.
1663If you supply a true value to the C<ignore_case> parameter, then you
1664can be sure of its being case-insensitive.  This is recommended.
1665
1666If you don't supply any criteria then you'll get an empty list.
1667
1668This is a really really really simple way of finding things; if you
1669want to be more complicated then you'll need to call the method
1670multiple times and combine the results yourself, or write a plugin.
1671
1672=cut
1673
1674sub list_nodes_by_metadata {
1675    my ($self, %args) = @_;
1676    my ( $type, $value ) = @args{ qw( metadata_type metadata_value ) };
1677    return () unless $type;
1678
1679    my $dbh = $self->dbh;
1680    if ( $args{ignore_case} ) {
1681        $type  = lc( $type  );
1682        $value = lc( $value );
1683    }
1684    my $sql =
1685         $self->_get_list_by_metadata_sql( ignore_case => $args{ignore_case} );
1686    my $sth = $dbh->prepare( $sql );
1687    $sth->execute( $type, $self->charset_encode($value) );
1688    my @nodes;
1689    while ( my ($id, $node) = $sth->fetchrow_array ) {
1690        push @nodes, $node;
1691    }
1692    return @nodes;
1693}
1694
1695=item B<list_nodes_by_missing_metadata>
1696Returns nodes where either the metadata doesn't exist, or is blank
1697
1698Unlike list_nodes_by_metadata(), the metadata value is optional.
1699
1700  # All nodes missing documentation
1701  my @nodes = $store->list_nodes_by_missing_metadata(
1702      metadata_type  => "category",
1703      metadata_value => "documentation",
1704      ignore_case    => 1,   # optional but recommended (see below)
1705  );
1706
1707  # All nodes which don't have a latitude defined
1708  my @nodes = $store->list_nodes_by_missing_metadata(
1709      metadata_type  => "latitude"
1710  );
1711
1712=cut
1713
1714sub list_nodes_by_missing_metadata {
1715    my ($self, %args) = @_;
1716    my ( $type, $value ) = @args{ qw( metadata_type metadata_value ) };
1717    return () unless $type;
1718
1719    my $dbh = $self->dbh;
1720    if ( $args{ignore_case} ) {
1721        $type  = lc( $type  );
1722        $value = lc( $value );
1723    }
1724
1725    my @nodes;
1726
1727    # If the don't want to match by value, then we can do it with
1728    #  a LEFT OUTER JOIN, and either NULL or LENGTH() = 0
1729    if( ! $value ) {
1730        my $sql = $self->_get_list_by_missing_metadata_sql( 
1731                                        ignore_case => $args{ignore_case}
1732              );
1733        my $sth = $dbh->prepare( $sql );
1734        $sth->execute( $type );
1735
1736        while ( my ($id, $node) = $sth->fetchrow_array ) {
1737            push @nodes, $node;
1738        }
1739    } else {
1740        # To find those without the value in this case would involve
1741        #  some seriously brain hurting SQL.
1742        # So, cheat - find those with, and return everything else
1743        my @with = $self->list_nodes_by_metadata(%args);
1744        my %with_hash;
1745        foreach my $node (@with) { $with_hash{$node} = 1; }
1746
1747        my @all_nodes = $self->list_all_nodes();
1748        foreach my $node (@all_nodes) {
1749            unless($with_hash{$node}) {
1750                push @nodes, $node;
1751            }
1752        }
1753    }
1754
1755    return @nodes;
1756}
1757
1758=item B<_get_list_by_metadata_sql>
1759
1760Return the SQL to do a match by metadata. Should expect the metadata type
1761as the first SQL parameter, and the metadata value as the second.
1762
1763If possible, should take account of $args{ignore_case}
1764
1765=cut
1766
1767sub _get_list_by_metadata_sql {
1768    # SQL 99 version
1769    #  Can be over-ridden by database-specific subclasses
1770    my ($self, %args) = @_;
1771    if ( $args{ignore_case} ) {
1772        return "SELECT node.id, node.name "
1773             . "FROM node "
1774             . "INNER JOIN metadata "
1775             . "   ON (node.id = metadata.node_id "
1776             . "       AND node.version=metadata.version) "
1777             . "WHERE ". $self->_get_lowercase_compare_sql("metadata.metadata_type")
1778             . " AND ". $self->_get_lowercase_compare_sql("metadata.metadata_value");
1779    } else {
1780        return "SELECT node.id, node.name "
1781             . "FROM node "
1782             . "INNER JOIN metadata "
1783             . "   ON (node.id = metadata.node_id "
1784             . "       AND node.version=metadata.version) "
1785             . "WHERE ". $self->_get_casesensitive_compare_sql("metadata.metadata_type")
1786             . " AND ". $self->_get_casesensitive_compare_sql("metadata.metadata_value");
1787    }
1788}
1789
1790=item B<_get_list_by_missing_metadata_sql>
1791
1792Return the SQL to do a match by missing metadata. Should expect the metadata
1793type as the first SQL parameter.
1794
1795If possible, should take account of $args{ignore_case}
1796
1797=cut
1798
1799sub _get_list_by_missing_metadata_sql {
1800    # SQL 99 version
1801    #  Can be over-ridden by database-specific subclasses
1802    my ($self, %args) = @_;
1803
1804    my $sql = "";
1805    if ( $args{ignore_case} ) {
1806        $sql = "SELECT node.id, node.name "
1807             . "FROM node "
1808             . "LEFT OUTER JOIN metadata "
1809             . "   ON (node.id = metadata.node_id "
1810             . "       AND node.version=metadata.version "
1811             . "       AND ". $self->_get_lowercase_compare_sql("metadata.metadata_type")
1812             . ")";
1813    } else {
1814        $sql = "SELECT node.id, node.name "
1815             . "FROM node "
1816             . "LEFT OUTER JOIN metadata "
1817             . "   ON (node.id = metadata.node_id "
1818             . "       AND node.version=metadata.version "
1819             . "       AND ". $self->_get_casesensitive_compare_sql("metadata.metadata_type")
1820             . ")";
1821    }
1822
1823    $sql .= "WHERE (metadata.metadata_value IS NULL OR LENGTH(metadata.metadata_value) = 0) ";
1824    return $sql;
1825}
1826
1827sub _get_lowercase_compare_sql {
1828    my ($self, $column) = @_;
1829    # SQL 99 version
1830    #  Can be over-ridden by database-specific subclasses
1831    return "lower($column) = ?";
1832}
1833sub _get_casesensitive_compare_sql {
1834    my ($self, $column) = @_;
1835    # SQL 99 version
1836    #  Can be over-ridden by database-specific subclasses
1837    return "$column = ?";
1838}
1839
1840sub _get_comparison_sql {
1841    my ($self, %args) = @_;
1842    # SQL 99 version
1843    #  Can be over-ridden by database-specific subclasses
1844    return "$args{thing1} = $args{thing2}";
1845}
1846
1847sub _get_node_exists_ignore_case_sql {
1848    # SQL 99 version
1849    #  Can be over-ridden by database-specific subclasses
1850    return "SELECT name FROM node WHERE name = ? ";
1851}
1852
1853=item B<list_unmoderated_nodes>
1854
1855  my @nodes = $wiki->list_unmoderated_nodes();
1856  my @nodes = $wiki->list_unmoderated_nodes(
1857                                                only_where_latest => 1
1858                                            );
1859
1860  $nodes[0]->{'name'}              # The name of the node
1861  $nodes[0]->{'node_id'}           # The id of the node
1862  $nodes[0]->{'version'}           # The version in need of moderation
1863  $nodes[0]->{'moderated_version'} # The newest moderated version
1864
1865  With only_where_latest set, return the id, name and version of all the
1866   nodes where the most recent version needs moderation.
1867  Otherwise, returns the id, name and version of all node versions that need
1868   to be moderated.
1869
1870=cut
1871
1872sub list_unmoderated_nodes {
1873    my ($self,%args) = @_;
1874
1875    my $only_where_lastest = $args{'only_where_latest'};
1876
1877    my $sql =
1878         "SELECT "
1879        ."    id, name, "
1880        ."    node.version AS last_moderated_version, "
1881        ."    content.version AS version "
1882        ."FROM content "
1883        ."INNER JOIN node "
1884        ."    ON (id = node_id) "
1885        ."WHERE moderated = ? "
1886    ;
1887    if($only_where_lastest) {
1888        $sql .= "AND node.version = content.version ";
1889    }
1890    $sql .= "ORDER BY name, content.version ";
1891
1892    # Query
1893    my $dbh = $self->dbh;
1894    my $sth = $dbh->prepare( $sql );
1895    $sth->execute( "0" );
1896
1897    my @nodes;
1898    while(my @results = $sth->fetchrow_array) {
1899        my %data;
1900        @data{ qw( node_id name moderated_version version ) } = @results;
1901        push @nodes, \%data;
1902    }
1903
1904    return @nodes;
1905}
1906
1907=item B<list_last_version_before>
1908
1909    List the last version of every node before a given date.
1910    If no version existed before that date, will return undef for version.
1911    Returns a hash of id, name, version and date
1912
1913    my @nv = $wiki->list_last_version_before('2007-01-02 10:34:11')
1914    foreach my $data (@nv) {
1915       
1916    }
1917
1918=cut
1919
1920sub list_last_version_before {
1921    my ($self, $date) = @_;
1922
1923    my $sql =
1924         "SELECT "
1925        ."    id, name, "
1926        ."MAX(content.version) AS version, MAX(content.modified) AS modified "
1927        ."FROM node "
1928        ."LEFT OUTER JOIN content "
1929        ."    ON (id = node_id "
1930        ."      AND content.modified <= ?) "
1931        ."GROUP BY id, name "
1932        ."ORDER BY id "
1933    ;
1934
1935    # Query
1936    my $dbh = $self->dbh;
1937    my $sth = $dbh->prepare( $sql );
1938    $sth->execute( $date );
1939
1940    my @nodes;
1941    while(my @results = $sth->fetchrow_array) {
1942        my %data;
1943        @data{ qw( id name version modified ) } = @results;
1944        $data{'node_id'} = $data{'id'};
1945        unless($data{'version'}) { $data{'version'} = undef; }
1946        push @nodes, \%data;
1947    }
1948
1949    return @nodes;
1950}
1951
1952
1953# Internal function only, used when querying latest metadata
1954sub _current_node_id_versions {
1955    my ($self) = @_;
1956
1957    my $dbh = $self->dbh;
1958
1959    my $nv_sql = 
1960       "SELECT node_id, MAX(version) ".
1961       "FROM content ".
1962       "WHERE moderated ".
1963       "GROUP BY node_id ";
1964    my $sth = $dbh->prepare( $nv_sql );
1965    $sth->execute();
1966
1967    my @nv_where;
1968    while(my @results = $sth->fetchrow_array) {
1969        my ($node_id, $version) = @results;
1970        my $where = "(node_id=$node_id AND version=$version)";
1971        push @nv_where, $where;
1972    }
1973    return @nv_where;
1974}
1975
1976=item B<list_metadata_by_type>
1977
1978    List all the currently defined values of the given type of metadata.
1979
1980    Will only return data from the latest moderated version of each node
1981
1982    # List all of the different metadata values with the type 'category'
1983    my @categories = $wiki->list_metadata_by_type('category');
1984
1985=cut
1986sub list_metadata_by_type {
1987    my ($self, $type) = @_;
1988
1989    return undef unless $type;
1990    my $dbh = $self->dbh;
1991
1992    # Ideally we'd do this as one big query
1993    # However, this would need a temporary table on many
1994    #  database engines, so we cheat and do it as two
1995    my @nv_where = $self->_current_node_id_versions();
1996
1997    # Now the metadata bit
1998    my $sql = 
1999       "SELECT DISTINCT metadata_value ".
2000       "FROM metadata ".
2001       "WHERE metadata_type = ? ".
2002       "AND (".
2003       join(" OR ", @nv_where).
2004       ")";
2005    my $sth = $dbh->prepare( $sql );
2006    $sth->execute($type);
2007
2008    my $values = $sth->fetchall_arrayref([0]);
2009    return ( map { $self->charset_decode( $_->[0] ) } (@$values) );
2010}
2011
2012
2013=item B<list_metadata_names>
2014
2015    List all the currently defined kinds of metadata, eg Locale, Postcode
2016
2017    Will only return data from the latest moderated version of each node
2018
2019    # List all of the different kinds of metadata
2020    my @metadata_types = $wiki->list_metadata_names()
2021
2022=cut
2023sub list_metadata_names {
2024    my ($self) = @_;
2025
2026    my $dbh = $self->dbh;
2027
2028    # Ideally we'd do this as one big query
2029    # However, this would need a temporary table on many
2030    #  database engines, so we cheat and do it as two
2031    my @nv_where = $self->_current_node_id_versions();
2032
2033    # Now the metadata bit
2034    my $sql = 
2035       "SELECT DISTINCT metadata_type ".
2036       "FROM metadata ".
2037       "WHERE (".
2038       join(" OR ", @nv_where).
2039       ")";
2040    my $sth = $dbh->prepare( $sql );
2041    $sth->execute();
2042
2043    my $types = $sth->fetchall_arrayref([0]);
2044    return ( map { $self->charset_decode( $_->[0] ) } (@$types) );
2045}
2046
2047
2048=item B<schema_current>
2049
2050  my ($code_version, $db_version) = $store->schema_current;
2051  if ($code_version == $db_version)
2052      # Do stuff
2053  } else {
2054      # Bail
2055  }
2056
2057=cut
2058
2059sub schema_current {
2060    my $self = shift;
2061    my $dbh = $self->dbh;
2062    my $sth;
2063    eval { $sth = $dbh->prepare("SELECT version FROM schema_info") };
2064    if ($@) {
2065        return ($SCHEMA_VER, 0);
2066    }
2067    eval { $sth->execute };
2068    if ($@) {
2069        return ($SCHEMA_VER, 0);
2070    }
2071    my $version;
2072    eval { $version = $sth->fetchrow_array };
2073    if ($@) {
2074        return ($SCHEMA_VER, 0);
2075    } else {
2076        return ($SCHEMA_VER, $version);
2077    }
2078}
2079
2080
2081=item B<dbh>
2082
2083  my $dbh = $store->dbh;
2084
2085Returns the database handle belonging to this storage backend instance.
2086
2087=cut
2088
2089sub dbh {
2090    my $self = shift;
2091    return $self->{_dbh};
2092}
2093
2094=item B<dbname>
2095
2096  my $dbname = $store->dbname;
2097
2098Returns the name of the database used for backend storage.
2099
2100=cut
2101
2102sub dbname {
2103    my $self = shift;
2104    return $self->{_dbname};
2105}
2106
2107=item B<dbuser>
2108
2109  my $dbuser = $store->dbuser;
2110
2111Returns the username used to connect to the database used for backend storage.
2112
2113=cut
2114
2115sub dbuser {
2116    my $self = shift;
2117    return $self->{_dbuser};
2118}
2119
2120=item B<dbpass>
2121
2122  my $dbpass = $store->dbpass;
2123
2124Returns the password used to connect to the database used for backend storage.
2125
2126=cut
2127
2128sub dbpass {
2129    my $self = shift;
2130    return $self->{_dbpass};
2131}
2132
2133=item B<dbhost>
2134
2135  my $dbhost = $store->dbhost;
2136
2137Returns the optional host used to connect to the database used for
2138backend storage.
2139
2140=cut
2141
2142sub dbhost {
2143    my $self = shift;
2144    return $self->{_dbhost};
2145}
2146
2147# Cleanup.
2148sub DESTROY {
2149    my $self = shift;
2150    return if $self->{_external_dbh};
2151    my $dbh = $self->dbh;
2152    $dbh->disconnect if $dbh;
2153}
2154
2155# decode a string of octets into perl's internal encoding, based on the
2156# charset parameter we were passed. Takes a list, returns a list.
2157sub charset_decode {
2158    my $self = shift;
2159    my @input = @_;
2160    if ($CAN_USE_ENCODE) {
2161        my @output;
2162        for (@input) {
2163            push( @output, Encode::decode( $self->{_charset}, $_ ) );
2164        }
2165        return @output;
2166    }
2167    return @input;
2168}
2169
2170# convert a perl string into a series of octets we can put into the database
2171# takes a list, returns a list
2172sub charset_encode {
2173    my $self = shift;
2174    my @input = @_;
2175    if ($CAN_USE_ENCODE) {
2176        my @output;
2177        for (@input) {
2178            push( @output, Encode::encode( $self->{_charset}, $_ ) );
2179        }
2180        return @output;
2181    }
2182    return @input;
2183}
2184
21851;
Note: See TracBrowser for help on using the repository browser.