Mercurial > hg > monetdb-perl

comparison MonetDB-CLI-MapiPP/MonetDB/CLI/MapiPP.pm @ 0:cedccb7e0143

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
author Sjoerd Mullender <sjoerd@acm.org>
date Mon, 19 Sep 2016 15:15:52 +0200 (2016-09-19)
parents
children f899cb48b4cc
comparison
equal deleted inserted replaced
-1:000000000000 0:cedccb7e0143
1 package MonetDB::CLI::MapiPP;
2
3 use Text::ParseWords();
4 use Encode ();
5 use Mapi;
6 use strict;
7 use warnings;
8
9 our $VERSION = '0.04';
10
11
12 my %unescape = ( n => "\n", t => "\t", r => "\r", f => "\f");
13
14 sub unquote
15 {
16 if (!defined($_) || $_ eq 'NULL' || $_ eq 'nil') { $_ = undef; return; }
17
18 if ( /^["']/) {
19 s/^["']//;
20 s/["']$//;
21 s/\\([0-7]{3}|.)/length($1) == 3 ? chr(oct($1)) : ($unescape{$1} || $1)/eg;
22 }
23 }
24
25 sub connect
26 {
27 my ($class, $host, $port, $user, $pass, $lang, $db) = @_;
28
29 my $h = new Mapi($host, $port, $user, $pass, $lang, $db, 0)
30 or die "Making connection failed: $@";
31
32 bless { h => $h },'MonetDB::CLI::MapiPP::Cxn';
33 }
34
35
36 package MonetDB::CLI::MapiPP::Cxn;
37
38 sub query
39 {
40 my ($self, $statement) = @_;
41
42 my $h = $self->new_handle;
43 $h->query($statement);
44
45 return $h;
46 }
47
48 sub new_handle
49 {
50 my ($self) = @_;
51
52 bless { h => $self->{h} },'MonetDB::CLI::MapiPP::Req';
53 }
54
55 sub DESTROY
56 {
57 my ($self) = @_;
58
59 $self->{h}->disconnect();
60
61 return;
62 }
63
64
65 package MonetDB::CLI::MapiPP::Req;
66
67 sub query
68 {
69 my ($self, $statement) = @_;
70
71 my $h = $self->{h};
72 $h->doRequest($statement);
73
74 $self->{i} = -1;
75 $self->{rows} = [];
76 $self->{querytype} = -1;
77 $self->{id} = -1;
78 $self->{affrows} = -1;
79 $self->{colcnt} = -1;
80 $self->{colnames} = [];
81 $self->{coltypes} = [];
82 $self->{collens} = [];
83
84 my $tpe = $h->getReply();
85 if ($tpe > 0) {
86 # "regular" resultset, or just "tuple"
87 $self->{querytype} = 1;
88 $self->{id} = $h->{id} || -1;
89 $self->{affrows} = $h->{count} if $h->{count};
90 $self->{colcnt} = $h->{nrcols} if $h->{nrcols};
91
92 my $hdr;
93 foreach $hdr (@{$h->{hdrs}}) {
94 my $nme = substr($hdr, rindex($hdr, "# "));
95 $hdr = substr($hdr, 2, -(length($nme) + 1));
96 if ($nme eq "# name") {
97 @{$self->{colnames}} = split(/,\t/, $hdr);
98 } elsif ($nme eq "# type") {
99 @{$self->{coltypes}} = split(/,\t/, $hdr);
100 } elsif ($nme eq "# length") {
101 @{$self->{collens}} = split(/,\t/, $hdr);
102 }
103 # TODO: table_name
104 }
105 # we must pre-fetch if this is not an SQL result-set
106 if (!defined $h->{count}) {
107 do {
108 utf8::decode($self->{h}->{row});
109 my @cols = split(/,\t */, $h->{row});
110 my $i = -1;
111 for (@cols) {
112 s/^\[ //;
113 s/[ \t]+\]$//;
114 MonetDB::CLI::MapiPP::unquote();
115 }
116 push(@{$self->{rows}}, [@cols]);
117 } while (($tpe = $h->getReply()) > 0);
118 $self->{affrows} = @{$self->{rows}};
119 undef $self->{id};
120 }
121 } elsif ($tpe == -1) {
122 # error
123 die $h->{errstr};
124 } elsif ($tpe == -2) {
125 # update count/affected rows
126 $self->{affrows} = $h->{count};
127 }
128 }
129
130 sub querytype
131 {
132 my ($self) = @_;
133
134 return $self->{querytype};
135 }
136
137 sub id
138 {
139 my ($self) = @_;
140
141 return $self->{id} || -1;
142 }
143
144 sub rows_affected
145 {
146 my ($self) = @_;
147
148 return $self->{affrows};
149 }
150
151 sub columncount
152 {
153 my ($self) = @_;
154
155 return $self->{colcnt};
156 }
157
158 sub name
159 {
160 my ($self, $fnr) = @_;
161
162 return $self->{colnames}[$fnr] || '';
163 }
164
165 sub type
166 {
167 my ($self, $fnr) = @_;
168
169 return $self->{coltypes}[$fnr] || '';
170 }
171
172 sub length
173 {
174 my ($self, $fnr) = @_;
175
176 return $self->{collens}[$fnr] || 0;
177 }
178
179 sub fetch
180 {
181 my ($self) = @_;
182
183 return if ++$self->{i} >= $self->{affrows};
184
185 if ($self->{id}) {
186 utf8::decode($self->{h}->{row});
187 my @cols = split(/,\t */, $self->{h}->{row});
188 my $i = -1;
189 $cols[0] =~ s/^\[ //;
190 $cols[-1] =~ s/[ \t]+\]$//;
191 for (@cols) {
192 MonetDB::CLI::MapiPP::unquote();
193 }
194 $self->{currow} = [@cols];
195 $self->{h}->getReply();
196 } else {
197 $self->{currow} = $self->{rows}[$self->{i}];
198 }
199
200 return @{$self->{currow}};
201 }
202
203 sub field
204 {
205 my ($self, $fnr) = @_;
206
207 return $self->{currow}[$fnr];
208 }
209
210 sub finish
211 {
212 my ($self) = @_;
213
214 $self->{$_} = -1 for qw(querytype id tuplecount columncount i);
215 $self->{$_} = "" for qw(query);
216 $self->{$_} = [] for qw(rows name type length);
217
218 return;
219 }
220
221 sub DESTROY
222 {
223 my ($self) = @_;
224
225 return;
226 }
227
228 __PACKAGE__;
229
230 =head1 NAME
231
232 MonetDB::CLI::MapiPP - MonetDB::CLI implementation, using the Mapi protocol
233
234 =head1 DESCRIPTION
235
236 MonetDB::CLI::MapiPP is an implementation of the MonetDB call level interface
237 L<MonetDB::CLI>.
238 It's a Pure Perl module.
239 It uses the Mapi protocol - a text based communication layer on top of TCP.
240 Normally, you don't use this module directly, but let L<MonetDB::CLI>
241 choose an implementation module.
242
243 =head1 AUTHORS
244
245 Steffen Goeldner E<lt>sgoeldner@cpan.orgE<gt>.
246 Fabian Groffen E<lt>fabian@cwi.nlE<gt>.
247
248 =head1 COPYRIGHT AND LICENCE
249
250 This Source Code Form is subject to the terms of the Mozilla Public
251 License, v. 2.0. If a copy of the MPL was not distributed with this
252 file, You can obtain one at http://mozilla.org/MPL/2.0/.
253
254 Copyright 1997 - July 2008 CWI, August 2008 - 2016 MonetDB B.V.
255
256 =head1 SEE ALSO
257
258 =head2 MonetDB
259
260 Homepage : http://www.monetdb.org/
261
262 =head2 Perl modules
263
264 L<MonetDB::CLI>
265
266 =cut
267
268 # vim: set ts=2 sw=2 expandtab: