monetdb-perl: MonetDB-CLI-MapiPP/MonetDB/CLI/Mapi.pm annotate

annotate MonetDB-CLI-MapiPP/MonetDB/CLI/Mapi.pm @ 1:f899cb48b4cc

Turned into independent repository. Updated version numbers to 1.00; added Fedora spec file; added top-level Makefile.

author	Sjoerd Mullender <sjoerd@acm.org>
date	Mon, 19 Sep 2016 15:20:16 +0200 (2016-09-19)
parents	Mapi.pm@cedccb7e0143
children	a0ec9e080a5b

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
1 f899cb48b4cc Turned into independent repository. Sjoerd Mullender <sjoerd@acm.org> parents: 0 diff changeset	7 package MonetDB::CLI::Mapi;
0 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
1 f899cb48b4cc Turned into independent repository. Sjoerd Mullender <sjoerd@acm.org> parents: 0 diff changeset	15 our $VERSION = '1.00';
f899cb48b4cc Turned into independent repository. Sjoerd Mullender <sjoerd@acm.org> parents: 0 diff changeset	16
0 cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	17 sub pass_chal {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	18 my ($passwd, @challenge) = @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	19 if ($challenge[2] == 9) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	20 my $pwhash = $challenge[5];
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	21 if ($pwhash eq 'SHA512') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	22 $passwd = sha512_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 'SHA256') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	24 $passwd = sha256_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 'SHA1') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	26 $passwd = sha1_hex($passwd);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	27 } elsif ($pwhash eq 'MD5') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	28 $passwd = md5_hex($passwd);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	29 } else {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	30 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	31 return;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	32 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	33 } else {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	34 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	35 return;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	36 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	37
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	38 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	39 my $chal;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	40 foreach (@cyphers) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	41 if ($_ eq 'SHA512') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	42 $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	43 last;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	44 } elsif ($_ eq 'SHA256') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	45 $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	46 last;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	47 } elsif ($_ eq 'SHA1') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	48 $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	49 last;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	50 } elsif ($_ eq 'MD5') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	51 $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	52 last;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	53 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	54 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	55 if (!$chal) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	56 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	57 return;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	58 }
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 return $chal;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	61 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	62
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	63 sub new {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	64 my $mapi = shift;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	65 my $host = shift \|\| 'localhost';
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	66 my $port = shift \|\| 50000;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	67 my $user = shift \|\| 'monetdb';
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	68 my $passwd = shift \|\| 'monetdb';
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	69 my $lang = shift \|\| 'sql';
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	70 my $db = shift \|\| '';
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	71 my $trace = shift \|\| 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	72 my $self = {};
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 bless( $self, $mapi );
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 $self->{trace} = $trace;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	77
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	78 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	79 $self->{host} = $host;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	80 $self->{port} = $port;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	81 $self->{user} = $user;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	82 $self->{passwd} = $passwd;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	83 $self->{lang} = $lang;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	84 $self->{db} = $db;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	85 $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	86 PeerAddr => $host,
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	87 PeerPort => $port,
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	88 Proto => 'tcp'
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	89 ) \|\| 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	90 $self->{piggyback} = [];
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	91 $self->{skip_in} = 0;
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 #binmode($self->{socket},":utf8");
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	94
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	95 #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	96 my $block = $self->getblock();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	97 my @challenge = split(/:/, $block);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	98 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	99
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	100 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	101
1 f899cb48b4cc Turned into independent repository. Sjoerd Mullender <sjoerd@acm.org> parents: 0 diff changeset	102 # content_byteorder(BIG/LIT):user:{cypher_algo}mypasswordchallenge_cyphered:lang:database:
0 cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	103 $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	104 my $prompt = $self->getblock();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	105 if ($prompt =~ /^\^mapi:monetdb:/) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	106 # full reconnect
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	107 $self->{socket}->close;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	108 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	109 my @tokens = split(/[\n\/:\?]+/, $prompt); # dirty, but it's Perl anyway
1 f899cb48b4cc Turned into independent repository. Sjoerd Mullender <sjoerd@acm.org> parents: 0 diff changeset	110 return new MonetDB::CLI::Mapi($tokens[3], $tokens[4], $user, $passwd, $lang, $tokens[5], $trace);
0 cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	111 } 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	112 # proxied redirect
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	113 do {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	114 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	115 $block = $self->getblock();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	116 @challenge = split(/:/, $block);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	117 $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	118 $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	119 $prompt = $self->getblock();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	120 } 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	121 } # 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	122 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	123 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	124 return $self;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	125 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	126
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	127 # 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	128 sub clone {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	129 my ($self,$src)= @_;
1 f899cb48b4cc Turned into independent repository. Sjoerd Mullender <sjoerd@acm.org> parents: 0 diff changeset	130 bless($self,"MonetDB::CLI::Mapi");
0 cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	131 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	132 $self->{host} = $src->{host};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	133 $self->{port} = $src->{port};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	134 $self->{user} = $src->{user};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	135 $self->{passwd} = $src->{passwd};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	136 $self->{lang} = $src->{lang};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	137 $self->{db} = $src->{db};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	138 $self->{socket} = $src->{socket};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	139 $self->resetState();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	140 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	141
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	142 sub mapiport_intern {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	143 my $mapiport = 'localhost:50000';
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	144 $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	145 return $mapiport;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	146 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	147
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	148 sub hostname {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	149 my ($hostname) = mapiport_intern() =~ /([^:]*)/;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	150 $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	151 return $hostname;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	152 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	153
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	154 sub portnr {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	155 my ($portnr) = mapiport_intern() =~ /:([^:]*)/;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	156 $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	157 return $portnr;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	158 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	159
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	160 sub disconnect {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	161 my ($self) = @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	162 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	163 $self->{socket}->close;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	164 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	165 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	166
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	167 sub showState {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	168 my ($self) = @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	169 if ($self->{trace}) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	170 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	171 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	172 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	173 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	174 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	175 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	176
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	177 sub resetState {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	178 my ($self) = @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	179 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	180 $self->{errstr}="";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	181 $self->{error}=0;
1 f899cb48b4cc Turned into independent repository. Sjoerd Mullender <sjoerd@acm.org> parents: 0 diff changeset	182 $self->{active}=0;
0 cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	183 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	184
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	185 #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	186 sub doRequest {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	187 my($self,$cmd) = @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	188
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	189 $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	190 # 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	191 $cmd = $cmd . "\n;\n";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	192 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	193 $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	194 $self->resetState();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	195 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	196
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	197 # 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	198 sub error {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	199 my ($self,$line) = @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	200 my $err = $self->{errstr};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	201 $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	202 $line =~ s/^\!//;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	203 $self->{errstr} = $err . $line;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	204 # $self->showState();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	205 $self->{row}= "";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	206 $self->{error} = 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	207 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	208 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	209
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	210 # 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	211 sub propertyTest {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	212 my ($self) =@_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	213 my $err= $self->{error};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	214 my $row= $self->{row};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	215 # $self->showState();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	216 if ($row =~ /^\#---/) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	217 $self->{row}= "";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	218 return 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	219 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	220 if ($row =~ /^\#.*\#/) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	221 $self->{row}= "";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	222 return 1;
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 return 0;
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
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	227
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	228 sub getRow {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	229 my ($self)= @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	230 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	231 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	232
1 f899cb48b4cc Turned into independent repository. Sjoerd Mullender <sjoerd@acm.org> parents: 0 diff changeset	233 if ($chars[0] eq '!') {
0 cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	234 $self->error($row);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	235 my $i = 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	236 while ($self->{lines}[$i] =~ '!') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	237 $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	238 $i++;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	239 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	240 $self->{active} = 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	241 return -1
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 # not expected
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 # header line
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	246 } elsif ($chars[0] eq '[') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	247 # row result
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	248 $self->{row} = $row;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	249 if ($self->{nrcols} < 0) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	250 $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	251 $self->{nrcols}++;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	252 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	253 $self->{active} = 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	254 } elsif ($chars[0] eq '=') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	255 # xml result line
1 f899cb48b4cc Turned into independent repository. Sjoerd Mullender <sjoerd@acm.org> parents: 0 diff changeset	256 $self->{row} = substr($row, 1); # skip =
0 cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	257 $self->{active} = 1;
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 # ^ 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	260 } elsif ($chars[0] eq '#') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	261 # 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	262 return $self->getRow;
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 return $self->{active};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	265 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	266
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	267 sub getBlock {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	268 my ($self)= @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	269 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	270 my $block = $self->getblock();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	271 @{$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	272
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	273 # 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	274 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	275
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	276 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	277
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	278 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	279 my @chars = split(//, $header);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	280
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	281 $self->{id} = -1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	282 $self->{nrcols} = -1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	283 $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	284 $self->{active} = 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	285 $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	286 $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	287 $self->{offset} = 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	288 $self->{hdrs} = [];
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	289
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	290 if ($chars[0] eq '&') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	291 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	292 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	293 # &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	294 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	295 $self->{id} = $id;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	296 $self->{count} = $cnt;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	297 $self->{nrcols} = $nrcols;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	298 $self->{replysize} = $replysize;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	299 } else {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	300 # &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	301 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	302 $self->{id} = $id;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	303 $self->{nrcols} = $nrcols;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	304 $self->{replysize} = $replysize;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	305 $self->{offset} = $offset;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	306 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	307 # 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	308 my $i = 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	309 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	310 $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	311 $i++;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	312 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	313 $self->{skip} = $i;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	314 $self->{next} = $i;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	315 $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	316
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	317 $self->{active} = 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	318 } 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	319 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	320 $self->{count} = $cnt;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	321 $self->{nrcols} = 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	322 $self->{replysize} = 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	323 $self->{row} = "" . $cnt;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	324 $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	325 return -2;
1 f899cb48b4cc Turned into independent repository. Sjoerd Mullender <sjoerd@acm.org> parents: 0 diff changeset	326 } elsif ($chars[1] eq '3') { # transaction
0 cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	327 # nothing todo
1 f899cb48b4cc Turned into independent repository. Sjoerd Mullender <sjoerd@acm.org> parents: 0 diff changeset	328 } elsif ($chars[1] eq '4') { # auto_commit
0 cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	329 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	330 if ($ac eq 't') {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	331 $self->{auto_commit} = 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	332 } else {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	333 $self->{auto_commit} = 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	334 }
1 f899cb48b4cc Turned into independent repository. Sjoerd Mullender <sjoerd@acm.org> parents: 0 diff changeset	335 } elsif ($chars[1] eq '5') { # prepare
0 cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	336 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	337 # 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	338 $self->{count} = $cnt;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	339 $self->{nrcols} = $nrcols;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	340 $self->{replysize} = $replysize;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	341 $self->{row} = "";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	342 $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	343 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	344 } else {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	345 return $self->getRow();
1 f899cb48b4cc Turned into independent repository. Sjoerd Mullender <sjoerd@acm.org> parents: 0 diff changeset	346 }
0 cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	347 return $self->{active};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	348 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	349
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	350 sub getReply {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	351 my ($self)= @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	352
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	353 if ($self->{active} == 0) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	354 return $self->getBlock();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	355 } 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	356 return $self->getRow();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	357 } 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	358 # get next slice
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	359 my $rs = $self->{replysize};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	360 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	361 $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	362 return $self->getBlock();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	363 } else {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	364 # 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	365 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	366 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	367 $self->{skip_in}++;
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 $self->{active} = 0;
1 f899cb48b4cc Turned into independent repository. Sjoerd Mullender <sjoerd@acm.org> parents: 0 diff changeset	370 }
0 cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	371 return $self->{active};
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 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	374
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	375 sub readFromSocket {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	376 my ($self, $ref, $count) = @_;
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 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	379
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	380 my $rcount = 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	381 $$ref \|\|= "";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	382
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	383 while ($count > 0) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	384 $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	385
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	386 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	387 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	388
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	389 $count -= $rcount;
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 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	392
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	393 sub getblock {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	394 my ($self) = @_;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	395
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	396 # 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	397 my $result = "";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	398 my $last_block = 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	399 do {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	400 my $flag;
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 $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	403
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	404 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	405 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	406 $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	407
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	408 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	409 if ($len > 0 ) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	410 my $data;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	411 $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	412 $result .= $data;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	413 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	414 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	415 } while ( !$last_block );
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	416 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	417
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	418 if ($self->{skip_in}) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	419 $self->{skip_in}--;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	420 goto &getblock;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	421 }
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 return $result;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	424 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	425
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	426 sub putblock {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	427 my $self = shift;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	428
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	429 # 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	430 my @blocks = (\(@{ $self->{piggyback} }), \(@_));
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	431 @{ $self->{piggyback} } = ();
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	432
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	433 # 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	434 # 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	435 my $out = '';
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	436 for my $blk (@blocks) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	437 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	438 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	439 my $pos = 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	440 my $last_block = 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	441 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	442 my $data;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	443
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	444 while ( !$last_block ) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	445 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	446 my $len = length($data);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	447 # set last-block-flag
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	448 $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	449 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	450 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	451 $out .= $flag . $data;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	452 }
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 $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	455 }
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 1;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	458
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a. Sjoerd Mullender <sjoerd@acm.org> parents: diff changeset	459 # vim: set ts=2 sw=2 expandtab:

Mercurial > hg > monetdb-perl

annotate MonetDB-CLI-MapiPP/MonetDB/CLI/Mapi.pm @ 1:f899cb48b4cc