view release on metacpan or  search on metacpan

lib/Prty/Database/Api/Dbi/Connection.pm  view on Meta::CPAN

        elsif ($dbms eq 'access') {
            $msg = sprintf('ACCESS-%05d: %s',$err,$errstr);
        }

        if ($stmt) {
            substr($stmt,$pos,0) = '<*>' if $pos;
            $stmt =~ s|^\s+||;
            $stmt =~ s|\s+$||;
        }

        if ($stdErr) {
            my $stdMsg;
            if ($stdErr == 4) {
                $stdMsg = "DB-00004: Unique Constraint verletzt";
            }
            $class->throw($stdMsg,Internal=>$msg,Command=>$stmt);
        }
        else {
            $class->throw($msg,Command=>$stmt);
        }
    };

    my ($dbh,$strict);
    if ($handle) {
        $dbh = $handle; # bereits aufgebaute Db-Verbindung
        $strict = 0;
    }
    else {
        $dbh = DBI->connect($dsn,$user,$passw,{
            HandleError=>$errSub,
            RaiseError=>1,
            ShowErrorStatement=>1,
            AutoCommit=>$autoCommit,
            Warn=>0,
        });
        $strict = 1;
    }

    if (!$handle) {
        if ($dbms eq 'oracle') {
            $dbh->{'LongReadLen'} = 3*1024*1024; # 3MB
            if ($utf8) {
                $dbh->{'ora_charset'} = 'AL32UTF8';
            }
        }
        elsif ($dbms eq 'postgresql') {
            if ($utf8) {
                $dbh->{'pg_enable_utf8'} = 1;
                # $dbh->do('SET client_encoding TO utf8');
            }
            else {
                $dbh->{'pg_enable_utf8'} = 0;
                # scheinbar nötig
                $dbh->do('SET client_encoding TO latin1');
            }
            # keine \-Escapes in String-Literalen zulassen
            $dbh->do("SET standard_conforming_strings = ON");
        }
        elsif ($dbms eq 'mysql') {
            if ($utf8) {
                $dbh->{'mysql_enable_utf8'} = 1;
                $dbh->do('SET NAMES utf8');
            }
            # Schalte in den "Strict SQL Mode"
            $dbh->do("SET sql_mode = 'STRICT_TRANS_TABLES'");
        }
        elsif ($dbms eq 'sqlite') {
            if ($utf8) {
                # $dbh->{'unicode'} = 1;
                $dbh->{'sqlite_unicode'} = 1;
            }
        }
        elsif ($dbms eq 'access') {
            if ($utf8) {
                $dbh->{'odbc_utf8_on'} = 1;
            }
        }
        else {
            $class->throw('Not implemented');
        }
    }

    return $class->SUPER::new(
        dbh=>$dbh,
        dbms=>$dbms,
        # Strict-Umschaltung
        strict=>$strict,
        errSub=>$errSub,
        HandleError=>undef,
        RaiseError=>undef,
        ShowErrorStatement=>undef,
        AutoCommit=>undef,
        Warn=>undef,
    );
}

# -----------------------------------------------------------------------------

=head3 destroy() - Schließe Datenbankverbindung

=head4 Synopsis

    $db->destroy;

=head4 Description

Schließe die Datenbankverbindung. Die Methode liefert keinen Wert zurück.

=cut

# -----------------------------------------------------------------------------

sub destroy {
    #my ($self) = @_;

    #if (my $dbh = $self->get('dbh')) {
    #    $dbh->disconnect;
    #}
    $_[0] = undef;

    return;