MySQL::Packet 0.2007054

MySQL::Packet allows to encode and decode the MySQL binary protocol.

SYNOPSIS

Sorry for the absurdly verbose synopsis. I don't have a proper example script for you at the moment.

use MySQL::Packet qw(:debug); # dumping packet contents etc.
use MySQL::Packet qw(:test :decode); # decoding subs
use MySQL::Packet qw(:encode); # encoding subs

use MySQL::Packet qw(:COM :CLIENT :SERVER); # constants

my $packet;
my $greeting;
my $result;
my $field_end;

my $mysql_socket = whatever_i_do_to_connect();

while (read $mysql_socket, $_, 1000, length) {
if (not $packet) {
my $_packet = {};
my $rc = mysql_decode_header $_packet;
if ($rc < 0) {
die 'bad header';
}
elsif ($rc > 0) {
$packet = $_packet;
redo;
}
}
elsif (not $greeting) {
my $rc = mysql_decode_greeting $_packet;
if ($rc < 0) {
die 'bad greeting';
}
elsif ($rc > 0) {
mysql_debug_packet $packet;
$greeting = $packet;
undef $packet;
send_client_auth();
redo;
}
}
elsif (not $result) {
my $rc = mysql_decode_result $packet;
if ($rc < 0) {
die 'bad result';
}
elsif ($rc > 0) {
mysql_debug_packet $packet;
if ($packet->{error}) {
die 'the server hates me';
}
elsif ($packet->{end}) {
die 'this should never happen';
}
else {
if ($packet->{field_count}) {
$result = $packet;
# fields and rows to come
}
elsif (not $packet->{server_status} & SERVER_MORE_RESULTS_EXISTS) {
# that's that..
send_some_query();
}
}
undef $packet;
redo;
}
}
elsif (not $field_end) {
my $rc = do {
(mysql_test_var $packet}) ? (mysql_decode_field $packet)
: (mysql_decode_result $packet)
};
if ($rc < 0) {
die 'bad field packet';
}
elsif ($rc > 0) {
mysql_debug_packet $packet;
if ($packet->{error}) {
die 'the server hates me';
}
elsif ($packet->{end}) {
$field_end = $packet;
}
else {
do_something_with_field_metadata($packet);
}
undef $packet;
redo;
}
}
else {
my $rc = do {
(mysql_test_var $packet ? (mysql_decode_row $packet)
: (mysql_decode_result $packet)
};
if ($rc < 0) {
die 'bad row packet';
}
elsif ($rc > 0) {
mysql_debug_packet $packet;
if ($packet->{error}) {
die 'the server hates me';
}
elsif ($packet->{end}) {
undef $result;
undef $field_end;
unless ($packet->{server_status} & SERVER_MORE_RESULTS_EXISTS) {
# that's that..
send_some_query();
}
}
else {
my @row = @{ $packet->{row} };
do_something_with_row_data(@row);
}
undef $packet;
redo;
}
}
}

sub send_client_auth {
my $flags = CLIENT_LONG_PASSWORD | CLIENT_LONG_FLAG | CLIENT_PROTOCOL_41 | CLIENT_TRANSACTIONS | CLIENT_SECURE_CONNECTION;
$flags |= CLIENT_CONNECT_WITH_DB if $i_want_to;
my $pw_crypt = mysql_crypt 'my_password', $greeting->{crypt_seed};
my $packet_body = mysql_encode_client_auth (
$flags, # $client_flags
0x01000000, # $max_packet_size
$greeting->{server_lang}, # $charset_no
'my_username', # $username
$pw_crypt, # $pw_crypt
'my_database', # $database
);
my $packet_head = mysql_encode_header $packet_body, 1;
print $mysql_socket $packet_head, $packet_body;
}

sub send_some_query {
my $packet_body = mysql_encode_com_query 'SELECT * FROM foo';
my $packet_head = mysql_encode_header $packet_body;
print $mysql_socket $packet_head, $packet_body;
}

Product's homepage

Requirements:

· Perl