File Coverage

blib/lib/DBD/mysqlPP.pm

Criterion	Covered	Total	%
statement	56	226	24.7
branch	11	100	11.0
condition	11	25	44.0
subroutine	13	34	38.2
pod	0	1	0.0
total	91	386	23.5

package DBD::mysqlPP;
use strict;

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

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

sub driver
{
	return $drh if $drh;

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

	$drh = DBI::_new_drh($class, {
		Name        => 'mysqlPP',
		Version     => $VERSION,
		Err         => \$DBD::mysqlPP::err,
		Errstr      => \$DBD::mysqlPP::errstr,
		State       => \$DBD::mysqlPP::state,
		Attribution => 'DBD::mysqlPP by Hiroyuki OYAMA',
	}, {});
}


sub _parse_dsn
{
	my $class = shift;
	my ($dsn, $args) = @_;
	my($hash, $var, $val);
	return if ! defined $dsn;

	while (length $dsn) {
		if ($dsn =~ /([^:;]*)[:;](.*)/) {
			$val = $1;
			$dsn = $2;
		}
		else {
			$val = $dsn;
			$dsn = '';
		}
		if ($val =~ /([^=]*)=(.*)/) {
			$var = $1;
			$val = $2;
			if ($var eq 'hostname' || $var eq 'host') {
				$hash->{'host'} = $val;
			}
			elsif ($var eq 'db' || $var eq 'dbname') {
				$hash->{'database'} = $val;
			}
			else {
				$hash->{$var} = $val;
			}
		}
		else {
			for $var (@$args) {
				if (!defined($hash->{$var})) {
					$hash->{$var} = $val;
					last;
				}
			}
		}
	}
	return $hash;
}


sub _parse_dsn_host
{
	my($class, $dsn) = @_;
	my $hash = $class->_parse_dsn($dsn, ['host', 'port']);
	($hash->{'host'}, $hash->{'port'});
}



package DBD::mysqlPP::dr;

$DBD::mysqlPP::dr::imp_data_size = 0;

use Net::MySQL;
use strict;


sub connect
{
	my $drh = shift;
	my ($dsn, $user, $password, $attrhash) = @_;

	my $data_source_info = DBD::mysqlPP->_parse_dsn(
		$dsn, ['database', 'host', 'port'],
	);
	$user     ||= '';
	$password ||= '';

	my $dbh = DBI::_new_dbh($drh, {
		Name         => $dsn,
		USER         => $user,
		CURRENT_USRE => $user,
	}, {});
	eval {
		my $mysql = Net::MySQL->new(
			hostname => $data_source_info->{host},
			port     => $data_source_info->{port},
			database => $data_source_info->{database},
			user     => $user,
			password => $password,
			debug    => $attrhash->{protocol_dump},
		);
		$dbh->STORE(mysqlpp_connection => $mysql);
		$dbh->STORE(thread_id => $mysql->{server_thread_id});
	};
	if ($@) {
		return $dbh->DBI::set_err(1, $@);
	}
	return $dbh;
}


sub data_sources
{
	return ("dbi:mysqlPP:");
}


sub disconnect_all {}



package DBD::mysqlPP::db;

$DBD::mysqlPP::db::imp_data_size = 0;
use strict;


# Patterns referred to 'mysql_sub_escape_string()' of libmysql.c
sub quote
{
	my $dbh = shift;
	my ($statement, $type) = @_;
	return 'NULL' unless defined $statement;

	for ($statement) {
		s/\\/\\\\/g;
		s/\0/\\0/g;
		s/\n/\\n/g;
		s/\r/\\r/g;
		s/'/\\'/g;
		s/"/\\"/g;
		s/\x1a/\\Z/g;
	}
	return "'$statement'";
}

sub _count_param
{
	my @statement = split //, shift;
	my $num = 0;

	while (defined(my $c = shift @statement)) {
		if ($c eq '"' || $c eq "'") {
			my $end = $c;
			while (defined(my $c = shift @statement)) {
				last if $c eq $end;
				@statement = splice @statement, 2 if $c eq '\\';
			}
		}
		elsif ($c eq '?') {
			$num++;
		}
	}
	return $num;
}

sub prepare
{
	my $dbh = shift;
	my ($statement, @attribs) = @_;

	my $sth = DBI::_new_sth($dbh, {
		Statement => $statement,
	});
	$sth->STORE(mysqlpp_handle => $dbh->FETCH('mysqlpp_connection'));
	$sth->STORE(mysqlpp_params => []);
	$sth->STORE(NUM_OF_PARAMS => _count_param($statement));
	$sth;
}


sub commit
{
	my $dbh = shift;
	if ($dbh->FETCH('Warn')) {
		warn 'Commit ineffective while AutoCommit is on';
	}
	1;
}


sub rollback
{
	my $dbh = shift;
	if ($dbh->FETCH('Warn')) {
		warn 'Rollback ineffective while AutoCommit is on';
	}
	1;
}


sub tables
{
	my $dbh = shift;
	my @args = @_;
	my $mysql = $dbh->FETCH('mysqlpp_connection');

	my @database_list;
	eval {
		$mysql->query('show tables');
		die $mysql->get_error_message if $mysql->is_error;
		if ($mysql->has_selected_record) {
			my $record = $mysql->create_record_iterator;
			while (my $db_name = $record->each) {
				push @database_list, $db_name->[0];
			}
		}
	};
	if ($@) {
		warn $mysql->get_error_message;
	}
	return $mysql->is_error
		? undef
		: @database_list;
}


sub _ListDBs
{
	my $dbh = shift;
	my @args = @_;
	my $mysql = $dbh->FETCH('mysqlpp_connection');

	my @database_list;
	eval {
		$mysql->query('show databases');
		die $mysql->get_error_message if $mysql->is_error;
		if ($mysql->has_selected_record) {
			my $record = $mysql->create_record_iterator;
			while (my $db_name = $record->each) {
				push @database_list, $db_name->[0];
			}
		}
	};
	if ($@) {
		warn $mysql->get_error_message;
	}
	return $mysql->is_error
		? undef
		: @database_list;
}


sub _ListTables
{
	my $dbh = shift;
	return $dbh->tables;
}


sub disconnect
{
	return 1;
}


sub FETCH
{
	my $dbh = shift;
	my $key = shift;

	return 1 if $key eq 'AutoCommit';
	return $dbh->{$key} if $key =~ /^(?:mysqlpp_.*|thread_id|mysql_insertid)$/;
	return $dbh->SUPER::FETCH($key);
}


sub STORE
{
	my $dbh = shift;
	my ($key, $value) = @_;

	if ($key eq 'AutoCommit') {
		die "Can't disable AutoCommit" unless $value;
		return 1;
	}
	elsif ($key =~ /^(?:mysqlpp_.*|thread_id|mysql_insertid)$/) {
		$dbh->{$key} = $value;
		return 1;
	}
	return $dbh->SUPER::STORE($key, $value);
}


sub DESTROY
{
	my $dbh = shift;
	my $mysql = $dbh->FETCH('mysqlpp_connection');
	$mysql->close;
}


package DBD::mysqlPP::st;

$DBD::mysqlPP::st::imp_data_size = 0;
use strict;


sub bind_param
{
	my $sth = shift;
	my ($index, $value, $attr) = @_;
	my $type = (ref $attr) ? $attr->{TYPE} : $attr;
	if ($type) {
		my $dbh = $sth->{Database};
		$value = $dbh->quote($sth, $type);
	}
	my $params = $sth->FETCH('mysqlpp_param');
	$params->[$index - 1] = $value;
}



sub execute
{
	my $sth = shift;
	my @bind_values = @_;
	my $params = (@bind_values) ?
		\@bind_values : $sth->FETCH('mysqlpp_params');
	my $num_param = $sth->FETCH('NUM_OF_PARAMS');
	if (@$params != $num_param) {
		# ...
	}
    my $statement = _mysqlpp_bind_statement($sth, $params);
    #warn $statement;

	my $mysql = $sth->FETCH('mysqlpp_handle');
	my $result = eval {
		$sth->{mysqlpp_record_iterator} = undef;
		$mysql->query($statement);
		die if $mysql->is_error;

		my $dbh = $sth->{Database};
		$dbh->STORE(mysqlpp_insertid => $mysql->get_insert_id);
		$dbh->STORE(mysql_insertid => $mysql->get_insert_id);

		$sth->{mysqlpp_rows} = $mysql->get_affected_rows_length;
		if ($mysql->has_selected_record) {
			my $record = $mysql->create_record_iterator;
			$sth->{mysqlpp_record_iterator} = $record;
			$sth->STORE(NUM_OF_FIELDS => $record->get_field_length);
			$sth->STORE(NAME => [ $record->get_field_names ]);
		}
		$mysql->get_affected_rows_length;
	};
	if ($@) {
		$sth->DBI::set_err(
			$mysql->get_error_code, $mysql->get_error_message
		);
		return undef;
	}

	return $mysql->is_error
		? undef : $result
			? $result : '0E0';
}


sub fetch
{
	my $sth = shift;

	my $iterator = $sth->FETCH('mysqlpp_record_iterator');
	my $row = $iterator->each;
	return undef unless $row;

	if ($sth->FETCH('ChopBlanks')) {
		map {s/\s+$//} @$row;
	}
	return $sth->_set_fbav($row);
}
*fetchrow_arrayref = \&fetch;


sub rows
{
	my $sth = shift;
	$sth->FETCH('mysqlpp_rows');
}


sub FETCH
{
	my $dbh = shift;
	my $key = shift;

	return 1 if $key eq 'AutoCommit';
	return $dbh->{NAME} if $key eq 'NAME';
	return $dbh->{$key} if $key =~ /^mysqlpp_/;
	return $dbh->SUPER::FETCH($key);
}


sub STORE
{
	my $dbh = shift;
	my ($key, $value) = @_;

	if ($key eq 'AutoCommit') {
		die "Can't disable AutoCommit" unless $value;
		return 1;
	}
	elsif ($key eq 'NAME') {
		$dbh->{NAME} = $value;
		return 1;
	}
	elsif ($key =~ /^mysqlpp_/) {
		$dbh->{$key} = $value;
		return 1;
	}
	return $dbh->SUPER::STORE($key, $value);
}

sub _mysqlpp_bind_statement {
    my ($sth, $params) = @_;

    my @splitted = split qr/((?:\?)|(?:\bLIMIT\b))/i, $sth->{Statement};
    my $param_idx = 0;
    my $limit_found = 0;
    for (my $i=0; $i<@splitted; $i++ ) {
        my $dbh = $sth->{Database};
        if ( $splitted[$i] eq '?' && exists $params->[$param_idx] ) {
            my $value = $limit_found  && $params->[$param_idx] =~ qr/^\d+$/  ? $params->[$param_idx++]  #bind for LIMIT isn't need quote
                                                                             : $dbh->quote($params->[$param_idx++]);
            $splitted[$i] = $value;
            if ( exists $splitted[$i + 1]
                   && $splitted[$i + 1] !~ qr/,/ # qr/,/ is for LIMIT ?, ?
                   && $splitted[$i + 1] !~ qr/\bOFFSET\b/i  ) {
                $limit_found = 0;
            }
        }
        elsif( $splitted[$i] =~ qr/\bLIMIT\b/i ) {
            $limit_found = 1;
        }
	}
    return join '', @splitted;
}

sub DESTROY
{
	my $dbh = shift;

}


1;
__END__