—
—
—
—
—
—
—
—
—
—

              
package Prty::Database::Api::Dbi::Cursor;
use base qw/Prty::Hash/;
use strict;
use warnings;
our $VERSION = 1.109;
# -----------------------------------------------------------------------------
HideShow 59 lines of Pod
=encoding utf8
=head1 NAME
Prty::Database::Api::Dbi::Cursor - DBI Datenbank-Cursor
=head1 BASE CLASS
L<Prty::Hash>
=head1 DESCRIPTION
Ein Objekt der Klasse repräsentiert einen DBI-Datenbank-Cursor.
=head1 ATTRIBUTES
=over 4
=item sth => $sth
DBI Statement-Handle.
=item bindVars => $n
Anzahl an Bind-Variablen, die im Statement enthalten sind. Ist
die Anzahl größer 0, handelt es sich um einen Bind-Cursor.
=item titles => \@titles
Array der Kolumentitel. Ist das Array nicht leer, handelt es
sich um einen Select-Cursor.
=item hits => $n
Anzahl der getroffenen Datensätze.
=item id => $id
Id nach INSERT in Tabelle mit AUTOINCREMENT-Kolumne (MySQL, SQLite)
=back
=head1 METHODS
=head2 Konstruktor/Destruktor
=head3 new() - Instantiiere Cursor
=head4 Synopsis
    $cur = $class->new(@keyVal);
=head4 Description
Instantiiere ein Cursor-Objekt mit den Attributen @keyVal
und liefere dieses zurück.
=cut
# -----------------------------------------------------------------------------
sub new {
    my $class = shift;
    my $self = $class->SUPER::new(
        sth=>undef,
        bindVars=>0,
        bindTypes=>[],
        db=>undef,
        titles=>[],
        hits=>0,
        id=>0,
    );
    $self->set(@_);
    return $self;
}
# -----------------------------------------------------------------------------
HideShow 13 lines of Pod
=head3 destroy() - Schließe Cursor
=head4 Synopsis
    $cur->destroy;
=head4 Description
Schließe Cursor. Die Objektreferenz ist anschließend ungültig.
Die Methode liefert keinen Wert zurück.
=cut
# -----------------------------------------------------------------------------
sub destroy {
    my ($self) = @_;
    if (my $sth = $self->{'sth'}) {
        $sth->finish;
    }
    $_[0] = undef;
    return;
}
# -----------------------------------------------------------------------------
HideShow 15 lines of Pod
=head2 Akzessoren
=head3 bindVars() - Liefere die Anzahl der Bind-Variablen
=head4 Synopsis
    $n = $cur->bindVars;
=head4 Description
Liefere die Anzahl der Bind-Variablen, die im SQL-Statement enthalten
waren.
=cut
# -----------------------------------------------------------------------------
sub bindVars {
    return shift->{'bindVars'};
}
# -----------------------------------------------------------------------------
HideShow 9 lines of Pod
=head3 bindTypes() - Setze/Liefere Datentypen der Bind-Variablen
=head4 Synopsis
    @arr|$arr = $cur->bindTypes(@dataTypes);
    @arr|$arr = $cur->bindTypes;
=cut
# -----------------------------------------------------------------------------
sub bindTypes {
    my $self = shift;
    # @_: @types
    my $arr = $self->{'bindTypes'};
    if (@_) {
        @$arr = ();
        my $dbms = $self->{'db'}->{'dbms'};
        for my $type (@_) {
            if (!defined $type) {
                push @$arr,undef;
            }
            elsif ($type eq 'BLOB') {
                if ($dbms eq 'oracle') {
                    push @$arr,{ora_type=>DBD::Oracle::SQLT_BIN()};
                }
                elsif ($dbms eq 'postgresql') {
                    push @$arr,{pg_type=>DBD::Pg::PG_BYTEA()};
                }
                else {
                    push @$arr,undef;
                }
            }
            elsif ($type eq 'TEXT') {
                if ($dbms eq 'oracle') {
                    push @$arr,{ora_type=>DBD::Oracle::SQLT_CHR()};
                }
                else {
                    push @$arr,undef;
                }
            }
            elsif ($type eq 'NUMBER') {
                if ($dbms eq 'oracle') {
                    push @$arr,{ora_type=>DBD::Oracle::ORA_NUMBER()};
                }
                else {
                    push @$arr,undef;
                }
            }
            elsif ($type eq 'XML') {
                if ($dbms eq 'oracle') {
                    push @$arr,{ora_type=>DBD::Oracle::ORA_XMLTYPE()};
                }
                else {
                    push @$arr,undef;
                }
            }
            else {
                push @$arr,$type;
            }
        }
    }
    return wantarray? @$arr: $arr;
}
# -----------------------------------------------------------------------------
HideShow 14 lines of Pod
=head3 hits() - Liefere die Anzahl der getroffenen Datensätze
=head4 Synopsis
    $n = $cur->hits;
=head4 Description
Liefere die Anzahl der Datesätze, die bei der Ausführung des
Statement getroffen wurden. Im Falle einer Selektion ist dies die
Anzahl der (bislang) gelesenen Datensätze.
=cut
# -----------------------------------------------------------------------------
sub hits {
    return shift->{'hits'};
}
# -----------------------------------------------------------------------------
HideShow 8 lines of Pod
=head3 id() - Liefere die Id des eingefügten Datensatzes
=head4 Synopsis
    $id = $cur->id;
=cut
# -----------------------------------------------------------------------------
sub id {
    return shift->{'id'};
}
# -----------------------------------------------------------------------------
HideShow 8 lines of Pod
=head3 titles() - Liefere eine Referenz auf Liste der Kolumnentitel
=head4 Synopsis
    $titlesA = $cur->titles;
=cut
# -----------------------------------------------------------------------------
sub titles {
    return shift->{'titles'};
}
# -----------------------------------------------------------------------------
HideShow 15 lines of Pod
=head2 Objektmethoden
=head3 bind() - Führe Bind-Statement aus
=head4 Synopsis
    $cur = $cur->bind(@vals);
=head4 Description
Führe Bind-Statement aus und liefere einen (neuen) Cursor über
das Resultat der Statement-Ausführung zurück.
=cut
# -----------------------------------------------------------------------------
sub bind {
    my $self = shift;
    my ($sth,$bindVars,$bindTypes) = $self->get(qw/sth bindVars bindTypes/);
    my $hits = 0;
    while (@_) {
        my @vals;
        if (ref $_[0]) {
            # Wert ist (Array-)Referenz, wir expandieren die Referenz
            @vals = @{shift()}
        }
        else {
            # Abfolge von Werten
            @vals = splice @_,0,$bindVars;
        }
        # '' auf undef umsetzen
        for (@vals) {
            if (defined $_ && $_ eq '') {
                $_ = undef;
            }
        }
        # Werte binden und Statement ausführen. BindType kann
        # undef sein. Im Falle von Oracle und BLOB oder CLOB sollte
        # ein Type spezifiziert sein (siehe Methode bindTypes)
        for (my $i = 0; $i < @vals; $i++) {
            $sth->bind_param($i+1,$vals[$i],$bindTypes->[$i]);
        }
        my $r = $sth->execute;
        $hits += $r if $r > 0;
    }
    $self->{'hits'} = $hits;
    # Die Kolumnentitel sind bei SELECT-Statements mit Bind-Variablen
    # erst nach dem Bind verfügbar.
    if ($sth->{'NUM_OF_FIELDS'}) {
        $self->{'titles'} = $sth->{'NAME_lc'};
    }
    return $self;
}
# -----------------------------------------------------------------------------
HideShow 22 lines of Pod
=head3 fetch() - Liefere den nächsten Datensatz
=head4 Synopsis
    $row = $cur->fetch;
=head4 Description
Liefere eine Referenz auf den nächsten Datensatz der Ergebnismenge.
Ist das Ende der Ergebnismenge erreicht, liefere undef.
Der Datensatz ist ein Array mit den Kolumnenwerten.
Bei DBI liefert jeder Aufruf dieselbe Referenz, so dass das Array vom
Aufrufer normalerweise kopiert werden muss.
Nullwerte werden durch einen Leerstring repräsentiert.
Da DBI einen Nullwert durch undef repräsentiert, nimmt die
Methode eine Abbildung von undef auf '' vor.
=cut
# -----------------------------------------------------------------------------
sub fetch {
    my $self = shift;
    my $curName = shift;
    my $chunkSize = shift;
    my $chunkPosS = shift;
    if ($curName) { # PostgreSQL
        if ($$chunkPosS == $chunkSize) {
            my $stmt = "FETCH $chunkSize FROM $curName";
            my $cur = $self->{'db'}->sql($stmt,-log=>0);
            $self->{'sth'} = $cur->{'sth'};
            # $self->{'sth'} = $self->{'db'}->{'dbh'}->prepare($stmt);
            # $self->{'sth'}->execute;
            $$chunkPosS = 1; # nicht 0, da wir den ersten Satz unten fetchen!
        }
        else {
            $$chunkPosS++;
        }
    }
    my $row = $self->{'sth'}->fetchrow_arrayref;
    if ($row) {
        grep { $_ = '' if !defined $_ } @$row; # undef -> ''
    }
    return $row;
}
# -----------------------------------------------------------------------------
HideShow 19 lines of Pod
=head1 VERSION
1.109
=head1 AUTHOR
Frank Seitz, L<http://fseitz.de/>
=head1 COPYRIGHT
Copyright (C) 2017 Frank Seitz
=head1 LICENSE
This code is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
# -----------------------------------------------------------------------------
1;
# eof