monetdb.pm

来自「这个是内存数据库的客户端」· PM 代码 · 共 884 行 · 第 1/2 页

   and ukc."id"         = ukk."id"
   and fkt."schema_id"  = fks."id"
   and fkk."table_id"   = fkt."id"
   and fkc."id"         = fkk."id"
-- and ukk."type"      IN ( 0, 1 )
-- and fkk."type"       = 2
-- and fkk."rkey"       > -1
   and fkk."rkey"       = ukk."id"
   and fkc."nr"         = ukc."nr"
SQL
    my @bv = ();
    $sql .= qq(   and uks."name"       = ?\n), push @bv, $s1 if $s1;
    $sql .= qq(   and ukt."name"       = ?\n), push @bv, $t1 if $t1;
    $sql .= qq(   and fks."name"       = ?\n), push @bv, $s2 if $s2;
    $sql .= qq(   and fkt."name"       = ?\n), push @bv, $t2 if $t2;
    $sql .= qq(   and ukk."type"       = 0\n)                if $t1 && !$t2;
    $sql .= " order by uk_table_schem, uk_table_name, fk_table_schem, fk_table_name, ordinal_position\n";
    my $sth = $dbh->prepare($sql) or return;
    $sth->execute(@bv) or return;
    $dbh->set_err(0,"Catalog parameter '$c1' ignored") if defined $c1;
    $dbh->set_err(0,"Catalog parameter '$c2' ignored") if defined $c2;
    return $sth;
}


*type_info_all = \&DBD::monetdb::TypeInfo::type_info_all;


sub tables {
    my ($dbh, @args) = @_;

    # TODO: !! warn: 0 CLEARED by call to fetchall_arrayref method
    return $dbh->SUPER::tables( @args ) if $dbh->{monetdb_language} eq 'sql';

    return eval{ @{$dbh->selectcol_arrayref('ls();')} };
}


sub disconnect {
    my ($dbh) = @_;

    delete $dbh->{monetdb_connection};
    $dbh->STORE('Active', 0 );
    return 1;
}


sub FETCH {
    my ($dbh, $key) = @_;

    return $dbh->{$key} if $key =~ /^monetdb_/;
    return $dbh->SUPER::FETCH($key);
}


sub STORE {
    my ($dbh, $key, $value) = @_;

    if ($key eq 'AutoCommit') {
        return 1 if $dbh->{monetdb_language} ne 'sql';
        my $old_value = $dbh->{$key};
        if ($value && defined $old_value && !$old_value) {
            $dbh->do('commit')
                or return $dbh->set_err($dbh->err, $dbh->errstr);
        }
        elsif (!$value && (!defined $old_value || $old_value)) {
            $dbh->do('start transaction')
                or return $dbh->set_err($dbh->err, $dbh->errstr);
        }
        $dbh->{$key} = $value;
        return 1;
    }
    elsif ($key =~ /^monetdb_/) {
        $dbh->{$key} = $value;
        return 1;
    }
    return $dbh->SUPER::STORE($key, $value);
}


sub DESTROY {
    my ($dbh) = @_;

    $dbh->disconnect if $dbh->FETCH('Active');
}



package DBD::monetdb::st;

$DBD::monetdb::st::imp_data_size = 0;


sub bind_param {
    my ($sth, $index, $value, $attr) = @_;

    $sth->{monetdb_params}[$index-1] = $value;
    $sth->{monetdb_types}[$index-1] = ref $attr ? $attr->{TYPE} : $attr;
    return 1;
}


sub execute {
    my($sth, @bind_values) = @_;
    my $statement = $sth->{Statement};
    my $dbh = $sth->{Database};

    $sth->STORE('Active', 0 );  # we don't need to call $sth->finish because
                                # mapi_query_handle() calls finish_handle()

    $sth->bind_param($_, $bind_values[$_-1]) or return for 1 .. @bind_values;

    my $params = $sth->{monetdb_params};
    my $num_of_params = $sth->FETCH('NUM_OF_PARAMS');
    return $sth->set_err(-1, @$params ." values bound when $num_of_params expected")
        unless @$params == $num_of_params;

    for ( 1 .. $num_of_params ) {
        my $quoted_param = $dbh->quote($params->[$_-1], $sth->{monetdb_types}[$_-1]);
        $statement =~ s/\?/$quoted_param/;  # TODO: '?' inside quotes/comments
    }
    $sth->trace_msg("    -- Statement: $statement\n", 5);

    my $hdl = $sth->{monetdb_hdl};
    eval{ $hdl->query($statement) };
    return $sth->set_err(-1, $@) if $@;

    my $rows = $hdl->rows_affected;

    if ( $dbh->{monetdb_language} eq 'sql' && $hdl->querytype != 1 ) {
        $sth->{monetdb_rows} = $rows;
        return $rows || '0E0';
    }
    my ( @names, @types, @precisions, @nullables );
    my $field_count = $hdl->columncount;
    for ( 0 .. $field_count-1 ) {
        push @names     , $hdl->name  ($_);
        push @types     , $hdl->type  ($_);
        push @precisions, $hdl->length($_);
        push @nullables , 2;  # TODO
    }
    $sth->STORE('NUM_OF_FIELDS', $field_count) unless $sth->FETCH('NUM_OF_FIELDS');
    $sth->{NAME}      = \@names;
    $sth->{TYPE}      = [ map { $DBD::monetdb::TypeInfo::typeinfo{$_}->[1] } @types ];
    $sth->{PRECISION} = \@precisions;  # TODO
    $sth->{SCALE}     = [];
    $sth->{NULLABLE}  = \@nullables;
    $sth->STORE('Active', 1 );

    $sth->{monetdb_rows} = 0;

    return $rows || '0E0';
}


sub fetch {
    my ($sth) = @_;

    return $sth->set_err(-900,'Statement handle not marked as Active')
        unless $sth->FETCH('Active');
    my $hdl = $sth->{monetdb_hdl};
    my $field_count = eval{ $hdl->fetch };
    unless ( $field_count ) {
        $sth->STORE('Active', 0 );
        $sth->set_err(-1, $@) if $@;
        return;
    }
    my @row = map $hdl->field($_), 0 .. $field_count-1;
    map { s/\s+$// } @row if $sth->FETCH('ChopBlanks');

    $sth->{monetdb_rows}++;
    return $sth->_set_fbav(\@row);
}

*fetchrow_arrayref = \&fetch;


sub rows {
    my ($sth) = @_;

    return $sth->{monetdb_rows};
}


sub finish {
    my ($sth) = @_;
    my $hdl = $sth->{monetdb_hdl};

    eval{ $hdl->finish };
    return $sth->set_err(-1, $@) if $@;

    return $sth->SUPER::finish;  # sets Active off
}


sub FETCH {
    my ($sth, $key) = @_;

    if ( $key =~ /^monetdb_/) {
        return $sth->{$key};
    }
    elsif ( $key eq 'ParamValues') {
        my $p = $sth->{monetdb_params};
        return { map { $_ => $p->[$_-1] } 1 .. $sth->FETCH('NUM_OF_PARAMS') };
    }
    return $sth->SUPER::FETCH($key);
}


sub STORE {
    my ($sth, $key, $value) = @_;

    if ($key =~ /^monetdb_/) {
        $sth->{$key} = $value;
        return 1;
    }
    return $sth->SUPER::STORE($key, $value);
}


sub DESTROY {
    my ($sth) = @_;

    $sth->STORE('Active', 0 );
}


1;

=head1 NAME

DBD::monetdb - MonetDB Driver for DBI

=head1 SYNOPSIS

  use DBI();

  my $dbh = DBI->connect('dbi:monetdb:');

  my $sth = $dbh->prepare('SELECT * FROM env');
  $sth->execute;
  $sth->dump_results;

=head1 DESCRIPTION

DBD::monetdb is a Pure Perl client interface for the MonetDB Database Server.
It requires MonetDB::CLI (and one of its implementations).

=head2 Outline Usage

From perl you activate the interface with the statement

  use DBI;

After that you can connect to multiple MonetDB database servers
and send multiple queries to any of them via a simple object oriented
interface. Two types of objects are available: database handles and
statement handles. Perl returns a database handle to the connect
method like so:

  $dbh = DBI->connect("dbi:monetdb:host=$host",
    $user, $password, { RaiseError => 1 } );

Once you have connected to a database, you can can execute SQL
statements with:

  my $sql = sprintf('INSERT INTO foo VALUES (%d, %s)',
    $number, $dbh->quote('name'));
  $dbh->do($sql);

See L<DBI> for details on the quote and do methods. An alternative
approach is

  $dbh->do('INSERT INTO foo VALUES (?, ?)', undef, $number, $name);

in which case the quote method is executed automatically. See also
the bind_param method in L<DBI>.

If you want to retrieve results, you need to create a so-called
statement handle with:

  $sth = $dbh->prepare("SELECT id, name FROM $table");
  $sth->execute;

This statement handle can be used for multiple things. First of all
you can retreive a row of data:

  my $row = $sth->fetch;

If your table has columns ID and NAME, then $row will be array ref with
index 0 and 1.

=head2 Example

  #!/usr/bin/perl

  use strict;
  use DBI;

  # Connect to the database.
  my $dbh = DBI->connect('dbi:monetdb:host=localhost',
    'joe', "joe's password", { RaiseError => 1 } );

  # Drop table 'foo'. This may fail, if 'foo' doesn't exist.
  # Thus we put an eval around it.
  eval { $dbh->do('DROP TABLE foo') };
  print "Dropping foo failed: $@\n" if $@;

  # Create a new table 'foo'. This must not fail, thus we don't
  # catch errors.
  $dbh->do('CREATE TABLE foo (id INTEGER, name VARCHAR(20))');

  # INSERT some data into 'foo'. We are using $dbh->quote() for
  # quoting the name.
  $dbh->do('INSERT INTO foo VALUES (1, ' . $dbh->quote('Tim') . ')');

  # Same thing, but using placeholders
  $dbh->do('INSERT INTO foo VALUES (?, ?)', undef, 2, 'Jochen');

  # Now retrieve data from the table.
  my $sth = $dbh->prepare('SELECT id, name FROM foo');
  $sth->execute;
  while ( my $row = $sth->fetch ) {
    print "Found a row: id = $row->[0], name = $row->[1]\n";
  }

  # Disconnect from the database.
  $dbh->disconnect;

=head1 METHODS

=head2 Driver Handle Methods

=over

=item B<connect>

  use DBI();

  $dsn = 'dbi:monetdb:';
  $dsn = "dbi:monetdb:host=$host";
  $dsn = "dbi:monetdb:host=$host;port=$port";

  $dbh = DBI->connect($dsn, $user, $password);

=over

=item host

The default host to connect to is 'localhost', i.e. your workstation.

=item port

The port where MonetDB daemon listens to. Default for MonetDB is 50000.

=back

=back

=head2 Database Handle Methods

The following methods are currently not supported:

  last_insert_id

All MetaData methods are supported. However, column_info() currently doesn't
provide length (size, ...) related information.
The foreign_key_info() method returns a SQL/CLI like result set,
because it provides additional information about unique keys.

=head2 Statement Handle Methods

The following methods are currently not supported:

  bind_param_inout
  more_results
  blob_read

=head1 ATTRIBUTES

The following attributes are currently not supported:

  LongReadLen
  LongTruncOk

=head2 Database Handle Attributes

The following attributes are currently not supported:

  RowCacheSize

=head2 Statement Handle Attributes

The following attributes are currently not (or not correctly) supported:

  PRECISION  (MonetDB semantic != DBI semantic)
  SCALE      (empty)
  NULLABLE   (SQL_NULLABLE_UNKNOWN = 2)
  CursorName
  RowsInCache

=head1 AUTHORS

Martin Kersten E<lt>[e-mail]<gt> implemented the initial Mapi
based version of the driver (F<monet.pm>).
Arjan Scherpenisse E<lt>[e-mail]<gt> renamed this module to
F<monetdbPP.pm> and derived the new MapiLib based version (F<monetdb.pm>).
Current maintainer is Steffen Goeldner E<lt>[e-mail]<gt>.

=head1 COPYRIGHT AND LICENCE

The contents of this file are subject to the MonetDB Public License
Version 1.1 (the "License"); you may not use this file except in
compliance with the License. You may obtain a copy of the License at
http://monetdb.cwi.nl/Legal/MonetDBLicense-1.1.html

Software distributed under the License is distributed on an "AS IS"
basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
License for the specific language governing rights and limitations
under the License.

The Original Code is the MonetDB Database System.

The Initial Developer of the Original Code is CWI.
Portions created by CWI are Copyright (C) 1997-2007 CWI.
All Rights Reserved.

Contributor(s): Steffen Goeldner.

=head1 SEE ALSO

=head2 MonetDB

  Homepage    : http://monetdb.cwi.nl
  SourceForge : http://sourceforge.net/projects/monetdb

=head2 Perl modules

L<DBI>, L<MonetDB::CLI>

=cut