view release on metacpan or  search on metacpan

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

        elsif ($dbms eq 'jdbc') {
            $msg = sprintf('JDBC-%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: 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;
            }
            $dbh->do('PRAGMA foreign_keys = ON'); # Schalte Foreign Keys ein
        }
        elsif ($dbms eq 'access') {
            if ($utf8) {
                $dbh->{'odbc_utf8_on'} = 1;
            }
        }
        elsif ($dbms eq 'mssql') {
            if ($utf8) {
                $dbh->{'odbc_utf8_on'} = 1;
            }
            $dbh->{LongTruncOk} = 0; # RuV Auftrags-DB
            # RuV Auftrags-DB
            $dbh->{LongReadLen} = 3*1024*1024; # 3MB / 32768;
        }
        elsif ($dbms eq 'jdbc') {
        }
        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