Changeset: 760675f255c6 for MonetDB URL: http://dev.monetdb.org/hg/MonetDB?cmd=changeset;node=760675f255c6 Modified Files: clients/perl/Tests/dbitest_extensive.sql clients/perl/Tests/dbitest_small.sql Branch: headless Log Message:
Merge with default branch. diffs (truncated from 896 to 300 lines): diff --git a/clients/ChangeLog.Aug2011 b/clients/ChangeLog.Aug2011 --- a/clients/ChangeLog.Aug2011 +++ b/clients/ChangeLog.Aug2011 @@ -1,6 +1,14 @@ # ChangeLog file for clients # This file is updated with Maddlog +* Mon Sep 19 2011 Sjoerd Mullender <[email protected]> +- Perl: We now distinguish properly between TABLE and GLOBAL TEMPORARY + (the latter are recognized by being in the "tmp" schema). +- Perl: fixed a bunch of syntax errors. This fixes bug 2884. With thanks + to Rémy Chibois. +- Perl: Fixed DBD::monetdb table_info and tabletype_info. This fixes + bug 2885. With thanks to Rémy Chibois. + * Tue Sep 13 2011 Sjoerd Mullender <[email protected]> - mclient: fix display of varchar columns with only NULL values. - Fixed a bug in mclient/msqldump where an internal error occurred during diff --git a/clients/perl/DBD/monetdb.pm b/clients/perl/DBD/monetdb.pm --- a/clients/perl/DBD/monetdb.pm +++ b/clients/perl/DBD/monetdb.pm @@ -233,10 +233,11 @@ SQL my $ttp = { - 'TABLE' => 't."istable" = true and t."system" = false and t."temporary" = 0' -,'SYSTEM TABLE' => 't."istable" = true and t."system" = true and t."temporary" = 0' -,'LOCAL TEMPORARY' => 't."istable" = true and t."system" = false and t."temporary" = 1' -,'VIEW' => 't."istable" = false ' + 'TABLE' => 't."type" = 0 and t."system" = false and t."temporary" = 0 and s.name <> \'tmp\'' +,'GLOBAL TEMPORARY' => 't."type" = 0 and t."system" = false and t."temporary" = 0 and s.name = \'tmp\'' +,'SYSTEM TABLE' => 't."type" = 0 and t."system" = true and t."temporary" = 0' +,'LOCAL TEMPORARY' => 't."type" = 0 and t."system" = false and t."temporary" = 1' +,'VIEW' => 't."type" = 1 ' }; @@ -248,14 +249,16 @@ select distinct , cast( null as varchar( 128 ) ) as table_schem , cast( null as varchar( 128 ) ) as table_name , case - when $ttp->{'TABLE' } then cast('TABLE' as varchar( 254 ) ) - when $ttp->{'SYSTEM TABLE' } then cast('SYSTEM TABLE' as varchar( 254 ) ) - when $ttp->{'LOCAL TEMPORARY'} then cast('LOCAL TEMPORARY' as varchar( 254 ) ) - when $ttp->{'VIEW' } then cast('VIEW' as varchar( 254 ) ) - else cast('INTERNAL TABLE TYPE' as varchar( 254 ) ) + when $ttp->{'TABLE' } then cast('TABLE' as varchar( 254 ) ) + when $ttp->{'SYSTEM TABLE' } then cast('SYSTEM TABLE' as varchar( 254 ) ) + when $ttp->{'LOCAL TEMPORARY' } then cast('LOCAL TEMPORARY' as varchar( 254 ) ) + when $ttp->{'GLOBAL TEMPORARY'} then cast('GLOBAL TEMPORARY' as varchar( 254 ) ) + when $ttp->{'VIEW' } then cast('VIEW' as varchar( 254 ) ) + else cast('INTERNAL TABLE TYPE' as varchar( 254 ) ) end as table_type , cast( null as varchar( 254 ) ) as remarks - from sys."tables" t + from sys."tables" t, sys."schemas" s + where t."schema_id" = s."id" order by table_type SQL my $sth = $dbh->prepare($sql) or return; @@ -271,11 +274,12 @@ select cast( null as varchar( 128 ) ) as , s."name" as table_schem , t."name" as table_name , case - when $ttp->{'TABLE' } then cast('TABLE' as varchar( 254 ) ) - when $ttp->{'SYSTEM TABLE' } then cast('SYSTEM TABLE' as varchar( 254 ) ) - when $ttp->{'LOCAL TEMPORARY'} then cast('LOCAL TEMPORARY' as varchar( 254 ) ) - when $ttp->{'VIEW' } then cast('VIEW' as varchar( 254 ) ) - else cast('INTERNAL TABLE TYPE' as varchar( 254 ) ) + when $ttp->{'TABLE' } then cast('TABLE' as varchar( 254 ) ) + when $ttp->{'SYSTEM TABLE' } then cast('SYSTEM TABLE' as varchar( 254 ) ) + when $ttp->{'LOCAL TEMPORARY' } then cast('LOCAL TEMPORARY' as varchar( 254 ) ) + when $ttp->{'GLOBAL TEMPORARY'} then cast('GLOBAL TEMPORARY' as varchar( 254 ) ) + when $ttp->{'VIEW' } then cast('VIEW' as varchar( 254 ) ) + else cast('INTERNAL TABLE TYPE' as varchar( 254 ) ) end as table_type , cast( null as varchar( 254 ) ) as remarks from sys."schemas" s diff --git a/clients/perl/DBD/monetdb/GetInfo.pm b/clients/perl/DBD/monetdb/GetInfo.pm --- a/clients/perl/DBD/monetdb/GetInfo.pm +++ b/clients/perl/DBD/monetdb/GetInfo.pm @@ -22,7 +22,7 @@ use DBD::monetdb(); my $sql_driver = 'monetdb'; my $sql_ver_fmt = '%02d.%02d.%04d'; # ODBC version string: ##.##.##### -my $sql_driver_ver = sprintf $sql_ver_fmt, split(/\./, $DBD::monetdb::VERSION); +my $sql_driver_ver = sprintf $sql_ver_fmt, split(/\./, $DBD::monetdb::VERSION), 0; my @Keywords = qw( BOOLEAN diff --git a/clients/perl/Mapi.pm b/clients/perl/Mapi.pm --- a/clients/perl/Mapi.pm +++ b/clients/perl/Mapi.pm @@ -25,8 +25,8 @@ use Digest::SHA qw(sha1_hex sha256_hex s sub pass_chal { my ($passwd, @challenge) = @_; - if (@challenge[2] == 9) { - my $pwhash = @challenge[5]; + if ($challenge[2] == 9) { + my $pwhash = $challenge[5]; if ($pwhash eq 'SHA512') { $passwd = sha512_hex($passwd); } elsif ($pwhash eq 'SHA256') { @@ -39,33 +39,33 @@ sub pass_chal { warn "unsupported password hash: ".$pwhash; return; } - } elsif (@challenge[2] == 8) { + } elsif ($challenge[2] == 8) { # can leave passwd cleartext } else { - warn "unsupported protocol version: ".@challenge[2]; + warn "unsupported protocol version: ".$challenge[2]; return; } - my @cyphers = split(/,/, @challenge[3]); + my @cyphers = split(/,/, $challenge[3]); my $chal; foreach (@cyphers) { if ($_ eq 'SHA512') { - $chal = "{$_}".sha512_hex($passwd.@challenge[0]); + $chal = "{$_}".sha512_hex($passwd.$challenge[0]); last; } elsif ($_ eq 'SHA256') { - $chal = "{$_}".sha256_hex($passwd.@challenge[0]); + $chal = "{$_}".sha256_hex($passwd.$challenge[0]); last; } elsif ($_ eq 'SHA1') { - $chal = "{$_}".sha1_hex($passwd.@challenge[0]); + $chal = "{$_}".sha1_hex($passwd.$challenge[0]); last; } elsif ($_ eq 'MD5') { - $chal = "{$_}".md5_hex($passwd.@challenge[0]); + $chal = "{$_}".md5_hex($passwd.$challenge[0]); last; } } if (!$chal) { # we assume v8's "plain" - $chal = "{plain}".$passwd.@challenge[0]; + $chal = "{plain}".$passwd.$challenge[0]; } return $chal; @@ -118,7 +118,7 @@ sub new { $self->{socket}->close; print "Following redirect: $prompt\n" if ($self->{trace}); my @tokens = split(/[\n\/:\?]+/, $prompt); # dirty, but it's Perl anyway - return new Mapi(@tokens[3], @tokens[4], $user, $passwd, $lang, @tokens[5], $trace); + return new Mapi($tokens[3], $tokens[4], $user, $passwd, $lang, $tokens[5], $trace); } elsif ($prompt =~ /^\^mapi:merovingian:\/\/proxy/) { # proxied redirect do { @@ -240,7 +240,7 @@ sub getRow { my $row = $self->{lines}[$self->{next}++]; my @chars = split(//, $row); - if (@chars[0] eq '!') { + if ($chars[0] eq '!') { $self->error($row); my $i = 1; while ($self->{lines}[$i] =~ '!') { @@ -249,11 +249,11 @@ sub getRow { } $self->{active} = 0; return -1 - } elsif (@chars[0] eq '&') { + } elsif ($chars[0] eq '&') { # not expected - } elsif (@chars[0] eq '%') { + } elsif ($chars[0] eq '%') { # header line - } elsif (@chars[0] eq '[') { + } elsif ($chars[0] eq '[') { # row result $self->{row} = $row; if ($self->{nrcols} < 0) { @@ -261,13 +261,13 @@ sub getRow { $self->{nrcols}++; } $self->{active} = 1; - } elsif (@chars[0] eq '=') { + } elsif ($chars[0] eq '=') { # xml result line $self->{row} = substr($row, 1); # skip = $self->{active} = 1; - } elsif (@chars[0] eq '^') { + } elsif ($chars[0] eq '^') { # ^ redirect, ie use different server - } elsif (@chars[0] eq '#') { + } elsif ($chars[0] eq '#') { # warnings etc, skip, and return what follows return $self->getRow; } @@ -293,9 +293,9 @@ sub getBlock { $self->{offset} = 0; $self->{hdrs} = []; - if (@chars[0] eq '&') { - if (@chars[1] eq '1' || @chars[1] eq 6) { - if (@chars[1] eq '1') { + if ($chars[0] eq '&') { + if ($chars[1] eq '1' || $chars[1] eq 6) { + if ($chars[1] eq '1') { # &1 id result-count nr-cols rows-in-this-block my ($dummy,$id,$cnt,$nrcols,$replysize) = split(' ', $header); $self->{id} = $id; @@ -321,7 +321,7 @@ sub getBlock { $self->{row} = $self->{lines}[$self->{next}++]; $self->{active} = 1; - } elsif (@chars[1] eq '2') { # updates + } elsif ($chars[1] eq '2') { # updates my ($dummy,$cnt) = split(' ', $header); $self->{count} = $cnt; $self->{nrcols} = 1; @@ -329,16 +329,16 @@ sub getBlock { $self->{row} = "" . $cnt; $self->{next} = $cnt; # all done return -2; - } elsif (@chars[1] eq '3') { # transaction + } elsif ($chars[1] eq '3') { # transaction # nothing todo - } elsif (@chars[1] eq '4') { # auto_commit + } elsif ($chars[1] eq '4') { # auto_commit my ($dummy,$ac) = split(' ', $header); if ($ac eq 't') { $self->{auto_commit} = 1; } else { $self->{auto_commit} = 0; } - } elsif (@chars[1] eq '5') { # prepare + } elsif ($chars[1] eq '5') { # prepare my ($dummy,$id,$cnt,$nrcols,$replysize) = split(' ', $header); # TODO parse result, rows (type, digits, scale) $self->{count} = $cnt; @@ -380,7 +380,7 @@ sub getblock { my ($self) = @_; # now read back the same way - my $result; + my $result = ""; my $last_block = 0; do { my $flag; diff --git a/clients/perl/Tests/countries.sql b/clients/perl/Tests/countries.sql new file mode 100644 --- /dev/null +++ b/clients/perl/Tests/countries.sql @@ -0,0 +1,266 @@ +-- data file to be used with dbitest_extensive. +CREATE TABLE countries ( + cty_name VARCHAR(256), + cty_code VARCHAR(32) +); +COPY INTO countries FROM STDIN USING DELIMITERS '\t','\n','"' NULL AS ''; +AFGHANISTAN .af +ÅLAND ISLANDS .ax +ALBANIA .al +ALDERNEY +ALGERIA (El Djazaïr) .dz +AMERICAN SAMOA .as +ANDORRA .ad +ANGOLA .ao +ANGUILLA .ai +ANTARCTICA .aq +ANTIGUA AND BARBUDA .ag +ARGENTINA .ar +ARMENIA .am +ARUBA .aw +ASCENSION ISLAND .ac +AUSTRALIA .au +AUSTRIA .at +AZERBAIJAN .az +BAHAMAS .bs +BAHRAIN .bh +BANGLADESH .bd +BARBADOS .bb +BELARUS .by +BELGIUM .be +BELIZE .bz +BENIN .bj +BERMUDA .bm +BHUTAN .bt +BOLIVIA .bo +BONAIRE, ST. EUSTATIUS, AND SABA .bq +BOSNIA AND HERZEGOVINA .ba +BOTSWANA .bw +BOUVET ISLAND .bv +BRAZIL .br +BRITISH INDIAN OCEAN TERRITORY .io +BRUNEI DARUSSALAM .bn +BULGARIA .bg +BURKINA FASO .bf +BURUNDI .bi +CAMBODIA .kh +CAMEROON .cm +CANADA .ca _______________________________________________ Checkin-list mailing list [email protected] http://mail.monetdb.org/mailman/listinfo/checkin-list
