view release on metacpan or  search on metacpan

lib/DBD/Wire10.pm  view on Meta::CPAN

# TODO: Find out why DBI croaks under PerlSvc when DBD::Wire10 and Net::Wire10
#       files are in UTF-8 (with BOM), this prevents using Unicode for the POD docs.

# TODO: Put in a place where people expect to find this driver, maybe alias
#       under package names matching the supported database systems?
#       (DBD::MySQL::Wire10, DBD::Sphinx::Wire10, DBD::Drizzle::Wire10 etc)

package DBD::Wire10;

use strict;
use warnings;
use DBI;
use vars qw($VERSION $err $errstr $state $drh);

$VERSION = '1.08';
$err = 0;
$errstr = '';
$state = undef;
$drh = undef;

our $methods_already_installed = 0;

sub driver {
	return $drh if $drh;

	my $class = shift;
	my $attr  = shift;
	$class .= '::dr';

	# TODO: core->ping() + core->connect() useful as a generic mechanism
	unless ($methods_already_installed++) {
		eval {
			my $method = "DBI::db::reconnect";
			my $file = "__FILENAME__";
			my $info = {};
			DBI->_install_method($method, $file, $info);
		};
		warn "Failed to register reconnect method: $@" if $@;
	}

	$drh = DBI::_new_drh($class, {
		Name        => 'Wire10',
		Version     => $VERSION,
	}, {});
	return $drh;
}

sub CLONE {
	undef $drh;
}

# TODO: Is there a shrinkwrapped function to do this
sub _parse_dsn {
	my $class = shift;
	my ($dsn, $args) = @_;
	my ($hash, $var, $val);
	return undef if ! defined $dsn;

	while (length $dsn) {
		if ($dsn =~ /([^:;]*)[:;](.*)/) {
			$val = $1;
			$dsn = $2;