view release on metacpan or  search on metacpan

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

}

sub get_error_message {
    my ($self) = @_;
    return $self->{error_message};
}

# DBD::PgPPSjis (4 of 6)

sub parse_statement {
    my ($invocant, $statement) = @_;

    my $param_num = 0;
    my $comment_depth = 0;
    my @tokens = ('');

    Parse: for ($statement) {

        # Observe the default action at the end
        if (m{\G \z}xmsgc) {
            last Parse;
        }

        # C-style block comments nest, as specified in the SQL standard but unlike C
        elsif (m{\G( /\* (?:$sjis_mbcs|[\x00-\xFF])*? ) (?= /\* | \*/ ) }xmsgc) {
            $comment_depth++;
        }
        elsif ($comment_depth && m{\G( (?:$sjis_mbcs|[\x00-\xFF])*? ) (?= /\* | \*/ )}xmsgc) {
        }
        elsif ($comment_depth && m{\G( \*/ )}xmsgc) {
            $comment_depth--;
        }

        # string constants with C-style escapes
        elsif (m{\G( ' (?: \\\\ | '' | \\' | \\0 | \\b | \\f | \\n | \\r | \\t | $sjis_mbcs | [^'] )* ' )}xmsgc) {
        }
        elsif (m{\G( ' )}xmsgc) {
        }
        elsif (m{\G( \\ )}xmsgc) {
        }

        # quoted identifiers can contain any character, except the character with code zero
        # to include a double quote, write two double quotes
        elsif (m{\G( " (?: "" | $sjis_leading_byte[^\x00] | [^\x00"] )* " )}xmsgc) {
        }
        elsif (m{\G( " )}xmsgc) {
        }

        # standard SQL comment
        elsif (m{\G( -- (?:$sjis_mbcs|[^\n])* )}xmsgc) {
        }

        # placeholder
        elsif (m{\G \?}xmsgc) {
            pop @tokens if $tokens[-1] eq '';
            push @tokens, \(my $tmp = $param_num++), '';
            redo Parse;
        }

        # key words, numeric constants, etc
###     elsif (m{\G( \s+             | \w+                                                         | ::? | \$[0-9]+ | [-/*\$] | [^[:ascii:]]+                            | [\0-\037\177]+ )}xmsgc) {
        elsif (m{\G( [\t\n\f\r\x20]+ | [_ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0-9]+ | ::? | \$[0-9]+ | [-/*\$] | (?:$sjis_mbcs|[\x80\xA0-\xDF\xFD-\xFF])+ | [\0-\037\177]+ )}xmsgc) {
        }

        # operators are + - * / < > = ~ ! @ # % ^ & | ` ?
        # special characters are $ ( ) [ ] , ; : * .
        elsif (m{\G( [+<>=~!\@\#%^&|`,;.()\[\]{}]+ )}xmsgc) {
        }

        # panic
        else {
            die qq{BUG: Unknown cause syntax error occurs at @{[pos]}\n$statement\n};
        }

        $tokens[-1] .= $1;
        redo Parse;
    }

    pop @tokens if @tokens > 1 && $tokens[-1] eq '';

    return \@tokens;
}


package DBD::PgPPSjis::ProtocolStatement;

sub new {
    my ($class, $pgsql, $statement) = @_;
    bless {
        postgres  => $pgsql,
        statement => $statement,
        rows      => [],
    }, $class;
}

sub execute {
    my ($self) = @_;

    my $pgsql = $self->{postgres};
    my $handle = $pgsql->get_handle;

    my $query_packet = "Q$self->{statement}\0";
    print " ==> Query\n" if $DEBUG;
    DBD::PgPPSjis::Protocol::_dump_packet($query_packet);
    $handle->send($query_packet, 0);
    $self->{affected_rows} = 0;
    $self->{last_oid}      = undef;
    $self->{rows}          = [];

    my $stream = $pgsql->get_stream;
    my $packet = $stream->each;
    if ($packet->is_error) {
        $self->_to_end_of_response($stream);
        die $packet->get_message;
    }
    elsif ($packet->is_end_of_response) {
        return;
    }
    elsif ($packet->is_empty) {
        $self->_to_end_of_response($stream);
        return;
    }