CGI::Wiki::Store::Database - parent class for database storage backends

  # See below for parameter details.
  my $store = CGI::Wiki::Store::MySQL->new( %config );

package CGI::Wiki::Store::Database;

use strict;

use vars qw( $VERSION $timestamp_fmt );
$timestamp_fmt = "%Y-%m-%d %H:%M:%S";

use DBI;
use Time::Piece;
use Time::Seconds;
use Carp qw( carp croak );
use Digest::MD5 qw( md5_hex );

$VERSION = '0.27';

# first, detect if Encode is available - it's not under 5.6. If we _are_
# under 5.6, give up - we'll just have to hope that nothing explodes. This
# is the current 0.54 behaviour, so that's ok.

my $CAN_USE_ENCODE;
BEGIN {
  eval " use Encode ";
  $CAN_USE_ENCODE = $@ ? 0 : 1;
}

sub new {
    my ($class, @args) = @_;
    my $self = {};
    bless $self, $class;
    return $self->_init(@args);
}

sub _init {
    my ($self, %args) = @_;

    if ( $args{dbh} ) {
        $self->{_dbh} = $args{dbh};
        $self->{_external_dbh} = 1; # don't disconnect at DESTROY time
    } else {
        die "Must supply a dbname" unless defined $args{dbname};
        $self->{_dbname} = $args{dbname};
        $self->{_dbuser} = $args{dbuser} || "";
        $self->{_dbpass} = $args{dbpass} || "";
        $self->{_dbhost} = $args{dbhost} || "";
        $self->{_charset} = $args{charset} || "iso-8859-1";

        # Connect to database and store the database handle.
        my ($dbname, $dbuser, $dbpass, $dbhost) =
                               @$self{qw(_dbname _dbuser _dbpass _dbhost)};
        my $dsn = $self->_dsn($dbname, $dbhost)
            or croak "No data source string provided by class";
        $self->{_dbh} = DBI->connect( $dsn, $dbuser, $dbpass,
				      { PrintError => 0, RaiseError => 1,
				        AutoCommit => 1 } )
          or croak "Can't connect to database $dbname using $dsn: "
                   . DBI->errstr;
    }

    return $self;
}

sub retrieve_node {
    my $self = shift;
    my %args = scalar @_ == 1 ? ( name => $_[0] ) : @_;
    # Note _retrieve_node_data is sensitive to calling context.
    return $self->_retrieve_node_data( %args ) unless wantarray;
    my %data = $self->_retrieve_node_data( %args );
    $data{checksum} = $self->_checksum(%data);
    return %data;
}

# Returns hash or scalar depending on calling context.
sub _retrieve_node_data {
    my ($self, %args) = @_;
    my %data = $self->_retrieve_node_content( %args );
    return $data{content} unless wantarray;

    # If we want additional data then get it.  Note that $data{version}
    # will already have been set by C<_retrieve_node_content>, if it wasn't
    # specified in the call.
    my $dbh = $self->dbh;
    my $sql = "SELECT metadata_type, metadata_value FROM metadata WHERE "
         . "node=" . $dbh->quote($self->charset_encode($args{name})) . " AND "
         . "version=" . $dbh->quote($self->charset_encode($data{version}));
    my $sth = $dbh->prepare($sql);
    $sth->execute or croak $dbh->errstr;
    my %metadata;
    while ( my ($type, $val) = $self->charset_decode( $sth->fetchrow_array ) ) {
        if ( defined $metadata{$type} ) {
	    push @{$metadata{$type}}, $val;
	} else {
            $metadata{$type} = [ $val ];
        }
    }
    $data{metadata} = \%metadata;
    return %data;
}

# $store->_retrieve_node_content( name    => $node_name,
#                                 version => $node_version );
# Params: 'name' is compulsory, 'version' is optional and defaults to latest.
# Returns a hash of data for C<retrieve_node> - content, version, last modified
sub _retrieve_node_content {
    my ($self, %args) = @_;
    croak "No valid node name supplied" unless $args{name};
    my $dbh = $self->dbh;
    my $sql;
    if ( $args{version} ) {
        $sql = "SELECT text, version, modified FROM content"
             . " WHERE  name=" . $dbh->quote($self->charset_encode($args{name}))
             . " AND version=" . $dbh->quote($self->charset_encode($args{version}));
    } else {
        $sql = "SELECT text, version, modified FROM node
                                WHERE name=" . $dbh->quote($self->charset_encode($args{name}));
    }
    my @results = $self->charset_decode( $dbh->selectrow_array($sql) );
    @results = ("", 0, "") unless scalar @results;
    my %data;
    @data{ qw( content version last_modified ) } = @results;
    return %data;
}

# Expects a hash as returned by ->retrieve_node
sub _checksum {
    my ($self, %node_data) = @_;
    my $string = $node_data{content};
    my %metadata = %{ $node_data{metadata} || {} };
    foreach my $key ( sort keys %metadata ) {
        $string .= "\0\0\0" . $key . "\0\0"
                 . join("\0", sort @{$metadata{$key}} );
    }
    return md5_hex($self->charset_encode($string));
}

# Expects an array of hashes whose keys and values are scalars.
sub _checksum_hashes {
    my ($self, @hashes) = @_;
    my @strings = "";
    foreach my $hashref ( @hashes ) {
        my %hash = %$hashref;
        my $substring = "";
        foreach my $key ( sort keys %hash ) {
            $substring .= "\0\0" . $key . "\0" . $hash{$key};
        }
        push @strings, $substring;
    }
    my $string = join("\0\0\0", sort @strings);
    return md5_hex($string);
}

sub node_exists {
    my $self = shift;
    if ( scalar @_ == 1 ) {
        my $node = shift;
        return $self->_do_old_node_exists( $node );
    } else {
        my %args = @_;
        return $self->_do_old_node_exists( $args{name} )
          unless $args{ignore_case};
        my $sql = $self->_get_node_exists_ignore_case_sql;
        my $sth = $self->dbh->prepare( $sql );
        $sth->execute( $args{name} );
        my $found_name = $sth->fetchrow_array || "";
        return lc($found_name) eq lc($args{name}) ? 1 : 0;
    }
}

sub _do_old_node_exists {
    my ($self, $node) = @_;
    my %data = $self->retrieve_node($node) or return ();
    return $data{version}; # will be 0 if node doesn't exist, >=1 otherwise
}

sub verify_checksum {
    my ($self, $node, $checksum) = @_;
#warn $self;
    my %node_data = $self->_retrieve_node_data( name => $node );
    return ( $checksum eq $self->_checksum( %node_data ) );
}

sub list_backlinks {
    my ( $self, %args ) = @_;
    my $node = $args{node};
    croak "Must supply a node name" unless $node;
    my $dbh = $self->dbh;
    my $sql = "SELECT link_from FROM internal_links WHERE link_to="
            . $dbh->quote($node);
    my $sth = $dbh->prepare($sql);
    $sth->execute or croak $dbh->errstr;
    my @backlinks;
    while ( my ($backlink) = $self->charset_decode( $sth->fetchrow_array ) ) {
        push @backlinks, $backlink;
    }
    return @backlinks;
}

sub list_dangling_links {
    my $self = shift;
    my $dbh = $self->dbh;
    my $sql = "SELECT DISTINCT internal_links.link_to
                              FROM internal_links LEFT JOIN node
                                                                      ON node.name=internal_links.link_to
                              WHERE node.version IS NULL";
    my $sth = $dbh->prepare($sql);
    $sth->execute or croak $dbh->errstr;
    my @links;
    while ( my ($link) = $self->charset_decode( $sth->fetchrow_array ) ) {
        push @links, $link;
    }
    return @links;
}

sub write_node_post_locking {
    my ($self, %args) = @_;
    my ($node, $content, $links_to_ref, $metadata_ref) =
                                @args{ qw( node content links_to metadata) };
    my $dbh = $self->dbh;

    my $timestamp = $self->_get_timestamp();
    my @links_to = @{ $links_to_ref || [] }; # default to empty array
    my $version;

    # Either inserting a new page or updating an old one.
    my $sql = "SELECT count(*) FROM node WHERE name=" . $dbh->quote($node);
    my $exists = @{ $dbh->selectcol_arrayref($sql) }[0] || 0;
    if ($exists) {
        $sql = "SELECT max(version) FROM content
                                WHERE name=" . $dbh->quote($node);
        $version = @{ $dbh->selectcol_arrayref($sql) }[0] || 0;
        croak "Can't get version number" unless $version;
        $version++;
        $sql = "UPDATE node SET version=" . $dbh->quote($version)
	     . ", text=" . $dbh->quote($self->charset_encode($content))
	     . ", modified=" . $dbh->quote($timestamp)
	     . " WHERE name=" . $dbh->quote($self->charset_encode($node));
	$dbh->do($sql) or croak "Error updating database: " . DBI->errstr;
    } else {
        $version = 1;
        $sql = "INSERT INTO node (name, version, text, modified)
                                VALUES ("
             . join(", ", map { $dbh->quote($self->charset_encode($_)) }
		              ($node, $version, $content, $timestamp)
                   )
             . ")";
	$dbh->do($sql) or croak "Error updating database: " . DBI->errstr;
    }

    # In either case we need to add to the history.
    $sql = "INSERT INTO content (name, version, text, modified)
                        VALUES ("
         . join(", ", map { $dbh->quote($self->charset_encode($_)) }
		          ($node, $version, $content, $timestamp)
               )
         . ")";
    $dbh->do($sql) or croak "Error updating database: " . DBI->errstr;

    # And to the backlinks.
    $dbh->do("DELETE FROM internal_links WHERE link_from="
             . $dbh->quote($self->charset_encode($node)) ) or croak $dbh->errstr;
    foreach my $links_to ( @links_to ) {
        $sql = "INSERT INTO internal_links (link_from, link_to) VALUES ("
             . join(", ", map { $dbh->quote($self->charset_encode($_)) } ( $node, $links_to ) ) . ")";
        # Better to drop a backlink or two than to lose the whole update.
        # Shevek wants a case-sensitive wiki, Jerakeen wants a case-insensitive
        # one, MySQL compares case-sensitively on varchars unless you add
        # the binary keyword.  Case-sensitivity to be revisited.
        eval { $dbh->do($sql); };
        carp "Couldn't index backlink: " . $dbh->errstr if $@;
    }

    # And also store any metadata.  Note that any entries already in the
    # metadata table refer to old versions, so we don't need to delete them.
    my %metadata = %{ $metadata_ref || {} }; # default to no metadata
    foreach my $type ( keys %metadata ) {
        my $val = $metadata{$type};

        # We might have one or many values; make an array now to merge cases.
        my @values = (ref $val and ref $val eq 'ARRAY') ? @$val : ( $val );

        # Find out whether all values for this type are scalars.
        my $all_scalars = 1;
        foreach my $value (@values) {
            $all_scalars = 0 if ref $value;
	}

        # If all values for this type are scalars, strip out any duplicates
        # and store the data.
        if ( $all_scalars ) {
            my %unique = map { $_ => 1 } @values;
            @values = keys %unique;

            foreach my $value ( @values ) {
                my $sql = "INSERT INTO metadata "
                    . "(node, version, metadata_type, metadata_value) VALUES ("
                    . join(", ", map { $dbh->quote($self->charset_encode($_)) }
                                 ( $node, $version, $type, $value )
                          )
                    . ")";
	        $dbh->do($sql) or croak $dbh->errstr;
	    }
	} else {
        # Otherwise grab a checksum and store that.
            my $type_to_store  = "__" . $type . "__checksum";
            my $value_to_store = $self->_checksum_hashes( @values );
            my $sql = "INSERT INTO metadata "
                    . "(node, version, metadata_type, metadata_value) VALUES ("
                    . join(", ", map { $dbh->quote($self->charset_encode($_)) }
                           ( $node, $version, $type_to_store, $value_to_store )
                          )
                    . ")";
	    $dbh->do($sql) or croak $dbh->errstr;
	}
    }

    # Finally call post_write on any plugins.
    my @plugins = @{ $args{plugins} || [ ] };
    foreach my $plugin (@plugins) {
        if ( $plugin->can( "post_write" ) ) {
            $plugin->post_write( node     => $node,
				 version  => $version,
				 content  => $content,
				 metadata => $metadata_ref );
	}
    }

    return 1;
}

# Returns the timestamp of now, unless epoch is supplied.
sub _get_timestamp {
    my $self = shift;
    # I don't care about no steenkin' timezones (yet).
    my $time = shift || localtime; # Overloaded by Time::Piece.
    unless( ref $time ) {
	$time = localtime($time); # Make it into an object for strftime
    }
    return $time->strftime($timestamp_fmt); # global
}

sub delete_node {
    my $self = shift;
    # Backwards compatibility.
    my %args = ( scalar @_ == 1 ) ? ( name => $_[0] ) : @_;

    my $dbh = $self->dbh;
    my ($name, $version, $wiki) = @args{ qw( name version wiki ) };

    # Trivial case - delete the whole node and all its history.
    unless ( $version ) {
        my $name = $dbh->quote($name);
        # Should start a transaction here.  FIXME.
        my $sql = "DELETE FROM node WHERE name=$name";
        $dbh->do($sql) or croak "Deletion failed: " . DBI->errstr;
        $sql = "DELETE FROM content WHERE name=$name";
        $dbh->do($sql) or croak "Deletion failed: " . DBI->errstr;
        $sql = "DELETE FROM internal_links WHERE link_from=$name";
        $dbh->do($sql) or croak $dbh->errstr;
        $sql = "DELETE FROM metadata WHERE node=$name";
        $dbh->do($sql) or croak $dbh->errstr;
        # And finish it here.
        return 1;
    }

    # Skip out early if we're trying to delete a nonexistent version.
    my %verdata = $self->retrieve_node( name => $name, version => $version );
    return 1 unless $verdata{version};

    # Reduce to trivial case if deleting the only version.
    my $sql = "SELECT COUNT(*) FROM content WHERE name=?";
    my $sth = $dbh->prepare( $sql );
    $sth->execute( $name ) or croak "Deletion failed: " . $dbh->errstr;
    my ($count) = $sth->fetchrow_array;
    return $self->delete_node( $name ) if $count == 1;

    # Check whether we're deleting the latest version.
    my %currdata = $self->retrieve_node( name => $name );
    if ( $currdata{version} == $version ) {
        # Can't just grab version ($version - 1) since it may have been
        # deleted itself.
        my $try = $version - 1;
        my %prevdata;
        until ( $prevdata{version} ) {
            %prevdata = $self->retrieve_node(
                                              name    => $name,
                                              version => $try,
                                            );
            $try--;
	}
        my $sql="UPDATE node SET version=?, text=?, modified=? WHERE name=?";
        my $sth = $dbh->prepare( $sql );
        $sth->execute( @prevdata{ qw( version content last_modified ) }, $name)
          or croak "Deletion failed: " . $dbh->errstr;
        $sql = "DELETE FROM content WHERE name=? AND version=?";
        $sth = $dbh->prepare( $sql );
        $sth->execute( $name, $version )
          or croak "Deletion failed: " . $dbh->errstr;
        $sql = "DELETE FROM internal_links WHERE link_from=?";
        $sth = $dbh->prepare( $sql );
        $sth->execute( $name )
          or croak "Deletion failed: " . $dbh->errstr;
        my @links_to;
        my $formatter = $wiki->formatter;
        if ( $formatter->can( "find_internal_links" ) ) {
            # Supply $metadata to formatter in case it's needed to alter the
            # behaviour of the formatter, eg for CGI::Wiki::Formatter::Multiple
            my @all = $formatter->find_internal_links(
                                    $prevdata{content}, $prevdata{metadata} );
            my %unique = map { $_ => 1 } @all;
            @links_to = keys %unique;
        }
        $sql = "INSERT INTO internal_links (link_from, link_to) VALUES (?,?)";
        $sth = $dbh->prepare( $sql );
        foreach my $link ( @links_to ) {
            eval { $sth->execute( $name, $link ); };
            carp "Couldn't index backlink: " . $dbh->errstr if $@;
        }
        $sql = "DELETE FROM metadata WHERE node=? and version=?";
        $sth = $dbh->prepare( $sql );
        $sth->execute( $name, $version )
          or croak "Deletion failed: " . $dbh->errstr;
        return 1;
    }

    # If we're still here, then we're deleting neither the latest
    # nor the only version.
    $sql = "DELETE FROM content WHERE name=? AND version=?";
    $sth = $dbh->prepare( $sql );
    $sth->execute( $name, $version )
      or croak "Deletion failed: " . $dbh->errstr;
    $sql = "DELETE FROM metadata WHERE node=? and version=?";
    $sth = $dbh->prepare( $sql );
    $sth->execute( $name, $version )
      or croak "Deletion failed: " . $dbh->errstr;

    return 1;
}

sub list_recent_changes {
    my $self = shift;
    my %args = @_;
    if ($args{since}) {
        return $self->_find_recent_changes_by_criteria( %args );
    } elsif ($args{between_days}) {
        return $self->_find_recent_changes_by_criteria( %args );
    } elsif ( $args{days} ) {
        my $now = localtime;
	my $then = $now - ( ONE_DAY * $args{days} );
        $args{since} = $then;
        delete $args{days};
        return $self->_find_recent_changes_by_criteria( %args );
    } elsif ( $args{last_n_changes} ) {
        $args{limit} = delete $args{last_n_changes};
        return $self->_find_recent_changes_by_criteria( %args );
    } else {
	croak "Need to supply some criteria to list_recent_changes.";
    }
}

sub _find_recent_changes_by_criteria {
    my ($self, %args) = @_;
    my ($since, $limit, $between_days, $ignore_case,
        $metadata_is,  $metadata_isnt, $metadata_was, $metadata_wasnt ) =
         @args{ qw( since limit between_days ignore_case
                    metadata_is metadata_isnt metadata_was metadata_wasnt) };
    my $dbh = $self->dbh;

    my @where;
    my @metadata_joins;
    my $main_table = $args{include_all_changes} ? "content" : "node";
    if ( $metadata_is || $metadata_isnt ) {
        if ( $metadata_is ) {
            my $i = 0;
            foreach my $type ( keys %$metadata_is ) {
                $i++;
                my $value  = $metadata_is->{$type};
                croak "metadata_is must have scalar values" if ref $value;
                my $mdt = "md_is_$i";
                push @metadata_joins, "LEFT JOIN metadata AS $mdt
                                                                  ON $main_table.name=$mdt.node
                                                                  AND $main_table.version=$mdt.version\n";
                push @where, "( "
                         . $self->_get_comparison_sql(
                                          thing1      => "$mdt.metadata_type",
                                          thing2      => $dbh->quote($type),
                                          ignore_case => $ignore_case,
                                                     )
                         . " AND "
                         . $self->_get_comparison_sql(
                                          thing1      => "$mdt.metadata_value",
                                          thing2      => $dbh->quote($value),
                                          ignore_case => $ignore_case,
                                                     )
                         . " )";
	    }
	}
        if ( $metadata_isnt ) {
            foreach my $type ( keys %$metadata_isnt ) {
                my $value  = $metadata_isnt->{$type};
                croak "metadata_isnt must have scalar values" if ref $value;
	    }
            my @omits = $self->_find_recent_changes_by_criteria(
                since        => $since,
                between_days => $between_days,
                metadata_is  => $metadata_isnt,
                ignore_case  => $ignore_case,
            );
            foreach my $omit ( @omits ) {
                push @where, "( node.name != " . $dbh->quote($omit->{name})
                     . "  OR node.version != " . $dbh->quote($omit->{version})
                     . ")";
	    }
	}
    } else {
        if ( $metadata_was ) {
            $main_table = "content";
            my $i = 0;
            foreach my $type ( keys %$metadata_was ) {
                $i++;
                my $value  = $metadata_was->{$type};
                croak "metadata_was must have scalar values" if ref $value;
                my $mdt = "md_was_$i";
                push @metadata_joins, "LEFT JOIN metadata AS $mdt
                                                                  ON $main_table.name=$mdt.node
                                                                  AND $main_table.version=$mdt.version\n";
                push @where, "( "
                         . $self->_get_comparison_sql(
                                          thing1      => "$mdt.metadata_type",
                                          thing2      => $dbh->quote($type),
                                          ignore_case => $ignore_case,
                                                     )
                         . " AND "
                         . $self->_get_comparison_sql(
                                          thing1      => "$mdt.metadata_value",
                                          thing2      => $dbh->quote($value),
                                          ignore_case => $ignore_case,
                                                     )
                         . " )";
	    }
	}
        if ( $metadata_wasnt ) {
            $main_table = "content";
            foreach my $type ( keys %$metadata_wasnt ) {
                my $value  = $metadata_was->{$type};
                croak "metadata_was must have scalar values" if ref $value;
	    }
            my @omits = $self->_find_recent_changes_by_criteria(
                since        => $since,
                between_days => $between_days,
                metadata_was => $metadata_wasnt,
                ignore_case  => $ignore_case,
            );
            foreach my $omit ( @omits ) {
                push @where, "( content.name != " . $dbh->quote($omit->{name})
                 . "  OR content.version != " . $dbh->quote($omit->{version})
                 . ")";
	    }
	}
    }

    if ( $since ) {
        my $timestamp = $self->_get_timestamp( $since );
        push @where, "$main_table.modified >= " . $dbh->quote($timestamp);
    } elsif ( $between_days ) {
        my $now = localtime;
        # Start is the larger number of days ago.
        my ($start, $end) = @$between_days;
        ($start, $end) = ($end, $start) if $start < $end;
        my $ts_start = $self->_get_timestamp( $now - (ONE_DAY * $start) ); 
        my $ts_end = $self->_get_timestamp( $now - (ONE_DAY * $end) ); 
        push @where, "$main_table.modified >= " . $dbh->quote($ts_start);
        push @where, "$main_table.modified <= " . $dbh->quote($ts_end);
    }

    my $sql = "SELECT DISTINCT
                                                              $main_table.name,
                                                              $main_table.version,
                                                              $main_table.modified
                              FROM $main_table
                            "
            . join("\n", @metadata_joins)
            . (
                scalar @where
                              ? " WHERE " . join(" AND ",@where) 
                              : ""
              )
            . " ORDER BY $main_table.modified DESC";
    if ( $limit ) {
        croak "Bad argument $limit" unless $limit =~ /^\d+$/;
        $sql .= " LIMIT $limit";
    }
#print "\n\n$sql\n\n";
    my $nodesref = $dbh->selectall_arrayref($sql);
    my @finds = map { { name          => $_->[0],
			version       => $_->[1],
			last_modified => $_->[2] }
		    } @$nodesref;
    foreach my $find ( @finds ) {
        my %metadata;
        my $sth = $dbh->prepare( "SELECT metadata_type, metadata_value
                                                                    FROM metadata WHERE node=? AND version=?" );
        $sth->execute( $find->{name}, $find->{version} );
        while ( my ($type, $value) = $self->charset_decode( $sth->fetchrow_array ) ) {
	    if ( defined $metadata{$type} ) {
                push @{$metadata{$type}}, $value;
	    } else {
                $metadata{$type} = [ $value ];
            }
	}
        $find->{metadata} = \%metadata;
    }
    return @finds;
}

sub list_all_nodes {
    my $self = shift;
    my $dbh = $self->dbh;
    my $sql = "SELECT name FROM node;";
    my $nodes = $dbh->selectall_arrayref($sql); 
    return ( map { $self->charset_decode( $_->[0] ) } (@$nodes) );
}

sub list_nodes_by_metadata {
    my ($self, %args) = @_;
    my ( $type, $value ) = @args{ qw( metadata_type metadata_value ) };
    return () unless $type;

    my $dbh = $self->dbh;
    if ( $args{ignore_case} ) {
        $type  = lc( $type  );
        $value = lc( $value );
    }
    my $sql =
         $self->_get_list_by_metadata_sql( ignore_case => $args{ignore_case} );
    my $sth = $dbh->prepare( $sql );
    $sth->execute( $type, $value );
    my @nodes;
    while ( my ($node) = $sth->fetchrow_array ) {
        push @nodes, $node;
    }
    return @nodes;
}

sub _get_list_by_metadata_sql {
    # can be over-ridden by database-specific subclasses
    return "SELECT node.name FROM node, metadata"
         . " WHERE node.name=metadata.node"
         . " AND node.version=metadata.version"
         . " AND metadata.metadata_type = ? "
         . " AND metadata.metadata_value = ? ";
}

sub _get_comparison_sql {
    my ($self, %args) = @_;
    # can be over-ridden by database-specific subclasses
    return "$args{thing1} = $args{thing2}";
}

sub _get_node_exists_ignore_case_sql {
    # can be over-ridden by database-specific subclasses
    return "SELECT name FROM node WHERE name = ? ";
}

sub dbh {
    my $self = shift;
    return $self->{_dbh};
}

sub dbname {
    my $self = shift;
    return $self->{_dbname};
}

sub dbuser {
    my $self = shift;
    return $self->{_dbuser};
}

sub dbpass {
    my $self = shift;
    return $self->{_dbpass};
}

sub dbhost {
    my $self = shift;
    return $self->{_dbhost};
}

# Cleanup.
sub DESTROY {
    my $self = shift;
    return if $self->{_external_dbh};
    my $dbh = $self->dbh;
    $dbh->disconnect if $dbh;
}

# decode a string of octets into perl's internal encoding, based on the
# charset parameter we were passed. Takes a list, returns a list.
sub charset_decode {
  my $self = shift;
  my @input = @_;
  if ($CAN_USE_ENCODE) {
    my @output;
    for (@input) {
      push( @output, Encode::decode( $self->{_charset}, $_ ) );
    }
    return @output;
  }
  return @input;
}

# convert a perl string into a series of octets we can put into the database
# takes a list, returns a list
sub charset_encode {
  my $self = shift;
  my @input = @_;
  if ($CAN_USE_ENCODE) {
    my @output;
    for (@input) {
      push( @output, Encode::encode( $self->{_charset}, $_ ) );
    }
    return @output;
  }
  return @input;
}

1;