libdbd-firebird-perl 1.15-2 / usr / lib / perl5 / DBD / FirebirdEmbedded.pm

# ************************************************************
# This is an automaticaly generated file.
# If needed, edit Firebird.pm in the parent directory
# and run perl Makefile.PL to re-generate it.
# ************************************************************

#
#   Copyright (c) 2011  Marius Popa <mapopa@gmail.com>
#   Copyright (c) 2011  Damyan Ivanov <dmn@debian.org>
#   Copyright (c) 1999-2008 Edwin Pratomo
#
#   You may distribute under the terms of either the GNU General Public
#   License or the Artistic License, as specified in the Perl README file

require 5.008001;

package DBD::FirebirdEmbedded;
use strict;
use Carp;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
use DBI 1.41 ();
require Exporter;
require DynaLoader;

@ISA = qw(Exporter DynaLoader);
$VERSION = '1.15';

bootstrap DBD::FirebirdEmbedded $VERSION;

use vars qw($VERSION $err $errstr $drh);

$err = 0;
$errstr = "";
$drh = undef;


sub CLONE
{
    $drh = undef;
}


sub driver
{
    return $drh if $drh;
    my($class, $attr) = @_;

    $class .= "::dr";

    $drh = DBI::_new_drh($class, {'Name' => 'FirebirdEmbedded',
                                  'Version' => $VERSION,
                                  'Err'    => \$DBD::FirebirdEmbedded::err,
                                  'Errstr' => \$DBD::FirebirdEmbedded::errstr,
                                  'Attribution' => 'DBD::FirebirdEmbedded by Edwin Pratomo and Daniel Ritz'});
    $drh;
}

# taken from JWIED's DBD::mysql, with slight modification
sub _OdbcParse($$$) 
{
    my($class, $dsn, $hash, $args) = @_;
    my($var, $val);

    if (!defined($dsn))
       { return; }

    while (length($dsn)) 
    {
        if ($dsn =~ /([^;]*)[;]\r?\n?(.*)/s) 
        {
            $val = $1;
            $dsn = $2;
        } 
        else 
        {
            $val = $dsn;
            $dsn = '';
        }
        if ($val =~ /([^=]*)=(.*)/) 
        {
            $var = $1;
            $val = $2;
            if ($var eq 'hostname') 
                { $hash->{'host'} = $val; } 
            elsif ($var eq 'db'  ||  $var eq 'dbname') 
                { $hash->{'database'} = $val; } 
            else 
                { $hash->{$var} = $val; }
        } 
        else 
        {
            foreach $var (@$args) 
            {
                if (!defined($hash->{$var})) 
                {
                    $hash->{$var} = $val;
                    last;
                }
            }
        }
    }
    $hash->{host} = "$hash->{host}/$hash->{port}" if ($hash->{host} && $hash->{port});
    $hash->{database} = "$hash->{host}:$hash->{database}" if $hash->{host};
}

sub create_database {
    my ( $self, $params ) = ( shift, shift );
    $self and $params and ref($params) and ref($params) eq 'HASH' and not @_
        or croak 'Usage: '
        . __PACKAGE__
        . '->create_database( { params...} )';

    exists $params->{db_path} and defined( $params->{db_path} )
        or croak "Required parameter 'db_path' not supplied";

    for( qw(db_path user password character_set) ) {
        next unless exists $params->{$_};

        $params->{$_} =~ s/'/''/g if defined($params->{$_});
    }

    DBD::FirebirdEmbedded::db::_create_database($params);
}

sub gfix {
    my ( $self, $params ) = ( shift, shift );
    $self and $params and ref($params) and ref($params) eq 'HASH' and not @_
        or croak 'Usage: '
        . __PACKAGE__
        . '->gfix( { params...} )';

    DBD::FirebirdEmbedded::db::_gfix($params);
}

package DBD::FirebirdEmbedded::dr;

sub connect 
{
    my($drh, $dsn, $dbuser, $dbpasswd, $attr) = @_;

    $dbuser   ||= $ENV{ISC_USER};       #"SYSDBA";
    $dbpasswd ||= $ENV{ISC_PASSWORD};   #"masterkey";

    my ($this, $private_attr_hash);

    $private_attr_hash = {
        'Name' => $dsn,
        'user' => $dbuser,
        'password' => $dbpasswd
    };

    DBD::FirebirdEmbedded->_OdbcParse($dsn, $private_attr_hash,
                               ['database', 'host', 'port', 'ib_role', 'ib_dbkey_scope',
                                'ib_charset', 'ib_dialect', 'ib_cache', 'ib_lc_time']);
    $private_attr_hash->{database} ||= $ENV{ISC_DATABASE}; #"employee.fdb"

    # second attr args will be retrieved using DBIc_IMP_DATA
    my $dbh = DBI::_new_dbh($drh, {}, $private_attr_hash);

    DBD::FirebirdEmbedded::db::_login($dbh, $dsn, $dbuser, $dbpasswd, $attr) 
        or return undef;

    $dbh;
}

package DBD::FirebirdEmbedded::db;
use strict;
use Carp;

sub do 
{
    my($dbh, $statement, $attr, @params) = @_;
    my $rows;
    if (@params) 
    {
        my $sth = $dbh->prepare($statement, $attr) or return undef;
        defined($sth->execute(@params)) or return undef;
        $rows = $sth->rows;
    } 
    else 
    {
        $rows = DBD::FirebirdEmbedded::db::_do($dbh, $statement, $attr);
        return undef unless defined($rows);
    }
    ($rows == 0) ? "0E0" : $rows;
}

sub prepare 
{
    my ($dbh, $statement, $attribs) = @_;
    
    my $sth = DBI::_new_sth($dbh, {'Statement' => $statement });
    DBD::FirebirdEmbedded::st::_prepare($sth, $statement, $attribs)
        or return undef;
    $sth;
}

sub primary_key_info
{
    my ($dbh, undef, undef, $tbl) = @_;

    my $sth = $dbh->prepare(<<'__eosql');
    SELECT CAST(NULL AS CHAR(1))       AS TABLE_CAT,
           CAST(NULL AS CHAR(1))       AS TABLE_SCHEM,
           rc.rdb$relation_name        AS TABLE_NAME,
           ix.rdb$field_name           AS COLUMN_NAME,
           ix.rdb$field_position + 1   AS KEY_SEQ,
           rc.rdb$index_name           AS PK_NAME
      FROM rdb$relation_constraints rc
           INNER JOIN
           rdb$index_segments ix
             ON rc.rdb$index_name = ix.rdb$index_name
     WHERE rc.rdb$relation_name = ?
           AND
           rc.rdb$constraint_type = 'PRIMARY KEY'
  ORDER BY 1, 2, 3, 5
__eosql

    if ($sth) {
        $sth->{ChopBlanks} = 1;
        return unless $sth->execute($tbl);
    }

    $sth;
}

sub table_info
{
    my ($self, $cat, $schem, $name, $type, $attr) = @_;

    require DBD::Firebird::TableInfo;

    my $ti = ($self->{private_table_info}
               ||=
              DBD::Firebird::TableInfo->factory($self));

    no warnings 'uninitialized';
    if ($cat eq '%' and $schem eq '' and $name eq '') {
        return $ti->list_catalogs($self);
    } elsif ($cat eq '' and $schem eq '%' and $name eq '') {
        return $ti->list_schema($self);
    } elsif ($cat eq '' and $schem eq '' and $name eq '' and $type eq '%') {
        return $ti->list_types($self);
    } else {
        my %seen;
        $type = '' if $type eq '%';

        # normalize $type specifiers:  upcase, strip quote and uniqify
        my @types = grep { length and not $seen{$_}++ }
                        map { s/'//g; s/^\s+//; s/\s+$//; uc }
                            split(',' => $type);
        return $ti->list_tables($self, $name, @types);
    }
}

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

    local $SIG{__WARN__} = sub { } if $dbh->{PrintError};
    local $dbh->{RaiseError} = 0 if $dbh->{RaiseError};
    my $ret = DBD::FirebirdEmbedded::db::_ping($dbh);

    return $ret;
}

# The get_info function was automatically generated by
# DBI::DBD::Metadata::write_getinfo_pm v1.05.

sub get_info {
    my($dbh, $info_type) = @_;
    require DBD::Firebird::GetInfo;
    my $v = $DBD::Firebird::GetInfo::info{int($info_type)};
    $v = $v->($dbh) if ref $v eq 'CODE';
    return $v;
}

# The type_info_all function was automatically generated by
# DBI::DBD::Metadata::write_typeinfo_pm v1.05.

sub type_info_all
{
    my ($dbh) = @_;
    require DBD::Firebird::TypeInfo;
    return [ @$DBD::Firebird::TypeInfo::type_info_all ];
}

1;

package DBD::FirebirdEmbedded::st;

# taken from DBI.pm, with this only change:
#  - remove the call to bind_param without value when $attr is set
#    * it fails when the column can't contain NULLs
#    * it is not necessary anyway, as we allocate param placeholder
#      structures according to Firebird's ananysis of the SQL, not
#      according to the datatype the supplied in $attr
sub bind_param_array {
    my $sth = shift;
    my ($p_id, $value_array, $attr) = @_;

    return $sth->set_err($DBI::stderr, "Value for parameter $p_id must be a scalar or an arrayref, not a ".ref($value_array))
        if defined $value_array and ref $value_array and ref $value_array ne 'ARRAY';

    return $sth->set_err($DBI::stderr, "Can't use named placeholder '$p_id' for non-driver supported bind_param_array")
        unless DBI::looks_like_number($p_id); # because we rely on execute(@ary) here

    return $sth->set_err($DBI::stderr, "Placeholder '$p_id' is out of range")
        if $p_id <= 0; # can't easily/reliably test for too big

    # get/create arrayref to hold params
    my $hash_of_arrays = $sth->{ParamArrays} ||= { };

    $$hash_of_arrays{$p_id} = $value_array;

    1;
}

1;

__END__

=head1 NAME

DBD::FirebirdEmbedded - embedded Firebird server (and client)

=head1 SYNOPSIS

  use DBI;

  $dbh = DBI->connect("dbi:FirebirdEmbedded:db=$dbname", undef, undef);

  # See the DBI module documentation for full details

=head1 DESCRIPTION


B<DBD::FirebirdEmbedded> is a variant of L<DBD::Firebird>, linked with the
Firebird embedded library, F<libfbembed>. In addition to the ability to work
with remote Firebird servers (which DBD::FirebirdEmbedded has, being linked with the
Firebird client library, F<libfbclient>), DBD::FirebirdEmbedded can be used to
work with Firebird databases without the need of a dedicated Firebird server.

The following things should be set up first:

=over

=item Username/password

These should be unset. Both in the C<< DBI->connection(...) >> call and in the
environment (C<ISC_USER>, C<ISC_PASSWORD>, C<DBI_USER>, C<DBI_PASSWORD> variables).

=item Firebird lock directory

The C<FIREBIRD_LOCK> environment variable should be set to some place where the
process can write. Note that if you plan for several processes to access the
database file directly, they all should have C<FIREBIRD_LOCK> set to the same
directory, or else database corruption will occur.

=item No C<host> in the DSN

Obviously, do not set any host when calling C<< DBI->connection(...) >>, not
even C<localhost>.

=item Permissions to read/write the database

Obviously, the process needs to be able to read/write the database file.

=back

=head1 COMPARISON WITH DBD::FIREBIRD

DBD::FirebirdEmbedded provides exactly the same functionality as the Firebird
server of the same version as the F<libfbembed> library. It still can work with
remote datases, in which case the use is exactly the same (DSN, environment) as
with the regular L<DBD::Firebird>.

=head2 Pros

=over

=item Standalone work with Firebird databases

No need to setup/administer a Firebird server. All the server functionality is
available via the F<libfbembed> library. Shared access to databases is still
possible (but read L</Firebird lock directory> above).

=item No network latency

Working directly with the database file elliminates possible network delays
(even if the server is on the local host).

=back

=head2 Cons

=over

=item Memory footprint

The F<libfbembed> library contains a fully functional Firebird server and is
therefore bigger than the ordinary client library, F<libfbclient>.

=item Setup complexity

It is very important to make sure that all processes that access a given
database use the same lock directory. See L</Firebird lock directory> above.

=back

=head1 SEE ALSO

=over

=item L<DBD::Firebird>

=back