monetdb-perl: Mapi.pm annotate

annotate Mapi.pm @ 0:cedccb7e0143

Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.

author	Sjoerd Mullender <sjoerd@acm.org>
date	Mon, 19 Sep 2016 15:15:52 +0200 (2016-09-19)
parents
children

rev	line source
0 cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	1 # This Source Code Form is subject to the terms of the Mozilla Public
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	2 # License, v. 2.0. If a copy of the MPL was not distributed with this
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	3 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	4 #
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	5 # Copyright 1997 - July 2008 CWI, August 2008 - 2016 MonetDB B.V.
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	6
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	7 package Mapi;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	8
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	9 use strict;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	10 use Socket;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	11 use IO::Socket;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	12 use Digest::MD5 'md5_hex';
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	13 use Digest::SHA qw(sha1_hex sha256_hex sha512_hex);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	14
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	15 sub pass_chal {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	16 my ($passwd, @challenge) = @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	17 if ($challenge[2] == 9) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	18 my $pwhash = $challenge[5];
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	19 if ($pwhash eq 'SHA512') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	20 $passwd = sha512_hex($passwd);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	21 } elsif ($pwhash eq 'SHA256') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	22 $passwd = sha256_hex($passwd);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	23 } elsif ($pwhash eq 'SHA1') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	24 $passwd = sha1_hex($passwd);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	25 } elsif ($pwhash eq 'MD5') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	26 $passwd = md5_hex($passwd);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	27 } else {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	28 warn "unsupported password hash: ".$pwhash;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	29 return;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	30 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	31 } else {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	32 warn "unsupported protocol version: ".$challenge[2];
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	33 return;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	34 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	35
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	36 my @cyphers = split(/,/, $challenge[3]);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	37 my $chal;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	38 foreach (@cyphers) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	39 if ($_ eq 'SHA512') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	40 $chal = "{$_}".sha512_hex($passwd.$challenge[0]);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	41 last;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	42 } elsif ($_ eq 'SHA256') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	43 $chal = "{$_}".sha256_hex($passwd.$challenge[0]);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	44 last;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	45 } elsif ($_ eq 'SHA1') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	46 $chal = "{$_}".sha1_hex($passwd.$challenge[0]);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	47 last;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	48 } elsif ($_ eq 'MD5') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	49 $chal = "{$_}".md5_hex($passwd.$challenge[0]);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	50 last;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	51 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	52 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	53 if (!$chal) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	54 warn "unsupported hash algorithm necessary for login: ".$challenge[3];
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	55 return;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	56 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	57
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	58 return $chal;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	59 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	60
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	61 sub new {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	62 my $mapi = shift;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	63 my $host = shift \|\| 'localhost';
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	64 my $port = shift \|\| 50000;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	65 my $user = shift \|\| 'monetdb';
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	66 my $passwd = shift \|\| 'monetdb';
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	67 my $lang = shift \|\| 'sql';
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	68 my $db = shift \|\| '';
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	69 my $trace = shift \|\| 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	70 my $self = {};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	71
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	72 bless( $self, $mapi );
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	73
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	74 $self->{trace} = $trace;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	75
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	76 print "new:$host,$port,$user,$passwd,$lang,$db\n" if ($self->{trace});
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	77 $self->{host} = $host;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	78 $self->{port} = $port;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	79 $self->{user} = $user;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	80 $self->{passwd} = $passwd;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	81 $self->{lang} = $lang;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	82 $self->{db} = $db;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	83 $self->{socket} = IO::Socket::INET->new(
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	84 PeerAddr => $host,
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	85 PeerPort => $port,
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	86 Proto => 'tcp'
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	87 ) \|\| die "!ERROR can't connect to $host:$port $!";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	88 $self->{piggyback} = [];
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	89 $self->{skip_in} = 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	90
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	91 #binmode($self->{socket},":utf8");
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	92
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	93 #block challenge:mserver:9:cypher(s):content_byteorder(BIG/LIT):pwhash\n");
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	94 my $block = $self->getblock();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	95 my @challenge = split(/:/, $block);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	96 print "Connection to socket established ($block)\n" if ($self->{trace});
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	97
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	98 my $passchal = pass_chal($passwd, @challenge) \|\| die;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	99
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	100 # content_byteorder(BIG/LIT):user:{cypher_algo}mypasswordchallenge_cyphered:lang:database:
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	101 $self->putblock("LIT:$user:$passchal:$lang:$db:\n");
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	102 my $prompt = $self->getblock();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	103 if ($prompt =~ /^\^mapi:monetdb:/) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	104 # full reconnect
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	105 $self->{socket}->close;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	106 print "Following redirect: $prompt\n" if ($self->{trace});
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	107 my @tokens = split(/[\n\/:\?]+/, $prompt); # dirty, but it's Perl anyway
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	108 return new Mapi($tokens[3], $tokens[4], $user, $passwd, $lang, $tokens[5], $trace);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	109 } elsif ($prompt =~ /^\^mapi:merovingian:\/\/proxy/) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	110 # proxied redirect
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	111 do {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	112 print "Being proxied by $host:$port\n" if ($self->{trace});
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	113 $block = $self->getblock();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	114 @challenge = split(/:/, $block);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	115 $passchal = pass_chal($passwd, @challenge) \|\| die;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	116 $self->putblock("LIT:$user:$passchal:$lang:$db:\n");
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	117 $prompt = $self->getblock();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	118 } while ($prompt =~ /^\^mapi:merovingian:proxy/);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	119 } # TODO: don't die on warnings (#)
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	120 die $prompt if ($prompt ne "");
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	121 print "Logged on $user\@$db with $lang\n" if ($self->{trace});
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	122 return $self;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	123 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	124
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	125 # How to create a duplicate
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	126 sub clone {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	127 my ($self,$src)= @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	128 bless($self,"Mapi");
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	129 print "cloning\n" if ($self->{trace});
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	130 $self->{host} = $src->{host};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	131 $self->{port} = $src->{port};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	132 $self->{user} = $src->{user};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	133 $self->{passwd} = $src->{passwd};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	134 $self->{lang} = $src->{lang};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	135 $self->{db} = $src->{db};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	136 $self->{socket} = $src->{socket};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	137 $self->resetState();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	138 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	139
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	140 sub mapiport_intern {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	141 my $mapiport = 'localhost:50000';
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	142 $mapiport = $ENV{'MAPIPORT'} if defined($ENV{'MAPIPORT'});
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	143 return $mapiport;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	144 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	145
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	146 sub hostname {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	147 my ($hostname) = mapiport_intern() =~ /([^:]*)/;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	148 $hostname = 'localhost' if ($hostname eq '');
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	149 return $hostname;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	150 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	151
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	152 sub portnr {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	153 my ($portnr) = mapiport_intern() =~ /:([^:]*)/;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	154 $portnr = 50000 if ($portnr eq '');
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	155 return $portnr;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	156 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	157
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	158 sub disconnect {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	159 my ($self) = @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	160 print "disconnect\n" if ($self->{trace});
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	161 $self->{socket}->close;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	162 print "Disconnected from server\n" if ($self->{trace});
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	163 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	164
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	165 sub showState {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	166 my ($self) = @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	167 if ($self->{trace}) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	168 print "mapi.error :".$self->{error}."\n";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	169 print "mapi.errstr:".$self->{errstr}."\n";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	170 print "mapi.active:".$self->{active}."\n";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	171 print "mapi.row[".length($self->{row})."]:".$self->{row}."\n";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	172 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	173 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	174
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	175 sub resetState {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	176 my ($self) = @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	177 print "resetState\n" if ($self->{trace});
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	178 $self->{errstr}="";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	179 $self->{error}=0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	180 $self->{active}=0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	181 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	182
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	183 #packge the request and ship it, the back-end reads blocks!
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	184 sub doRequest {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	185 my($self,$cmd) = @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	186
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	187 $cmd = "S" . $cmd if $self->{lang} eq 'sql';
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	188 # even if the query ends with a ;, this never hurts and fixes the -- on last line bug
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	189 $cmd = $cmd . "\n;\n";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	190 print "doRequest:$cmd\n" if ($self->{trace});
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	191 $self->putblock($cmd); # TODO handle exceptions \|\| die "!ERROR can't send $cmd: $!";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	192 $self->resetState();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	193 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	194
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	195 # Analyse a single line for errors
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	196 sub error {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	197 my ($self,$line) = @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	198 my $err = $self->{errstr};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	199 $err = "$err\n" if (length($err) > 0);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	200 $line =~ s/^\!//;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	201 $self->{errstr} = $err . $line;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	202 # $self->showState();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	203 $self->{row}= "";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	204 $self->{error} = 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	205 print "Error found $self->{error}\n" if ($self->{trace});
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	206 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	207
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	208 # analyse commentary lines for auxiliary information
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	209 sub propertyTest {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	210 my ($self) =@_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	211 my $err= $self->{error};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	212 my $row= $self->{row};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	213 # $self->showState();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	214 if ($row =~ /^\#---/) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	215 $self->{row}= "";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	216 return 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	217 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	218 if ($row =~ /^\#.*\#/) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	219 $self->{row}= "";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	220 return 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	221 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	222 return 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	223 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	224
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	225
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	226 sub getRow {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	227 my ($self)= @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	228 my $row = $self->{lines}[$self->{next}++];
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	229 my @chars = split(//, $row,3);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	230
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	231 if ($chars[0] eq '!') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	232 $self->error($row);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	233 my $i = 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	234 while ($self->{lines}[$i] =~ '!') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	235 $self->error($self->{lines}[$i]);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	236 $i++;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	237 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	238 $self->{active} = 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	239 return -1
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	240 } elsif ($chars[0] eq '&') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	241 # not expected
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	242 } elsif ($chars[0] eq '%') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	243 # header line
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	244 } elsif ($chars[0] eq '[') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	245 # row result
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	246 $self->{row} = $row;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	247 if ($self->{nrcols} < 0) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	248 $self->{nrcols} = () = $row =~ /,\t/g;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	249 $self->{nrcols}++;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	250 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	251 $self->{active} = 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	252 } elsif ($chars[0] eq '=') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	253 # xml result line
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	254 $self->{row} = substr($row, 1); # skip =
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	255 $self->{active} = 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	256 } elsif ($chars[0] eq '^') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	257 # ^ redirect, ie use different server
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	258 } elsif ($chars[0] eq '#') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	259 # warnings etc, skip, and return what follows
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	260 return $self->getRow;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	261 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	262 return $self->{active};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	263 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	264
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	265 sub getBlock {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	266 my ($self)= @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	267 print "getBlock $self->{active}\n" if ($self->{trace});
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	268 my $block = $self->getblock();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	269 @{$self->{lines}} = split(/\n/, $block);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	270
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	271 # skip diagnostic messages before the header
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	272 shift @{$self->{lines}} while @{$self->{lines}} && $self->{lines}[0] =~ /\A#/;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	273
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	274 die "implausible return from MonetDB: $self->{lines}[0]\n" if $self->{lines}[0] =~ /\A[^ -~]/;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	275
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	276 my $header = $self->{lines}[0];
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	277 my @chars = split(//, $header);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	278
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	279 $self->{id} = -1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	280 $self->{nrcols} = -1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	281 $self->{replysize} = scalar(@{$self->{lines}});
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	282 $self->{active} = 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	283 $self->{skip} = 0; # next+skip is current result row
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	284 $self->{next} = 0; # all done
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	285 $self->{offset} = 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	286 $self->{hdrs} = [];
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	287
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	288 if ($chars[0] eq '&') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	289 if ($chars[1] eq '1' \|\| $chars[1] eq 6) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	290 if ($chars[1] eq '1') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	291 # &1 id result-count nr-cols rows-in-this-block
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	292 my ($dummy,$id,$cnt,$nrcols,$replysize) = split(' ', $header);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	293 $self->{id} = $id;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	294 $self->{count} = $cnt;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	295 $self->{nrcols} = $nrcols;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	296 $self->{replysize} = $replysize;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	297 } else {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	298 # &6 id nr-cols,rows-in-this-block,offset
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	299 my ($dummy,$id,$nrcols,$replysize,$offset) = split(' ', $header);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	300 $self->{id} = $id;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	301 $self->{nrcols} = $nrcols;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	302 $self->{replysize} = $replysize;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	303 $self->{offset} = $offset;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	304 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	305 # for now skip table header information
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	306 my $i = 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	307 while ($self->{lines}[$i] =~ /\A%/) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	308 $self->{hdrs}[$i - 1] = $self->{lines}[$i];
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	309 $i++;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	310 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	311 $self->{skip} = $i;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	312 $self->{next} = $i;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	313 $self->{row} = $self->{lines}[$self->{next}++];
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	314
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	315 $self->{active} = 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	316 } elsif ($chars[1] eq '2') { # updates
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	317 my ($dummy,$cnt) = split(' ', $header);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	318 $self->{count} = $cnt;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	319 $self->{nrcols} = 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	320 $self->{replysize} = 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	321 $self->{row} = "" . $cnt;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	322 $self->{next} = $cnt; # all done
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	323 return -2;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	324 } elsif ($chars[1] eq '3') { # transaction
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	325 # nothing todo
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	326 } elsif ($chars[1] eq '4') { # auto_commit
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	327 my ($dummy,$ac) = split(' ', $header);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	328 if ($ac eq 't') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	329 $self->{auto_commit} = 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	330 } else {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	331 $self->{auto_commit} = 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	332 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	333 } elsif ($chars[1] eq '5') { # prepare
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	334 my ($dummy,$id,$cnt,$nrcols,$replysize) = split(' ', $header);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	335 # TODO parse result, rows (type, digits, scale)
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	336 $self->{count} = $cnt;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	337 $self->{nrcols} = $nrcols;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	338 $self->{replysize} = $replysize;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	339 $self->{row} = "";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	340 $self->{next} = $cnt; # all done
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	341 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	342 } else {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	343 return $self->getRow();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	344 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	345 return $self->{active};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	346 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	347
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	348 sub getReply {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	349 my ($self)= @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	350
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	351 if ($self->{active} == 0) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	352 return $self->getBlock();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	353 } elsif ($self->{next} < $self->{replysize} + $self->{skip}) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	354 return $self->getRow();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	355 } elsif (${self}->{offset} + $self->{replysize} < $self->{count}) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	356 # get next slice
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	357 my $rs = $self->{replysize};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	358 my $offset = $self->{offset} + $rs;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	359 $self->putblock("Xexport $self->{id} $offset $rs");
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	360 return $self->getBlock();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	361 } else {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	362 # close large results, but only send on next query
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	363 if ($self->{id} > 0 && $self->{count} != $self->{replysize}) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	364 push @{$self->{piggyback}}, "Xclose $self->{id}";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	365 $self->{skip_in}++;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	366 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	367 $self->{active} = 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	368 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	369 return $self->{active};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	370
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	371 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	372
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	373 sub readFromSocket {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	374 my ($self, $ref, $count) = @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	375
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	376 die "invalid buffer reference" unless (ref($ref) eq 'SCALAR');
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	377
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	378 my $rcount = 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	379 $$ref \|\|= "";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	380
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	381 while ($count > 0) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	382 $rcount = $self->{socket}->sysread($$ref, $count, length($$ref));
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	383
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	384 die "read error: $!" unless (defined($rcount));
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	385 die "no more data on socket" if ($rcount == 0);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	386
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	387 $count -= $rcount;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	388 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	389 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	390
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	391 sub getblock {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	392 my ($self) = @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	393
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	394 # now read back the same way
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	395 my $result = "";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	396 my $last_block = 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	397 do {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	398 my $flag;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	399
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	400 $self->readFromSocket(\$flag, 2); # read block info
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	401
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	402 my $unpacked = unpack( 'v', $flag ); # unpack (little endian short)
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	403 my $len = ( $unpacked >> 1 ); # get length
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	404 $last_block = $unpacked & 1; # get last-block-flag
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	405
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	406 print "getblock: $last_block $len\n" if ($self->{trace});
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	407 if ($len > 0 ) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	408 my $data;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	409 $self->readFromSocket(\$data, $len); # read
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	410 $result .= $data;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	411 print "getblock: $data\n" if ($self->{trace});
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	412 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	413 } while ( !$last_block );
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	414 print "IN:\n$result\n" if $ENV{MAPI_TRACE};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	415
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	416 if ($self->{skip_in}) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	417 $self->{skip_in}--;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	418 goto &getblock;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	419 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	420
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	421 return $result;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	422 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	423
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	424 sub putblock {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	425 my $self = shift;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	426
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	427 # there maybe something in the piggyback buffer
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	428 my @blocks = (\(@{ $self->{piggyback} }), \(@_));
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	429 @{ $self->{piggyback} } = ();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	430
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	431 # create blocks of data with max 0xffff length,
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	432 # then loop over the data and send it.
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	433 my $out = '';
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	434 for my $blk (@blocks) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	435 print "OUT:\n$$blk\n" if $ENV{MAPI_TRACE};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	436 utf8::downgrade($$blk); # deny wide chars
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	437 my $pos = 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	438 my $last_block = 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	439 my $blocksize = 0x7fff >> 1; # max len per block
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	440 my $data;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	441
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	442 while ( !$last_block ) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	443 my $data = substr($$blk, 0, $blocksize, "");
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	444 my $len = length($data);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	445 # set last-block-flag
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	446 $last_block = 1 if !length $$blk;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	447 my $flag = pack( 'v', ( $len << 1 ) + $last_block );
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	448 print "putblock: $last_block ".$data."\n" if ($self->{trace});
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	449 $out .= $flag . $data;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	450 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	451 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	452 $self->{socket}->syswrite($out); #send it
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	453 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	454
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	455 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	456
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	457 # vim: set ts=2 sw=2 expandtab:

Mercurial > hg > monetdb-perl

annotate Mapi.pm @ 0:cedccb7e0143