DBIx::MyServer::DBI - Perl server that speaks the MySQL protocol and then executes the received queries via DBI

	Please see the examples/dbi.pl file for a working demonstration

package DBIx::MyServer::DBI;
@ISA = qw(DBIx::MyServer);

use warnings;
use strict;
use DBI;
use DBIx::MyServer;

use constant MYSERVER_SQLTYPES => 30;

#
# During handshake, we may still issue SQL commands however we do not send the responses back to the client
#

use constant IN_HANDSHAKE => 1;

1;

sub comQuery {
### DBIx-MyServer-DBI-comQuery...
	my ($myserver, $query_text, $in_handshake) = @_;
#### $query_text
	my $dbh = $myserver->getDbh();

	my $sth = $dbh->prepare($query_text);

	return $myserver->sendErrorFromDBI($dbh) if not defined $sth;

	my $affected_rows = $sth->execute();
	$affected_rows = 0 if defined $affected_rows && $affected_rows eq '0E0';
	my $err = $sth->err();
	if (defined $err) {
		my $send_result = $myserver->sendErrorFromDBI($sth);
		return (defined $send_result) ? $query_text : undef;
	} elsif ((not defined $sth->{NUM_OF_FIELDS}) || ($sth->{NUM_OF_FIELDS} == 0)) {
		my $send_result = (not $in_handshake) ? $myserver->sendOK($dbh->{'mysql_info'}, $affected_rows, $sth->{mysql_insertid}, $sth->{'mysql_warning_count'}) : 1;
		return (defined $send_result) ? $query_text : undef;
	} else {
		my @definitions = map {
			my $flags = 0;
			$flags = $flags | DBIx::MyServer::NOT_NULL_FLAG if not $sth->{NULLABLE}->[$_];
			$flags = $flags | DBIx::MyServer::BLOB_FLAG if $sth->{mysql_is_blob}->[$_];
			$flags = $flags | DBIx::MyServer::UNIQUE_KEY_FLAG if $sth->{mysql_is_key}->[$_];
			$flags = $flags | DBIx::MyServer::PRI_KEY_FLAG if $sth->{mysql_is_pri_key}->[$_];
			$flags = $flags | DBIx::MyServer::AUTO_INCREMENT_FLAG if $sth->{mysql_is_auto_increment}->[$_];

			$myserver->newDefinition(
				name => $sth->{NAME}->[$_],
				type => $myserver->getSQLType($sth->{TYPE}->[$_]),
				length => $sth->{mysql_length}->[$_],
				flags => $flags
			);
		} (0..$sth->{NUM_OF_FIELDS}-1);

		return ($query_text, \@definitions, $sth->fetchall_arrayref());
	}
}

#
# comFieldList() converts the information provided from $dbh->column_info() into the format required by DBIx::MyServer
#


sub comFieldList {
### DBIx-MyServer-DBI-comFieldList()...
	my ($myserver, $table_name) = @_;
#### $table_name

	my $dbh = $myserver->[DBIx::MyServer::MYSERVER_DBH];
	my $sth = $dbh->column_info(undef, undef, $table_name, '%');

	return $myserver->sendErrorFromDBI($dbh) if not defined $sth;
	return $myserver->sendErrorFromDBI($sth) if $sth->err();

	my @definitions;
	while (my $hash_ref = $sth->fetchrow_hashref()) {
		push @definitions, $myserver->newDefinition(
			catalog => $hash_ref->{TABLE_CAT},
			database => $hash_ref->{TABLE_SCHEM},
			table => $hash_ref->{TABLE_NAME},
			org_table => $hash_ref->{TABLE_NAME},
			name => $hash_ref->{COLUMN_NAME},
			org_name => $hash_ref->{COLUMN_NAME},
			length => $hash_ref->{COLUMN_SIZE},
			type => $myserver->getSQLType($hash_ref->{DATA_TYPE}),
			decimals => $hash_ref->{DECIMAL_DIGITS},
			default => $hash_ref->{COLUMN_DEF}
		);
	};

	#
	# Please note we manually send the definitions here without header and with EOF
	#

	$myserver->sendDefinitions(\@definitions,1);
	return $myserver->sendEOF();
}

#
# authorise() calls the default authorization handler from DBIx::MyServer. If a DBI handle is available at connection
# establishment time and the client requested a connection to a specific database, we issue a USE statement to switch
# to that database. If the client has requested a utf8 character set, we set the DBI server accordingly.
#

sub authorize {
        my ($myserver, $remote_host, $username, $database) = @_;

	if (DBIx::MyServer::authorize(@_)) {
		my $dbh = $myserver->getDbh();
		return 1 if not defined $dbh;
		if ($dbh->{Driver}->{Name} eq 'mysql') {
			return undef if defined $database && not defined $myserver->comQuery("USE $database", IN_HANDSHAKE);
			return undef if $myserver->getClientCharset() == 33 && not defined $myserver->comQuery("SET NAMES utf8", IN_HANDSHAKE);
		}
	} else {
		return undef;
	}
}

sub new {
	my $myserver = DBIx::MyServer::new(@_);

	my $dbh = $myserver->getDbh();

	$myserver->setupSQLTypes() if defined $dbh;

	return $myserver;
}

sub setupSQLTypes {
	my $myserver = shift;
	my $dbh = $myserver->getDbh();
	if (defined $dbh) {
		my @type_info = @{$dbh->type_info_all()};

		my $sql_col = $type_info[0]->{DATA_TYPE};
		my $mysql_col = $type_info[0]->{mysql_native_type};
	
		foreach my $type (@type_info[1..$#type_info]) {
			my $sql_value = $type->[$sql_col];
			my $mysql_value = $type->[$mysql_col];
	
			# We use hash rather than array here because $sql_value may be negative
			$myserver->[MYSERVER_SQLTYPES]->{$sql_value} = $mysql_value;
		}
		return 1;
	} else {
		return 0;
	}
}

sub getSQLType {
	my ($myserver, $type) = @_;
	$myserver->setupSQLTypes() if not defined $myserver->[MYSERVER_SQLTYPES];
	return $myserver->[MYSERVER_SQLTYPES]->{$type};
}

sub sendErrorFromDBI {
	my ($myserver, $h) = @_;
	$myserver->sendError($h->errstr(), $h->err(), $h->state());

}

1;

__END__