view release on metacpan or  search on metacpan

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

		if ($error) {
			$dbh->DBI::set_err($error->get_error_code || -1, $error->get_error_message, $error->get_error_state);
			return 0;
		} elsif ($@) {
			$dbh->DBI::set_err(-1, $@);
			return 0;
		}
		# Return 1 if connection was reestablished.
		return 1;
	}
	# Return -1 if nothing besides a protocol ping was done.
	return -1;
}

sub disconnect {
	my $dbh = shift;
	my $wire = $dbh->FETCH('wire10_driver_dbh');
	$wire->disconnect if defined $wire;
	$dbh->STORE('wire10_thread_id', undef);
	$dbh->STORE('Active', 0);
	return 1;
}

sub DESTROY {
	my $dbh = shift;
	$dbh->disconnect if $dbh->FETCH('Active');
	$dbh->SUPER::DESTROY;
}

sub last_insert_id {
	my $dbh = shift;
	return $dbh->FETCH('wire10_insertid')
}

# TODO: Support more get_info properties as needed.
sub get_info {
	my $dbh = shift;
	my $type = shift;
	# 17: SQL_DBMS_NAME
	# Difficult to return something intelligent here, the server
	# only reports a version, not a daemon name in the handshake.
	return 'Wire10' if $type == 17;
	# 18: SQL_DBMS_VER
	return $dbh->FETCH('wire10_server_version') if $type == 18;
	# 29: SQL_IDENTIFIER_QUOTE_CHAR
	return '`' if $type == 29;
	# 41: SQL_CATALOG_NAME_SEPARATOR
	return '.' if $type == 41;
	# 114: SQL_CATALOG_LOCATION
	# According to MSDN, 0 means "catalog not supported" which is accurate.
	# (The server happily accepts, discards and prints a catalog named
	#  'def', though.)
	return 0 if $type == 114;
	# Return undef for unknown and unsupported attributes.
	return undef;
}

sub take_imp_data {
	my $dbh = shift;

	# Finish any active statements (important if streaming enabled).
	for my $sth (@{$dbh->{ChildHandles} || []}) {
		next unless $sth;
		$sth->finish if $sth->{Active};
	}

	# Take out core driver and remove reference to it.
	my $wire = $dbh->FETCH('wire10_driver_dbh');
	$dbh->STORE('wire10_driver_dbh', undef);

	# Remove reference to dbh from drh, probably also destroys dbh.
	$dbh->SUPER::take_imp_data;

	# Note: It would be nice to serialize or tie the core such that
	#       it can be be shared among interpreters running in different
	#       processes or threads.  Unfortunately, neither of the available
	#       modules, Storable and threads::shared, seem to be able to
	#       cope with socket handles:
	#
	#       Storable error: "Can't store GLOB items"
	#       threads::shared error: "Invalid value for shared scalar"
	#
	#       For now, we just return the core driver and expect that the
	#       caller serialize and deserialize the object if the caller needs
	#       to use it from a different context.

	# Return the core driver.
	return $wire;
}



package DBD::Wire10::st;

use strict;
use warnings;
use DBI qw(:sql_types);

$DBD::Wire10::st::imp_data_size = 0;

# TODO: Find out if DBI already calls a DBD st constructor somewhere
sub _constructor {
	my $sth = shift;
	my $wire = shift;
	my $sql = shift;

	my $ps = $wire->prepare($sql);

	# Store driver handle and prepared statement for later.
	$sth->STORE('wire10_driver_sth', $wire);
	$sth->STORE('wire10_prepared', $ps);
	$sth->STORE('NUM_OF_PARAMS', $ps->get_marker_count);
}

sub bind_param {
	my $sth = shift;
	my ($index, $value, $attr) = @_;
	my $binary = _test_for_binary_flag($sth, $attr);
	my $ps = $sth->FETCH('wire10_prepared');
	$ps->set_parameter($index, $value, $binary);
	return 1;
}

sub _test_for_binary_flag {
	my $sth = shift;
	my $attr = shift;
	return 0 unless defined $attr;
	my $binary = Net::Wire10::DATA_BINARY;
	my $text = Net::Wire10::DATA_TEXT;
	my $sqltype;
	# May be undefined.
	$sqltype = $attr if ref($attr) eq '';
	$sqltype = $attr->{TYPE} if ref($attr) eq 'HASH';
	if (defined $sqltype) {
		return $binary if $sqltype == SQL_BINARY;
		return $binary if $sqltype == SQL_VARBINARY;
		return $binary if $sqltype == SQL_LONGVARBINARY;
		return $binary if $sqltype == SQL_BLOB;
	}
	# For testing Oracle-based code with MySQL.
	# ORA_BLOB is 113, defined in Oracle.h.
	my $oratype;
	$oratype = $attr->{ora_type} if ref($attr) eq 'HASH';
	return $binary if defined $oratype and $oratype == 113;
	return $text;
}

sub execute {
	my $sth = shift;
	my @new_params = @_;
	my $dbh = $sth->{Database};
	my $wire = $sth->FETCH('wire10_driver_sth');
	my $ps = $sth->FETCH('wire10_prepared');

	unless (defined($ps)) {
		$sth->DBI::set_err(-1, "execute without prepare");
		return undef;
	}

	if (scalar(@new_params) > 0) {
		$ps->clear_parameter;
		my $i = 1;
		foreach my $p (@new_params) {
			$ps->set_parameter($i++, $p, 0);
		}
	}

	my $rowcount = eval {
		$sth->finish;
		my $stream_results = $sth->FETCH('wire10_streaming') || 0;
		my $res = $stream_results ? $ps->stream : $ps->query;

		die if $wire->get_error_info;

		$sth->STORE('wire10_warning_count', $res->get_warning_count);
		# For backward compatibility and/or do(), store in dbh too.
		my $dbh = $sth->{Database};
		$dbh->STORE('wire10_warning_count', $res->get_warning_count);

		if ($res->has_results) {
			$sth->{wire10_iterator} = $res;
			my @names = $res->get_column_info("name");
			$sth->STORE('NUM_OF_FIELDS', scalar @names);
			$sth->STORE('NAME', [@names]);
			my @flags = $res->get_column_info("flags");
			my @nullable = map { ! $_ & Net::Wire10::COLUMN_NOT_NULL } @flags;
			$sth->STORE('NULLABLE', [@nullable]);
			# DBI docs says this is important for bind_columns and bind_cols.
			$sth->STORE('Active', 1);
			# Note: Emulate DBD-MySQL by not resetting insertid in dbh (only sth).
			$sth->STORE('wire10_insertid', undef);
			$sth->{wire10_rows} = $res->get_no_of_selected_rows;
			return $res->get_no_of_selected_rows;
		} else {
			$sth->{wire10_iterator} = undef;
			$sth->STORE('NUM_OF_FIELDS', undef);
			$sth->STORE('NAME', undef);
			$sth->STORE('NULLABLE', undef);
			my $insertid;
			eval {
				$insertid = $res->get_insert_id;
			};
			if ($@) {
				# If the insert_id is too big for this Perl to handle,
				# extract it using an alternate method.
				my $res = $wire->query('SELECT LAST_INSERT_ID()');
				$insertid = $res->next_array()->[0] || 0;
			}
			$sth->STORE('wire10_insertid', $insertid);
			# For backward compatibility and/or do(), store in dbh too.
			$dbh->STORE('wire10_insertid', $insertid);
			$sth->{wire10_rows} = $res->get_no_of_affected_rows;
			return $res->get_no_of_affected_rows;
		}
	};

	my $error = $wire->get_error_info;
	if ($error) {
		$sth->DBI::set_err($error->get_error_code || -1, $error->get_error_message, $error->get_error_state);
		return undef;
	} elsif ($@) {
		$sth->DBI::set_err(-1, $@);
		return undef;
	}

	return $rowcount ? $rowcount : '0E0';
}

sub cancel {
	my $sth = shift;
	my $wire = $sth->FETCH('wire10_driver_sth');

	eval {
		$wire->cancel;
	};

	if ($@) {
		$sth->DBI::set_err(-1, $@);
		return undef;
	}

	return 1;
}

sub finish {
	my $sth = shift;
	my $dbh = $sth->{Database};
	# If in streaming mode, flush remaining results.
	my $iterator = $sth->{wire10_iterator};
	$iterator->spool if defined $iterator;
	$sth->{wire10_iterator} = undef;
	$sth->STORE('Active', 0);
	$sth->SUPER::finish;
}

sub fetchrow_arrayref {
	my $sth = shift;

	my $iterator = $sth->FETCH('wire10_iterator');
	unless ($iterator) {
		if ($sth->FETCH('Warn')) {
			warn 'fetch() without execute(), previous execute() failed, executed query does not have results, or last row was already fetched';
		}
		return undef;
	}

	my $row = undef;
	eval {
		$row = $iterator->next_array;
	};
	if ($@) {
		$sth->DBI::set_err(-1, $@);
		return undef;
	}
	if (! $row) {
		$sth->finish;
		return undef;
	}

	if ($sth->FETCH('ChopBlanks')) {
		map {s/\s+$//} @$row;
	}

	return $sth->_set_fbav($row);
}

# required alias for fetchrow_arrayref
*fetch = \&fetchrow_arrayref;

sub rows {
	my $sth = shift;
	my $rows = $sth->FETCH('wire10_rows');
	return $rows unless $rows == -1;
	return $sth->SUPER::rows;
}

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

	return $sth->{NAME} if $key eq 'NAME';
	return $sth->{NULLABLE} if $key eq 'NULLABLE';
	return $sth->{$key} if $key =~ /^wire10_/;
	return $sth->SUPER::FETCH($key);
}

sub STORE {
	my $sth = shift;

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

To bind binary data to a parameter, specify a type such as SQL_BLOB.  This prevents the data from being considered Latin-1 or Unicode text.  Example:

  $sth->bind_param(1, $mydata, SQL_BLOB);

Parameters are numbered beginning from 1.  SQL types are defined as optional exports in DBI:

  use DBI qw(:sql_types);

=head4 execute

Runs a prepared statement, optionally using parameters.  Parameters are supplied either via bind_param(), or directly in the call to execute().  When parameters are given in the call to execute(), they override earlier bound parameters for the durati...

=head4 cancel

Cancels the currently executing statement (or other blocking protocol command, such as C<ping()>).  Safe to call from another thread, but note that DBI currently prevents this.  Safe to call from a signal handler.

Use cancel for interactive code only, where a user may cancel an operation at any time.  Do not use cancel for setting query timeouts.  For that, just set the C<wire10_query_timeout> attribute to an appropriate number of seconds.

Always returns 1 (success).  The actual status of the query (finished or cancelled, depending on timing) appears in the thread which is running the query.

Use C<cancel()> to abort a query when the user presses CTRL-C:

  $SIG{INT} = sub { $sth->cancel; };

Notice that the driver core will terminate the connection when a C<cancel()> is performed.  A call to C<reconnect()> is thus required after a statement has been cancelled in order to reestablish the connection:

  {
    local $SIG{INT} = sub { $sth->cancel; };
    $sth->execute;
  }
  $dbh->reconnect;

If a cancel happens to be performed after the current command has finished executing (in a so-called race condition), it will instead take effect during the next command.  To avoid that the next user query is unduly aborted, a cancel can be flushed o...

=head4 finish

Clears out the resources used by a statement.  This is called automatically at the start of a new query, among other places, and is therefore normally not necessary to call explicitly.

=head4 fetchrow_arrayref

Fetch one row as an array.

There is a multitude of other fetch methods available, such as C<fetchrow_hashref>.  These methods are implemented in DBI, they internally make use of C<fetchrow_arrayref> to retrieve result data.  Refer to the DBI documentation for more information ...

=head4 fetch

Deprecated alias for fetchrow_arrayref.

=head4 rows

The number of affected rows after an UPDATE or similar query, or the number of rows so far read by the client during a SELECT or similar query.

=head3 I<Statement>: attributes

=head4 wire10_insertid

Contains the auto_increment value for the last row inserted.

  my $id = $sth->{wire10_insertid};

=head4 wire10_streaming

If this is set to 1 (or any value that evaluates to true), results will be streamed from the server rather than downloaded all at once, when the statement is executed.

  $sth->{wire10_streaming} = 1;

Notice that the underlying protocol has a limitation: when a streaming statement is active, no other statements can execute on the same connection.

=head4 wire10_warning_count

Contains the number of warnings produced by the last query.

  my $warnings = $sth->{wire10_warning_count};

=head4 ChopBlanks

If enabled, runs every field value in result sets through a regular expression that trims for whitespace.

=head4 NUM_OF_PARAMS

Returns the number of parameter tokens found in the prepared statement after a prepare().

=head4 NUM_OF_FIELDS

Returns the number of columns in the result set after a query has been executed.

  my $numCols = $sth->{NUM_OF_FIELDS};

=head4 NAME

Returns the names of all the columns in the result set after a query has been executed.

=head4 NULLABLE

Returns an array indicating for each column whether it has a NOT NULL constraint.

=head1 TROUBLESHOOTING

=head2 Supported operating systems and Perl versions

Over at CPAN Testers, there's a vast number of testers that do
a very good job of figuring out which versions work together:

L<http://static.cpantesters.org/distro/N/DBD-Wire10.html>

=head2 Differences from DBD-MySQL

=head3 Unicode always enabled

This driver always runs in a mode where international characters outside of the currently active ANSI code page are supported.

=head3 Binary data must be bound

Binary/BLOB data must be given as a bound parameter (see C<bind_param>) using fx. the C<SQL_BLOB> flag.  When using any other method, strings will as a default be interpreted as text.

=head3 Automatic reconnect

Automatic reconnection is not performed when a connection fails mid-execution.  The corresponding DBD-MySQL options C<auto_reconnect> and C<mysql_init_command> are therefore unavailable.

The driver expects you to call C<reconnect()> at any time you wish to check the connection status and (if need be) reestablish a connection with the server.

A good time and place to add a call to C<reconnect()> could be when a connection is first used after a long period of inactivity, plus at any point in your code where it is safe and appropriate to restart processing when an error occurs.

=head3 Automatic numerical trim

Numerical string values bound via C<bind_param()> and provided via C<execute()> parameters are not automatically trimmed of whitespace, even if they look like numbers.

=head3 Various missing protocol features

Various connection methods and other protocol features are not supported by the underlying driver.  See the "Unsupported features" chapter in the L<Net::Wire10> documentation for more information.

=head3 Supported DBI methods and attributes

Some methods are not yet supported in this driver, in particular type_info_all, table_info, column_info, primary_key_info and foreign_key_info.  Some attributes are not yet supported, in particular TYPE.

=head3 Supported C<mysql_> attributes

All of the C<mysql_> attributes are unavailable.  DBI requires that each driver uses a unique prefix, therefore this driver supports only attributes named C<wire10_>.

Not all C<mysql_> attributes have equivalently named C<wire10_> attributes.  For example, there is no C<mysql_use_result> attribute, but one called C<wire10_streaming> does exactly the same.

=head2 Dependencies

This module requires these other modules and libraries:

  L<DBI::DBI>
  L<Net::Wire10>

B<Net::Wire10> is a Pure Perl connector for MySQL, Sphinx and Drizzle servers.

B<Net::Wire10> implements the network protool used to communicate between server and client.

=head1 SEE ALSO

L<DBI::FAQ>
L<DBI::DBI>
L<Net::Wire10>

=head1 AUTHORS

DSN parsing and various code by Hiroyuki OYAMA E, Japan.  DBD boilerplate by DBD authors.  Various code by the open source team at Dubex A/S.

=head1 COPYRIGHT AND LICENCE

Copyright (C) 2002 and (C) 2009 as described in AUTHORS.

This is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=head1 WARRANTY

Because this software is licensed free of charge, there is
absolutely no warranty of any kind, expressed or implied.

=cut