view release on metacpan or  search on metacpan

lib/AnyEvent/MySQL/Imp.pm  view on Meta::CPAN

    recv_packet($hd, sub {
        if( substr($_[0], 0, 1) eq "\xFE" ) {
            $cb->();
        }
        else {
            skip_until_eof($hd, $cb);
        }
    });
}

=head2 send_packet($hd, $packet_num, $packet_frag1, $pack_frag2, ...)
=cut
sub send_packet {
    return if !$_[0];
    local $_[0] = $_[0];
    my $len = reduce { $a + length($b) } 0, @_[2..$#_];
    $_[0]->push_write(substr(pack('V', $len), 0, 3) . chr($_[1]) . join('', @_[2..$#_]));
}

=head2 _recv_field($hd, \@field)
=cut
sub _recv_field {
    warn "get field." if DEV;
    my $field = $_[1];
    recv_packet($_[0], sub {
        warn "got field!" if DEV;
        push @$field, [
            take_lcs($_[0]), take_lcs($_[0]), take_lcs($_[0]),
            take_lcs($_[0]), take_lcs($_[0]), take_lcs($_[0]),
            take_filler($_[0], 1),
            take_num($_[0], 2),
            take_num($_[0], 4),
            take_num($_[0], 1),
            take_num($_[0], 2),
            take_num($_[0], 1),
            take_filler($_[0], 2),
            take_lcb($_[0]),
        ];
    });
}

=head2 recv_response($hd, %opt, $cb->(TYPE, data...))
  RES_OK, $affected_rows, $insert_id, $server_status, $warning_count, $message
  RES_ERROR, $errno, $sqlstate, $message
  RES_RESULT, \@field, \@row
   $field[$i] = [$catalog, $db, $table, $org_table, $name, $org_name, $charsetnr, $length, $type, $flags, $decimals, $default]
   $row[$i] = [$field, $field, $field, ...]
  RES_PREPARE, $stmt_id, \@param, \@column, $warning_count
   $param[$i] = [$catalog, $db, $table, $org_table, $name, $org_name, $charsetnr, $length, $type, $flags, $decimals, $default]
   $column[$i] = [$catalog, $db, $table, $org_table, $name, $org_name, $charsetnr, $length, $type, $flags, $decimals, $default]
 opt:
  prepare (set to truthy to recv prepare_ok)
=cut
sub recv_response {
    my $cb = ref($_[-1]) eq 'CODE' ? pop : sub {};
    my($hd, %opt) = @_;

    if( DEV ) {
        my $cb0 = $cb;
        $cb = sub {
            use Data::Dumper;
            warn "recv_response: ".Dumper(\@_);
            &$cb0;
        };
    }

    recv_packet($hd, sub {
        my $head = substr($_[0], 0, 1);
        if( $head eq "\x00" ) { # OK
            substr($_[0], 0, 1, '');
            if( $opt{prepare} ) {
                my $stmt_id = take_num($_[0], 4);
                my $column_count = take_num($_[0], 2);
                my $param_count = take_num($_[0], 2);
                take_filler($_[0], 1);
                my $warning_count = take_num($_[0], 2);
                warn "stmt_id=$stmt_id, column_count=$column_count, param_count=$param_count, warning_count=$warning_count" if DEV;

                my(@param, @column);

                my $end_cv = AE::cv {
                    $cb->(RES_PREPARE, $stmt_id, \@param, \@column, $warning_count);
                };

                $end_cv->begin;

                if( $param_count ) {
                    $end_cv->begin;
                    for(my $i=0; $i<$param_count; ++$i) {
                        _recv_field($hd, \@param);
                    }
                    recv_packet($hd, sub { $end_cv->end }); # EOF
                }

                if( $column_count ) {
                    $end_cv->begin;
                    for(my $i=0; $i<$column_count; ++$i) {
                        _recv_field($hd, \@column);
                    }
                    recv_packet($hd, sub { $end_cv->end }); # EOF
                }

                $end_cv->end;
            }
            else {
                $cb->(
                    RES_OK,
                    take_lcb($_[0]),
                    take_lcb($_[0]),
                    take_num($_[0], 2),
                    take_num($_[0], 2),
                    $_[0],
                );
            }
        }
        elsif( $head eq "\xFF" ) { # Error
            substr($_[0], 0, 1, '');
            $cb->(
                RES_ERROR,
                take_num($_[0], 2),
                ( substr($_[0], 0, 1) eq '#' ?