File Coverage

blib/lib/DBD/monetdb.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package DBD::monetdb;
2              
3 2     2   25523 use strict;
  2         4  
  2         73  
4 2     2   1669 use sigtrap;
  2         3400  
  2         11  
5 2     2   415 use DBI();
  2         4  
  2         27  
6 2     2   833 use MonetDB::CLI();
  0            
  0            
7              
8             our $VERSION = '0.09';
9             our $drh = undef;
10              
11             require DBD::monetdb::GetInfo;
12             require DBD::monetdb::TypeInfo;
13              
14              
15             sub driver {
16             return $drh if $drh;
17              
18             my ($class, $attr) = @_;
19              
20             $drh = DBI::_new_drh($class .'::dr', {
21             Name => 'monetdb',
22             Version => $VERSION,
23             Attribution => 'DBD::monetdb by Martin Kersten, Arjan Scherpenisse and Steffen Goeldner',
24             });
25             }
26              
27              
28             sub CLONE {
29             undef $drh;
30             }
31              
32              
33              
34             package DBD::monetdb::dr;
35              
36             $DBD::monetdb::dr::imp_data_size = 0;
37              
38              
39             sub connect {
40             my ($drh, $dsn, $user, $password, $attr) = @_;
41              
42             my %dsn;
43             for ( split /;|:/, $dsn ||'') {
44             if ( my ( $k, $v ) = /(.*?)=(.*)/) {
45             $k = 'host' if $k eq 'hostname';
46             $k = 'database' if $k eq 'dbname' || $k eq 'db';
47             $dsn{$k} = $v;
48             next;
49             }
50             for my $k ( qw(host port database language) ) {
51             $dsn{$k} = $_, last unless defined $dsn{$k};
52             }
53             }
54             my $lang = $dsn{language} || 'sql';
55             my $host = $dsn{host} || 'localhost';
56             my $port = $dsn{port} || 50000;
57             $user ||= 'monetdb';
58             $password ||= 'monetdb';
59              
60             my $cxn = eval { MonetDB::CLI->connect($host, $port, $user, $password, $lang) };
61             return $drh->set_err(-1, $@) if $@;
62              
63             my ($outer, $dbh) = DBI::_new_dbh($drh, { Name => $dsn });
64              
65             $dbh->STORE('Active', 1 );
66              
67             $dbh->{monetdb_connection} = $cxn;
68             $dbh->{monetdb_language} = $lang;
69              
70             return $outer;
71             }
72              
73              
74             sub data_sources {
75             return ('dbi:monetdb:');
76             }
77              
78              
79              
80             package DBD::monetdb::db;
81              
82             $DBD::monetdb::db::imp_data_size = 0;
83              
84              
85             sub ping {
86             my ($dbh) = @_;
87              
88             my $statement = $dbh->{monetdb_language} eq 'sql' ? 'select 7' : 'print(7);';
89             my $rv = $dbh->selectrow_array($statement) || 0;
90             $dbh->set_err(undef, undef);
91             $rv == 7 ? 1 : 0;
92             }
93              
94              
95             sub quote {
96             my ($dbh, $value, $type) = @_;
97              
98             return $dbh->{monetdb_language} eq 'sql' ? 'NULL' : 'nil'
99             unless defined $value;
100              
101             for ($value) {
102             s/ /\\t/g;
103             s/\\/\\\\/g;
104             s/\n/\\n/g;
105             s/\r/\\r/g;
106             s/"/\\"/g;
107             s/'/''/g;
108             }
109              
110             $type ||= DBI::SQL_VARCHAR();
111              
112             my $prefix = $DBD::monetdb::TypeInfo::prefixes{$type} || '';
113             my $suffix = $DBD::monetdb::TypeInfo::suffixes{$type} || '';
114              
115             if ( $dbh->{monetdb_language} ne 'sql') {
116             $prefix = q(") if $prefix eq q(');
117             $suffix = q(") if $suffix eq q(');
118             }
119             return $prefix . $value . $suffix;
120             }
121              
122              
123             sub _count_param {
124             my @statement = split //, shift;
125             my $num = 0;
126              
127             while (defined(my $c = shift @statement)) {
128             if ($c eq '"' || $c eq "'") {
129             my $end = $c;
130             while (defined(my $c = shift @statement)) {
131             last if $c eq $end;
132             @statement = splice @statement, 2 if $c eq '\\';
133             }
134             }
135             elsif ($c eq '?') {
136             $num++;
137             }
138             }
139             return $num;
140             }
141              
142              
143             sub prepare {
144             my ($dbh, $statement, $attr) = @_;
145              
146             my $cxn = $dbh->{monetdb_connection};
147             my $hdl = eval { $cxn->new_handle };
148             return $dbh->set_err(-1, $@) if $@;
149              
150             my ($outer, $sth) = DBI::_new_sth($dbh, { Statement => $statement });
151              
152             $sth->STORE('NUM_OF_PARAMS', _count_param($statement));
153              
154             $sth->{monetdb_hdl} = $hdl;
155             $sth->{monetdb_params} = [];
156             $sth->{monetdb_types} = [];
157             $sth->{monetdb_rows} = -1;
158              
159             return $outer;
160             }
161              
162              
163             sub commit {
164             my($dbh) = @_;
165              
166             if ($dbh->FETCH('AutoCommit')) {
167             warn 'Commit ineffective while AutoCommit is on' if $dbh->FETCH('Warn');
168             return 0;
169             }
170             if ($dbh->{monetdb_language} eq 'sql') {
171             return $dbh->do('commit')
172             && $dbh->do('start transaction');
173             }
174             else {
175             return $dbh->do('commit();');
176             }
177             }
178              
179              
180             sub rollback {
181             my($dbh) = @_;
182              
183             if ($dbh->FETCH('AutoCommit')) {
184             warn 'Rollback ineffective while AutoCommit is on' if $dbh->FETCH('Warn');
185             return 0;
186             }
187             if ($dbh->{monetdb_language} eq 'sql') {
188             return $dbh->do('rollback')
189             && $dbh->do('start transaction');
190             }
191             else {
192             return $dbh->do('abort();');
193             }
194             }
195              
196              
197             *get_info = \&DBD::monetdb::GetInfo::get_info;
198              
199              
200             sub monetdb_catalog_info {
201             my($dbh) = @_;
202             my $sql = <<'SQL';
203             select cast( null as varchar( 128 ) ) as table_cat
204             , cast( null as varchar( 128 ) ) as table_schem
205             , cast( null as varchar( 128 ) ) as table_name
206             , cast( null as varchar( 254 ) ) as table_type
207             , cast( null as varchar( 254 ) ) as remarks
208             where 0 = 1
209             order by table_cat
210             SQL
211             my $sth = $dbh->prepare($sql) or return;
212             $sth->execute or return;
213             return $sth;
214             }
215              
216              
217             sub monetdb_schema_info {
218             my($dbh) = @_;
219             my $sql = <<'SQL';
220             select cast( null as varchar( 128 ) ) as table_cat
221             , "name" as table_schem
222             , cast( null as varchar( 128 ) ) as table_name
223             , cast( null as varchar( 254 ) ) as table_type
224             , cast( null as varchar( 254 ) ) as remarks
225             from sys."schemas"
226             order by table_schem
227             SQL
228             my $sth = $dbh->prepare($sql) or return;
229             $sth->execute or return;
230             return $sth;
231             }
232              
233              
234             my $ttp = {
235             'TABLE' => 't."istable" = true and t."system" = false and t."temporary" = 0'
236             ,'SYSTEM TABLE' => 't."istable" = true and t."system" = true and t."temporary" = 0'
237             ,'LOCAL TEMPORARY' => 't."istable" = true and t."system" = false and t."temporary" = 1'
238             ,'VIEW' => 't."istable" = false '
239             };
240              
241              
242             sub monetdb_tabletype_info {
243             my($dbh) = @_;
244             my $sql = <<"SQL";
245             select distinct
246             cast( null as varchar( 128 ) ) as table_cat
247             , cast( null as varchar( 128 ) ) as table_schem
248             , cast( null as varchar( 128 ) ) as table_name
249             , case
250             when $ttp->{'TABLE' } then cast('TABLE' as varchar( 254 ) )
251             when $ttp->{'SYSTEM TABLE' } then cast('SYSTEM TABLE' as varchar( 254 ) )
252             when $ttp->{'LOCAL TEMPORARY'} then cast('LOCAL TEMPORARY' as varchar( 254 ) )
253             when $ttp->{'VIEW' } then cast('VIEW' as varchar( 254 ) )
254             else cast('INTERNAL TABLE TYPE' as varchar( 254 ) )
255             end as table_type
256             , cast( null as varchar( 254 ) ) as remarks
257             from sys."tables" t
258             order by table_type
259             SQL
260             my $sth = $dbh->prepare($sql) or return;
261             $sth->execute or return;
262             return $sth;
263             }
264              
265              
266             sub monetdb_table_info {
267             my($dbh, $c, $s, $t, $tt) = @_;
268             my $sql = <<"SQL";
269             select cast( null as varchar( 128 ) ) as table_cat
270             , s."name" as table_schem
271             , t."name" as table_name
272             , case
273             when $ttp->{'TABLE' } then cast('TABLE' as varchar( 254 ) )
274             when $ttp->{'SYSTEM TABLE' } then cast('SYSTEM TABLE' as varchar( 254 ) )
275             when $ttp->{'LOCAL TEMPORARY'} then cast('LOCAL TEMPORARY' as varchar( 254 ) )
276             when $ttp->{'VIEW' } then cast('VIEW' as varchar( 254 ) )
277             else cast('INTERNAL TABLE TYPE' as varchar( 254 ) )
278             end as table_type
279             , cast( null as varchar( 254 ) ) as remarks
280             from sys."schemas" s
281             , sys."tables" t
282             where t."schema_id" = s."id"
283             SQL
284             my @bv = ();
285             $sql .= qq( and s."name" like ?\n), push @bv, $s if $s;
286             $sql .= qq( and t."name" like ?\n), push @bv, $t if $t;
287             if ( @$tt ) {
288             $sql .= " and ( 1 = 0\n";
289             for ( @$tt ) {
290             my $p = $ttp->{uc $_};
291             $sql .= " or $p\n" if $p;
292             }
293             $sql .= " )\n";
294             }
295             $sql .= " order by table_type, table_schem, table_name\n";
296             my $sth = $dbh->prepare($sql) or return;
297             $sth->execute(@bv) or return;
298             $dbh->set_err(0,"Catalog parameter '$c' ignored") if defined $c;
299             return $sth;
300             }
301              
302              
303             sub table_info {
304             my($dbh, $c, $s, $t, $tt) = @_;
305              
306             if ( defined $c && defined $s && defined $t ) {
307             if ( $c eq '%' && $s eq '' && $t eq '') {
308             return monetdb_catalog_info($dbh);
309             }
310             elsif ( $c eq '' && $s eq '%' && $t eq '') {
311             return monetdb_schema_info($dbh);
312             }
313             elsif ( $c eq '' && $s eq '' && $t eq '' && defined $tt && $tt eq '%') {
314             return monetdb_tabletype_info($dbh);
315             }
316             }
317             my @tt;
318             if ( defined $tt ) {
319             @tt = split /,/, $tt;
320             s/^\s*'?//, s/'?\s*$// for @tt;
321             }
322             return monetdb_table_info($dbh, $c, $s, $t, \@tt);
323             }
324              
325              
326             sub column_info {
327             my($dbh, $catalog, $schema, $table, $column) = @_;
328             my $sql = <<'SQL';
329             select cast( null as varchar( 128 ) ) as table_cat
330             , s."name" as table_schem
331             , t."name" as table_name
332             , c."name" as column_name
333             , cast( 0 as smallint ) as data_type -- ...
334             , c."type" as type_name -- TODO
335             , cast( c."type_digits" as integer ) as column_size -- TODO
336             , cast( null as integer ) as buffer_length -- TODO
337             , cast( c."type_scale" as smallint ) as decimal_digits -- TODO
338             , cast( null as smallint ) as num_prec_radix -- TODO
339             , case c."null"
340             when false then cast( 0 as smallint ) -- SQL_NO_NULLS
341             when true then cast( 1 as smallint ) -- SQL_NULLABLE
342             end as nullable
343             , cast( null as varchar( 254 ) ) as remarks
344             , c."default" as column_def
345             , cast( 0 as smallint ) as sql_data_type -- ...
346             , cast( null as smallint ) as sql_datetime_sub -- ...
347             , cast( null as integer ) as char_octet_length -- TODO
348             , cast( c."number" + 1 as integer ) as ordinal_position
349             , case c."null"
350             when false then cast('NO' as varchar( 254 ) )
351             when true then cast('YES' as varchar( 254 ) )
352             end as is_nullable
353             from sys."schemas" s
354             , sys."tables" t
355             , sys."columns" c
356             where t."schema_id" = s."id"
357             and c."table_id" = t."id"
358             SQL
359             my @bv = ();
360             $sql .= qq( and s."name" like ?\n), push @bv, $schema if $schema;
361             $sql .= qq( and t."name" like ?\n), push @bv, $table if $table;
362             $sql .= qq( and c."name" like ?\n), push @bv, $column if $column;
363             $sql .= " order by table_cat, table_schem, table_name, ordinal_position\n";
364             my $sth = $dbh->prepare($sql) or return;
365             $sth->execute(@bv) or return;
366             $dbh->set_err(0,"Catalog parameter '$catalog' ignored") if defined $catalog;
367             my $rows;
368             while ( my $row = $sth->fetch ) {
369             $row->[ 4] = $DBD::monetdb::TypeInfo::typeinfo{$row->[5]}->[ 1];
370             $row->[13] = $DBD::monetdb::TypeInfo::typeinfo{$row->[5]}->[15];
371             $row->[14] = $DBD::monetdb::TypeInfo::typeinfo{$row->[5]}->[16];
372             push @$rows, [ @$row ];
373             }
374             return DBI->connect('dbi:Sponge:','','', { RaiseError => 1 } )->prepare(
375             $sth->{Statement},
376             { rows => $rows, NAME => $sth->{NAME}, TYPE => $sth->{TYPE} }
377             );
378             }
379              
380              
381             sub primary_key_info {
382             my($dbh, $catalog, $schema, $table) = @_;
383             return $dbh->set_err(-1,'Undefined schema','HY009') unless defined $schema;
384             return $dbh->set_err(-1,'Undefined table' ,'HY009') unless defined $table;
385             my $sql = <<'SQL';
386             select cast( null as varchar( 128 ) ) as table_cat
387             , s."name" as table_schem
388             , t."name" as table_name
389             , c."column" as column_name
390             , cast( c."nr" + 1 as smallint ) as key_seq
391             , k."name" as pk_name
392             from sys."schemas" s
393             , sys."tables" t
394             , sys."keys" k
395             , sys."keycolumns" c
396             where t."schema_id" = s."id"
397             and k."table_id" = t."id"
398             and c."id" = k."id"
399             and s."name" = ?
400             and t."name" = ?
401             and k."type" = 0
402             order by table_schem, table_name, key_seq
403             SQL
404             my $sth = $dbh->prepare($sql) or return;
405             $sth->execute($schema, $table) or return;
406             $dbh->set_err(0,"Catalog parameter '$catalog' ignored") if defined $catalog;
407             return $sth;
408             }
409              
410              
411             sub foreign_key_info {
412             my($dbh, $c1, $s1, $t1, $c2, $s2, $t2) = @_;
413             my $sql = <<'SQL';
414             select cast( null as varchar( 128 ) ) as uk_table_cat
415             , uks."name" as uk_table_schem
416             , ukt."name" as uk_table_name
417             , ukc."column" as uk_column_name
418             , cast( null as varchar( 128 ) ) as fk_table_cat
419             , fks."name" as fk_table_schem
420             , fkt."name" as fk_table_name
421             , fkc."column" as fk_column_name
422             , cast( fkc."nr" + 1 as smallint ) as ordinal_position
423             , cast( 3 as smallint ) as update_rule -- SQL_NO_ACTION
424             , cast( 3 as smallint ) as delete_rule -- SQL_NO_ACTION
425             , fkk."name" as fk_name
426             , ukk."name" as uk_name
427             , cast( 7 as smallint ) as deferability -- SQL_NOT_DEFERRABLE
428             , case ukk."type"
429             when 0 then cast('PRIMARY' as varchar( 7 ) )
430             when 1 then cast('UNIQUE' as varchar( 7 ) )
431             else cast( ukk."type" as varchar( 7 ) )
432             end as unique_or_primary
433             from sys."schemas" uks
434             , sys."tables" ukt
435             , sys."keys" ukk
436             , sys."keycolumns" ukc
437             , sys."schemas" fks
438             , sys."tables" fkt
439             , sys."keys" fkk
440             , sys."keycolumns" fkc
441             where ukt."schema_id" = uks."id"
442             and ukk."table_id" = ukt."id"
443             and ukc."id" = ukk."id"
444             and fkt."schema_id" = fks."id"
445             and fkk."table_id" = fkt."id"
446             and fkc."id" = fkk."id"
447             -- and ukk."type" IN ( 0, 1 )
448             -- and fkk."type" = 2
449             -- and fkk."rkey" > -1
450             and fkk."rkey" = ukk."id"
451             and fkc."nr" = ukc."nr"
452             SQL
453             my @bv = ();
454             $sql .= qq( and uks."name" = ?\n), push @bv, $s1 if $s1;
455             $sql .= qq( and ukt."name" = ?\n), push @bv, $t1 if $t1;
456             $sql .= qq( and fks."name" = ?\n), push @bv, $s2 if $s2;
457             $sql .= qq( and fkt."name" = ?\n), push @bv, $t2 if $t2;
458             $sql .= qq( and ukk."type" = 0\n) if $t1 && !$t2;
459             $sql .= " order by uk_table_schem, uk_table_name, fk_table_schem, fk_table_name, ordinal_position\n";
460             my $sth = $dbh->prepare($sql) or return;
461             $sth->execute(@bv) or return;
462             $dbh->set_err(0,"Catalog parameter '$c1' ignored") if defined $c1;
463             $dbh->set_err(0,"Catalog parameter '$c2' ignored") if defined $c2;
464             return $sth;
465             }
466              
467              
468             *type_info_all = \&DBD::monetdb::TypeInfo::type_info_all;
469              
470              
471             sub tables {
472             my ($dbh, @args) = @_;
473              
474             # TODO: !! warn: 0 CLEARED by call to fetchall_arrayref method
475             return $dbh->SUPER::tables( @args ) if $dbh->{monetdb_language} eq 'sql';
476              
477             return eval{ @{$dbh->selectcol_arrayref('ls();')} };
478             }
479              
480              
481             sub disconnect {
482             my ($dbh) = @_;
483              
484             delete $dbh->{monetdb_connection};
485             $dbh->STORE('Active', 0 );
486             return 1;
487             }
488              
489              
490             sub FETCH {
491             my ($dbh, $key) = @_;
492              
493             return $dbh->{$key} if $key =~ /^monetdb_/;
494             return $dbh->SUPER::FETCH($key);
495             }
496              
497              
498             sub STORE {
499             my ($dbh, $key, $value) = @_;
500              
501             if ($key eq 'AutoCommit') {
502             return 1 if $dbh->{monetdb_language} ne 'sql';
503             my $old_value = $dbh->{$key};
504             if ($value && defined $old_value && !$old_value) {
505             $dbh->do('commit')
506             or return $dbh->set_err($dbh->err, $dbh->errstr);
507             }
508             elsif (!$value && (!defined $old_value || $old_value)) {
509             $dbh->do('start transaction')
510             or return $dbh->set_err($dbh->err, $dbh->errstr);
511             }
512             $dbh->{$key} = $value;
513             return 1;
514             }
515             elsif ($key =~ /^monetdb_/) {
516             $dbh->{$key} = $value;
517             return 1;
518             }
519             return $dbh->SUPER::STORE($key, $value);
520             }
521              
522              
523             sub DESTROY {
524             my ($dbh) = @_;
525              
526             $dbh->disconnect if $dbh->FETCH('Active');
527             }
528              
529              
530              
531             package DBD::monetdb::st;
532              
533             $DBD::monetdb::st::imp_data_size = 0;
534              
535              
536             sub bind_param {
537             my ($sth, $index, $value, $attr) = @_;
538              
539             $sth->{monetdb_params}[$index-1] = $value;
540             $sth->{monetdb_types}[$index-1] = ref $attr ? $attr->{TYPE} : $attr;
541             return 1;
542             }
543              
544              
545             sub execute {
546             my($sth, @bind_values) = @_;
547             my $statement = $sth->{Statement};
548             my $dbh = $sth->{Database};
549              
550             $sth->STORE('Active', 0 ); # we don't need to call $sth->finish because
551             # mapi_query_handle() calls finish_handle()
552              
553             $sth->bind_param($_, $bind_values[$_-1]) or return for 1 .. @bind_values;
554              
555             my $params = $sth->{monetdb_params};
556             my $num_of_params = $sth->FETCH('NUM_OF_PARAMS');
557             return $sth->set_err(-1, @$params ." values bound when $num_of_params expected")
558             unless @$params == $num_of_params;
559              
560             for ( 1 .. $num_of_params ) {
561             my $quoted_param = $dbh->quote($params->[$_-1], $sth->{monetdb_types}[$_-1]);
562             $statement =~ s/\?/$quoted_param/; # TODO: '?' inside quotes/comments
563             }
564             $sth->trace_msg(" -- Statement: $statement\n", 5);
565              
566             my $hdl = $sth->{monetdb_hdl};
567             eval{ $hdl->query($statement) };
568             return $sth->set_err(-1, $@) if $@;
569              
570             my $rows = $hdl->rows_affected;
571              
572             if ( $dbh->{monetdb_language} eq 'sql' && $hdl->querytype != 1 ) {
573             $sth->{monetdb_rows} = $rows;
574             return $rows || '0E0';
575             }
576             my ( @names, @types, @precisions, @nullables );
577             my $field_count = $hdl->columncount;
578             for ( 0 .. $field_count-1 ) {
579             push @names , $hdl->name ($_);
580             push @types , $hdl->type ($_);
581             push @precisions, $hdl->length($_);
582             push @nullables , 2; # TODO
583             }
584             $sth->STORE('NUM_OF_FIELDS', $field_count) unless $sth->FETCH('NUM_OF_FIELDS');
585             $sth->{NAME} = \@names;
586             $sth->{TYPE} = [ map { $DBD::monetdb::TypeInfo::typeinfo{$_}->[1] } @types ];
587             $sth->{PRECISION} = \@precisions; # TODO
588             $sth->{SCALE} = [];
589             $sth->{NULLABLE} = \@nullables;
590             $sth->STORE('Active', 1 );
591              
592             $sth->{monetdb_rows} = 0;
593              
594             return $rows || '0E0';
595             }
596              
597              
598             sub fetch {
599             my ($sth) = @_;
600              
601             return $sth->set_err(-900,'Statement handle not marked as Active')
602             unless $sth->FETCH('Active');
603             my $hdl = $sth->{monetdb_hdl};
604             my $field_count = eval{ $hdl->fetch };
605             unless ( $field_count ) {
606             $sth->STORE('Active', 0 );
607             $sth->set_err(-1, $@) if $@;
608             return;
609             }
610             my @row = map $hdl->field($_), 0 .. $field_count-1;
611             map { s/\s+$// } @row if $sth->FETCH('ChopBlanks');
612              
613             $sth->{monetdb_rows}++;
614             return $sth->_set_fbav(\@row);
615             }
616              
617             *fetchrow_arrayref = \&fetch;
618              
619              
620             sub rows {
621             my ($sth) = @_;
622              
623             return $sth->{monetdb_rows};
624             }
625              
626              
627             sub finish {
628             my ($sth) = @_;
629             my $hdl = $sth->{monetdb_hdl};
630              
631             eval{ $hdl->finish };
632             return $sth->set_err(-1, $@) if $@;
633              
634             return $sth->SUPER::finish; # sets Active off
635             }
636              
637              
638             sub FETCH {
639             my ($sth, $key) = @_;
640              
641             if ( $key =~ /^monetdb_/) {
642             return $sth->{$key};
643             }
644             elsif ( $key eq 'ParamValues') {
645             my $p = $sth->{monetdb_params};
646             return { map { $_ => $p->[$_-1] } 1 .. $sth->FETCH('NUM_OF_PARAMS') };
647             }
648             return $sth->SUPER::FETCH($key);
649             }
650              
651              
652             sub STORE {
653             my ($sth, $key, $value) = @_;
654              
655             if ($key =~ /^monetdb_/) {
656             $sth->{$key} = $value;
657             return 1;
658             }
659             return $sth->SUPER::STORE($key, $value);
660             }
661              
662              
663             sub DESTROY {
664             my ($sth) = @_;
665              
666             $sth->STORE('Active', 0 );
667             }
668              
669              
670             1;
671              
672             =head1 NAME
673              
674             DBD::monetdb - MonetDB Driver for DBI
675              
676             =head1 SYNOPSIS
677              
678             use DBI();
679              
680             my $dbh = DBI->connect('dbi:monetdb:');
681              
682             my $sth = $dbh->prepare('SELECT * FROM env');
683             $sth->execute;
684             $sth->dump_results;
685              
686             =head1 DESCRIPTION
687              
688             DBD::monetdb is a Pure Perl client interface for the MonetDB Database Server.
689             It requires MonetDB::CLI (and one of its implementations).
690              
691             =head2 Outline Usage
692              
693             From perl you activate the interface with the statement
694              
695             use DBI;
696              
697             After that you can connect to multiple MonetDB database servers
698             and send multiple queries to any of them via a simple object oriented
699             interface. Two types of objects are available: database handles and
700             statement handles. Perl returns a database handle to the connect
701             method like so:
702              
703             $dbh = DBI->connect("dbi:monetdb:host=$host",
704             $user, $password, { RaiseError => 1 } );
705              
706             Once you have connected to a database, you can can execute SQL
707             statements with:
708              
709             my $sql = sprintf('INSERT INTO foo VALUES (%d, %s)',
710             $number, $dbh->quote('name'));
711             $dbh->do($sql);
712              
713             See L for details on the quote and do methods. An alternative
714             approach is
715              
716             $dbh->do('INSERT INTO foo VALUES (?, ?)', undef, $number, $name);
717              
718             in which case the quote method is executed automatically. See also
719             the bind_param method in L.
720              
721             If you want to retrieve results, you need to create a so-called
722             statement handle with:
723              
724             $sth = $dbh->prepare("SELECT id, name FROM $table");
725             $sth->execute;
726              
727             This statement handle can be used for multiple things. First of all
728             you can retreive a row of data:
729              
730             my $row = $sth->fetch;
731              
732             If your table has columns ID and NAME, then $row will be array ref with
733             index 0 and 1.
734              
735             =head2 Example
736              
737             #!/usr/bin/perl
738              
739             use strict;
740             use DBI;
741              
742             # Connect to the database.
743             my $dbh = DBI->connect('dbi:monetdb:host=localhost',
744             'joe', "joe's password", { RaiseError => 1 } );
745              
746             # Drop table 'foo'. This may fail, if 'foo' doesn't exist.
747             # Thus we put an eval around it.
748             eval { $dbh->do('DROP TABLE foo') };
749             print "Dropping foo failed: $@\n" if $@;
750              
751             # Create a new table 'foo'. This must not fail, thus we don't
752             # catch errors.
753             $dbh->do('CREATE TABLE foo (id INTEGER, name VARCHAR(20))');
754              
755             # INSERT some data into 'foo'. We are using $dbh->quote() for
756             # quoting the name.
757             $dbh->do('INSERT INTO foo VALUES (1, ' . $dbh->quote('Tim') . ')');
758              
759             # Same thing, but using placeholders
760             $dbh->do('INSERT INTO foo VALUES (?, ?)', undef, 2, 'Jochen');
761              
762             # Now retrieve data from the table.
763             my $sth = $dbh->prepare('SELECT id, name FROM foo');
764             $sth->execute;
765             while ( my $row = $sth->fetch ) {
766             print "Found a row: id = $row->[0], name = $row->[1]\n";
767             }
768              
769             # Disconnect from the database.
770             $dbh->disconnect;
771              
772             =head1 METHODS
773              
774             =head2 Driver Handle Methods
775              
776             =over
777              
778             =item B
779              
780             use DBI();
781              
782             $dsn = 'dbi:monetdb:';
783             $dsn = "dbi:monetdb:host=$host";
784             $dsn = "dbi:monetdb:host=$host;port=$port";
785              
786             $dbh = DBI->connect($dsn, $user, $password);
787              
788             =over
789              
790             =item host
791              
792             The default host to connect to is 'localhost', i.e. your workstation.
793              
794             =item port
795              
796             The port where MonetDB daemon listens to. Default for MonetDB is 50000.
797              
798             =back
799              
800             =back
801              
802             =head2 Database Handle Methods
803              
804             The following methods are currently not supported:
805              
806             last_insert_id
807              
808             All MetaData methods are supported. However, column_info() currently doesn't
809             provide length (size, ...) related information.
810             The foreign_key_info() method returns a SQL/CLI like result set,
811             because it provides additional information about unique keys.
812              
813             =head2 Statement Handle Methods
814              
815             The following methods are currently not supported:
816              
817             bind_param_inout
818             more_results
819             blob_read
820              
821             =head1 ATTRIBUTES
822              
823             The following attributes are currently not supported:
824              
825             LongReadLen
826             LongTruncOk
827              
828             =head2 Database Handle Attributes
829              
830             The following attributes are currently not supported:
831              
832             RowCacheSize
833              
834             =head2 Statement Handle Attributes
835              
836             The following attributes are currently not (or not correctly) supported:
837              
838             PRECISION (MonetDB semantic != DBI semantic)
839             SCALE (empty)
840             NULLABLE (SQL_NULLABLE_UNKNOWN = 2)
841             CursorName
842             RowsInCache
843              
844             =head1 AUTHORS
845              
846             Martin Kersten EMartin.Kersten@cwi.nlE implemented the initial Mapi
847             based version of the driver (F).
848             Arjan Scherpenisse Eacscherp@science.uva.nlE renamed this module to
849             F and derived the new MapiLib based version (F).
850             Current maintainer is Steffen Goeldner Esgoeldner@cpan.orgE.
851              
852             =head1 COPYRIGHT AND LICENCE
853              
854             The contents of this file are subject to the MonetDB Public License
855             Version 1.1 (the "License"); you may not use this file except in
856             compliance with the License. You may obtain a copy of the License at
857             http://monetdb.cwi.nl/Legal/MonetDBLicense-1.1.html
858              
859             Software distributed under the License is distributed on an "AS IS"
860             basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
861             License for the specific language governing rights and limitations
862             under the License.
863              
864             The Original Code is the MonetDB Database System.
865              
866             The Initial Developer of the Original Code is CWI.
867             Portions created by CWI are Copyright (C) 1997-2006 CWI.
868             All Rights Reserved.
869              
870             Contributor(s): Steffen Goeldner.
871              
872             =head1 SEE ALSO
873              
874             =head2 MonetDB
875              
876             Homepage : http://monetdb.cwi.nl
877             SourceForge : http://sourceforge.net/projects/monetdb
878              
879             =head2 Perl modules
880              
881             L, L
882              
883             =cut