view release on metacpan or  search on metacpan

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

            if ($tag == $ber2->NULL()) {
                $ber2->decode(NULL => \$field);
                push @$arg, undef;
            }
            elsif ($tag == $ber2->STRING()) {
                $ber2->decode(STRING => \$field);
                push @$arg, $field;
            }
            elsif ($tag == $ber2->INTEGER()) {
                $ber2->decode(INTEGER => \$field);
                push @$arg, $field;
            }
        }
        1;
    }
}


{
    package DBD::JDBC::BER::EXECUTE_REQ;

    # Modified from Convert::BER::SEQUENCE;
    sub pack_array {
        my ($self, $ber, $arg) = @_;  # $arg is an array ref
        my ($handle, $param_count, $param_list) = @$arg;
        
        # Convert::BER::_encode should have packed the tag value already.
        # Build up the message body using a new BER object.
        my $ber2 = $ber->new;
        $ber2->_encode([INTEGER => $handle]);  # handle
        
        $ber2->_encode([INTEGER => $param_count]);  # parameter count
        
        my $i = 0;
        while ($i < scalar(@$param_list)) {
            my ($value, $type) = ($param_list->[$i], $param_list->[$i+1]);
            $i += 2;
            
            # Parameters may be null, but a type will always be specified.
            defined $value 
                ? $ber2->_encode([STRING => $value]) 
                    : $ber2->_encode([NULL => 0]);
            $ber2->_encode([INTEGER => $type]);
        }
        
        $ber->pack_length(CORE::length($ber2->[ Convert::BER::_BUFFER() ]));
        $ber->[ Convert::BER::_BUFFER() ] .= $ber2->[ Convert::BER::_BUFFER() ];
        1;
    }
}

{
    package DBD::JDBC::BER::FETCH_RESP;
    # TODO: Can this be another MYSEQUENCE?
    sub unpack_array {
        my ($self, $ber, $arg) = @_;
        
        my ($ber2, $tag, $i, $field);
        $self->unpack($ber, \$ber2);
        
        # This value indicates whether or not there's a row to be decoded.
        $ber2->decode(INTEGER => \$i);
        push @$arg, $i;    
        
        if ($i) {
            # tag() will return undef when the end of the buffer is reached
            while ($tag = $ber2->tag()) {
                if ($tag == $ber2->NULL()) {
                    $ber2->decode(NULL => \$field);
                    push @$arg, undef;
                }
                elsif ($tag == $ber2->STRING()) {
                    $ber2->decode(STRING => \$field);
                    push @$arg, $field;
                }
                $i++;    # Used periodically in debugging.
            }
        }
        1;
    }
}


{
    package DBD::JDBC::BER::ERROR_RESP;

    # This will push hash references containing the components of
    # ERROR packets onto the array argument.
    sub unpack_array {
        my ($self, $ber, $arg) = @_;
        
        my ($ber2);
        $self->unpack($ber, \$ber2);
        
        # tag() will return undef when the end of the buffer is reached;
        while ($ber2->tag()) {
            my %error;
            $ber2->decode(ERROR => [STRING => \$error{'errstr'},
                                    STRING => \$error{'err'},
                                    STRING => \$error{'state'}]);
            push @$arg, \%error;
        }
        1;
    }
}



# A func request consists of a sequence in which the first
# element is a method name and the remaining elements are
# (alternating) values and typecodes.

{
    package DBD::JDBC::BER::CONNECTION_FUNC_REQ;

    # Modified from Convert::BER::SEQUENCE;
    sub pack_array {
        my ($self, $ber, $arg) = @_;  # $arg is an array ref
        my ($method, $param_list) = @$arg;
        
        # Convert::BER::_encode should have packed the tag value already.