MyDBI auf dem Weg zu einer eigenen Klassenhierarchie

MySQL Statements in Klassen organisieren und nur noch Funktionen aufrufen

Ausgehend von eine Basisklasse, deren Instanz eine Sitzung zum MySQL-Server herstellt, werden spezielle Anwendungen in Subklassen organisiert, so die Idee. Aber auch in der Basisklasse können eine Reihe von Methoden untergebracht werden, die universell zu verwenden sind und ggf. in der jeweiligen Subklasse überschrieben werden werden können.

Konstruktor der Basisklasse MyDBI

package MyDBI;

use strict;
use warnings;
use DBI;


sub new{
    my $class = shift;
    my %cfg = (
        base => '',   # Name der Datenbank
        host => '',
        port => 3306,
        user => '',
        pass => '',
    @_);

    return eval{
        my $dbh = DBI->connect_cached(
            "DBI:mysql:$cfg{base}:$cfg{host}:$cfg{port}",
            $cfg{user}, $cfg{pass},
            {RaiseError => 1, PrintError => 0}
        );
        my $self = bless{
            DBH => $dbh,
            CFG => \%cfg
        }, $class;
    };
}

Der Konstruktor setzt die Art der Fehlerbehandlung auf Exception und weist ansonsten keine Besonderheiten auf. Von Interesse ist die Übernahme der Konfiguration in eine Eigenschaft der Instanz, was beim Debugging nützlich sein kann. Übergeben werden die Credentials, und Angaben zum Data Source Name, DSN. Der Aufruf sieht so aus:

    my $db = MyDBI->new( %attr )
        || die $@;

Und das liefert eine Instanz mit welcher eine Reihe weiterer universeller Methoden aufgerufen werden können.

sub insert

# Universelle Methode
sub insert{
    my $self  = shift;
    my $table = shift || die "Tabellenname fehlt! @{[caller]}\n";
    my %ins   = @_;
    my @cols  = keys %ins;
    my @vals  = @ins{@cols};

    my $cols  = join ",", map{$self->{DBH}->quote_identifier($_)}@cols;
    my $vals  = join ",", map{$self->{DBH}->quote($_)}@vals;

    $table = $self->{DBH}->quote_identifier($table);
    eval {
        $self->{DBH}->do("INSERT INTO $table ($cols) VALUES($vals)");
    };
}

# Aufruf
$db->insert('tabname', spalte => 'wert', col => 'value',...)
    || die $@;

Diese Methode zeigt im Wesentlichung die erste Zweckbestimmung einer solchen Klasse: Anstatt SQL-Statements abzusetzen werden in der eigenen Anwendung einfach nur Methoden aufgerufen.

sub last_insert_id

sub last_insert_id{
    my $self = shift;
    $self->{DBH}->selectrow_hashref("SELECT LAST_INSERT_ID() as id")
        ->{id} || '0E0';
}

Sofern es eine Spalte mit auto_increment gibt, liefert diese Methode den numerischen Wert der zuletzt von MySQL vergeben wurde. Gibt es keine solche Spalte, liefert die Methode eine Null deren boolscher Wert wahr ist. Ansonsten ist der von MySQL vergebene Wert an die Sitzung gebunden. Wird die Methode last_insert_id() unmittelbar nach einem insert() aufgerufen ist der Rückgabewert eindeutig zuzuordnen.

Weitere Methoden deren Namen selbsterklärend sind

sub drop{
    my $self = shift;
    my $tabn = shift || die "Tabellenname fehlt! @{[caller]}\n";
    $tabn = $self->{DBH}->quote_identifier($tabn);
    eval{$self->{DBH}->do("DROP TABLE $tabn")};
}

sub truncate{
    my $self = shift;
    my $tabn = shift || die "Tabellenname fehlt! @{[caller]}\n";
    $tabn = $self->{DBH}->quote_identifier($tabn);
    eval{$self->{DBH}->do("TRUNCATE $tabn")};
}

sub count{
    my $self = shift;
    my $tabn = shift || die "Tabellenname fehlt! @{[caller]}\n";
    $tabn = $self->{DBH}->quote_identifier($tabn);
    return eval{
        $self->{DBH}->selectrow_hashref("SELECT count(*) as count FROM $tabn")
            ->{count};
    };
}

# Löscht einen Datensatz für eine bestimmte id
# bedingt universell verwendbar!
sub delete_by_id{
    my $self = shift;
    my $tabn = shift || die "Tabellenname fehlt! @{[caller]}\n";
    my $id   = shift || die "Angabe der id fehlt! @{[caller]}\n";
    $tabn = $self->{DBH}->quote_identifier($tabn);
    do{$self->{DBH}->do("DELETE FROM $tabn WHERE id=?", {}, $id)};
}

# Löscht alle Datensätze
sub delete{
    my $self = shift;
    my $tabn = shift || die "Tabellenname fehlt! @{[caller]}\n";
    $tabn = $self->{DBH}->quote_identifier($tabn);
    do{$self->{DBH}->do("DELETE FROM $tabn")};
}

# Gibt das DBHandle heraus für
# eigene Statements außerhalb der Klasse
sub handle{shift->{DBH}}

sub describe{
    my $self = shift;
    my $tabn = shift || die "Tabellenname fehlt! @{[caller]}\n";
    $tabn = $self->{DBH}->quote_identifier($tabn);
    $self->{DBH}->selectall_arrayref("DESCRIBE $tabn", {Slice=>{}});
}

# Eine spezielle Variable
sub max_allowed_packet{
    my $self = shift;
    $self->{DBH}->selectrow_hashref(q(
        show variables where variable_name = 'max_allowed_packet'
    ))->{Value};
}

# Alle Variablen
sub show_variables{
    my $self = shift;
    my %vars = map{$_->[0] => $_->[1]} @{$self->handle->selectall_arrayref("show variables")};
    \%vars;
}

Wobei die Methode delete_by_id() nur dann funktionieren kann, wenn es tatsächlich eine Spalte mit dem Namen id gibt und damit einen Datensatz eindeutig kennzeichnet. In der Regel bekommen auto_increment Spalten den Namen id, was eine solche Methode universell verwendbar macht.

Es gibt sicher weitere Kandidaten für universell verwendbare Methoden, kommen wir nun jedoch zur Qualifizierung und Klassifizierung infolge Bildung von Subklassen. Untenstehendes Beispiel macht deutlich, wohin die Reise geht.

Subklasse MyDBI::Test

package MyDBI::Test;

our @ISA = qw(MyDBI);
use strict;
use warnings;

sub create{
    my $self = shift;

    my $st = q(
        CREATE TABLE test(
          `mesg` text,
          `id` int(11) NOT NULL AUTO_INCREMENT,
          `subject` varchar(100) NOT NULL DEFAULT '',
          `zahl` tinyint NOT NULL DEFAULT 0,
          `datum` timestamp NOT NULL DEFAULT CURRENT_TIMESTAMP,
          KEY `id` (`id`)
        ) ENGINE=MyISAM AUTO_INCREMENT=15 DEFAULT CHARSET=latin1
    );
    eval{$self->{DBH}->do($st)}; # DEFAULT CHARSET=utf8
}

sub truncate{
    my $self = shift;
    $self->{DBH}->do('TRUNCATE test');
}

In der create()-Methode werden für alle beteiligten Tabellen die Create-Statements gleichermaßen aufrufbar wie dokumentiert. Im Beispiel gibt es nur eine Tabelle und somit nur ein Create-Statement. Wird beim Entwickeln eine Versionskontrolle eingesetzt, werden somit auch die Create Statements automatisch mit eingecheckt.

Die Methode truncate() hingegen kennen wir bereits aus der Basisklasse. Sie wird hier überlagert und damit für eine ganz bestimmte Tabelle spezialisiert.

Es folgt nun ein weiteres Beispiel einer Spezialisierung wo zwei Tabellen im Spiel sind.

Subklasse MyDBI::Names

Im Folgenden nun eine von der Basisklasse MyDBI abgleitete Subklasse, welche einen relativ einfachen Object Relational Mapper (ORM) implemeniert. Es werden zwei Tabellen verwendet, wobei die Tabelle namen nur dazu dient, fortlaufende Nummern für die einzufügenden Objekte bereitzustellen. Von daher wird in dieser Klasse auf Prüfungen der referentiellen Integrität verzichtet und wenn es eine andere Methode gibt, fortlaufende Nummern zu erzeugen, kann die Tabelle namen sogar entfallen.

Die grundsätzliche Idee hinter ORM ist die, daß der abstrakte Datentyp, also die eigentliche Datenstruktur nur noch von der Anwendung selbst bestimmt wird und das völlig unabhängig vom Datenbankdesign. So können die zu speichernden Objekte beliebig viele Attribute => Value Paare haben.

Adererseits ist es jederzeit möglich auf SQL Ebene mit einem entsprechenden JOIN eine normale Tabelle als Ausgabe zu erzeugen wie untenstehendes Beispiel zeigt:

SELECT
  d1.val as Wohnort,
  d2.val as Strasse,
  d3.val as PLZ
FROM details d1
JOIN details d2 using(ent)
JOIN details d3 using(ent)
WHERE
  d1.att = 'ort' AND d2.att = 'str' AND d3.att = 'plz' AND
  d1.ent = 65

Untenstehend nun der Code für die Sublasse:

package MyDBI::Names;

our @ISA = qw(MyDBI);
use strict;
use warnings;

# Es gibt 2 Tabellen: namen, details
sub create{
    my $self = shift;

    my $st_namen = q(
        CREATE TABLE `namen` (
          `id` int(11) NOT NULL AUTO_INCREMENT,
          `name` varchar(255) NOT NULL DEFAULT '',
          PRIMARY KEY (`id`)
        ) ENGINE=MyISAM DEFAULT CHARSET=utf8
    );

    my $st_details = q(
        CREATE TABLE `details` (
          `ent` varchar(128) COLLATE utf8_bin NOT NULL DEFAULT '',
          `att` varchar(128) COLLATE utf8_bin NOT NULL DEFAULT '',
          `val` longtext COLLATE utf8_bin,
          PRIMARY KEY (`ent`,`att`),
          KEY `att` (`att`),
          KEY `ent` (`ent`)
        ) ENGINE=MyISAM DEFAULT CHARSET=utf8 COLLATE=utf8_bin
    );

    return eval{
        $self->{DBH}->do($st_namen);
        $self->{DBH}->do($st_details);
    }
}

sub checkin{
    my $self = shift;
    my %in = (
        name => '',
    @_);

    die "name erforderlich: @{[caller]}\n" unless $in{name};

    return eval{
        my $sth_name = $self->{STH}{namen} ? $self->{STH}{namen} : do{
            $self->{STH}{namen} = $self->{DBH}->prepare('INSERT INTO namen (name) values (?)');
            $self->{STH}{namen};
        };

        my $sth_details = $self->{STH}{details} ? $self->{STH}{details} : do{
            $self->{STH}{details} = $self->{DBH}->prepare('INSERT INTO details (ent, att, val) VALUES (?,?,?)');
            $self->{STH}{details};
        };

        $sth_name->execute($in{name});
        my $id = $self->last_insert_id;
        foreach my $att ( keys %in ){
            $sth_details->execute($id, $att, $in{$att});
        }

        $id;
    }
}

sub update{
    my $self = shift;
    my $id = shift;
    my %in = @_;

    return eval{
        my $sth_details = $self->{STH}{details} ? $self->{STH}{details} : do{
            $self->{STH}{details} = $self->{DBH}->prepare('INSERT INTO details (ent, att, val) VALUES (?,?,?)');
            $self->{STH}{details};
        };
        my $legacy = $self->checkout($id);
        $self->{DBH}->do('DELETE FROM details WHERE ent=?',{},$id);
        %in = (%$legacy, %in);
        foreach my $att ( keys %in ){
            $sth_details->execute($id, $att, $in{$att});
        }
        1;
    };
}

sub checkout{
    my $self = shift;
    my $id = shift || die "id fehlt: @{[caller]}\n";

    my $sth = $self->{STH}{checkout} ? $self->{STH}{checkout} : do{
        $self->{STH}{checkout} = $self->{DBH}->prepare(q(
            SELECT ent,att,val FROM details WHERE ent = ?
        ));
        $self->{STH}{checkout};
    };

    return eval{
        $sth->execute($id);
        my $hunt = {};
        foreach my $r( @{$sth->fetchall_arrayref({})} ){
            foreach my $att( keys %$r ){
                $hunt->{$r->{att}} = $r->{val};
            }
        }
        $hunt;
    };
}

sub delete{
    my $self = shift;
    my $id = shift;

    return eval{
        $self->{DBH}->do('DELETE FROM namen WHERE id = ? ',{}, $id);
        $self->{DBH}->do('DELETE FROM details WHERE ent = ? ',{}, $id);
    };
}

1; ########################################################################
# Anwendung, API zu dieser Klasse
###########################################################################
__END__
use Data::Dumper;

my $db = MyDBI::Names->new( base => 'myweb') or die $@;

my $id = $db->checkin(
    name => 'Horst Fred',
    ort => 'Groß Mähschen',
    str => 'Steinstraße 3',
) or die $@;

my $hunt = $db->checkout($id) or die $@;
$db->update($id, tel => 333, str => 'Steinstraße 4');
my $up = $db->checkout($id) or die $@;
print Dumper $hunt, $up;



Anbieter: nmq​rstx-18­@yahoo.de, die Seite verwendet funktionsbedingt einen Session-Cookie und ist Bestandteil meines nach modernen Aspekten in Perl entwickelten Frameworks.