###########################################################################
#
# Dateiname: Kladde.pm
# Einfache Klasse für eine Tabelle
# Rolf Rost, 15.7.2011
#
###########################################################################
package Kladde;

use strict;
use warnings;
use DBI;

# Object beeinhaltet die Definition der Felder und
# die Definition des Primary Key
sub new{
        my $class = shift;
        my %opts = @_;
        # Definiere die erforderlichen Felder
        # [0]-> Attribute DB, Feldtype
        # Achtung, es kommt noch ein Feld für das Einfügedatum hinzu
        # fest codiert: Feldname 'datime'
        my $self = bless{
                FIELDS => {
                        name =>  ["varchar(100) NOT NULL DEFAULT ''", 'Familienname'],
                        vorname => ["varchar(100) NOT NULL DEFAULT ''", 'Vorname'],
                        wohnort => ["varchar(100) NOT NULL DEFAULT ''", 'Wohnort'],
                        email => ["varchar(100) NOT NULL DEFAULT ''", 'Email'],
                        homepage => ["varchar(255) NOT NULL DEFAULT ''", 'Website'],
                        typ =>  ["varchar(100) NOT NULL DEFAULT ''", 'Schiffstyp'],
                        descr => ["text", 'Angaben zur Person'],
                        dienstzeit => ["varchar(100) NOT NULL DEFAULT ''", 'Dienstzeit von bis'],
                        dienstgrad => ["varchar(100) NOT NULL DEFAULT ''", 'Dienstgrad'],
                        dienststellung => ["varchar(100) NOT NULL DEFAULT ''", 'Dienststellung'],
                        einheit => ["varchar(100) NOT NULL DEFAULT ''", 'Name der Einheit'],
                        nummer => ["varchar(100) NOT NULL DEFAULT ''", 'Schiffsnummer'],
                },
                PKEY => q(name, vorname, email),
                DBH => undef,
        }, $class;
        
        $self->_handle(%opts) or return;    # Fehler in $@
        return $self;
}

########################## PRIVATE METHODS ################################
# Erstelle DataBaseHandle
sub _handle{
        my $self = shift;
        # Default Settings
        my %opts = (
                base => 'myweb',      # Name der Datenbank
                user => '',           # DB Benutzername
                pass => '',           # DB Passwort
                port => 3306,         # DB Port
                host => 'localhost',  # DB Host
                tabn => 'kladde',     # Name der Tabelle
                @_,                   # Parameter
        );

        # Alle Keys muessen definiert sein
        foreach my $k(keys %opts){ return if not defined $k } 

        # Data Source Name
        my $dsn = "DBI:mysql:database=$opts{base};host=$opts{host};port=$opts{port}";
        eval{
                $self->{DBH} = DBI->connect_cached(
                        $dsn, $opts{user}, $opts{pass}, {
                                RaiseError => 1, 
                                PrintError => 0,
                        }
                );
        };
        
        if($@){
                return;
        }
        else{
                $self->{TABN} = $self->{DBH}->quote_identifier($opts{tabn});
                return 1;
        }
}
########################## PUBLIC METHODS #################################
# Tabelle erstellen
sub create_table{
        my $self = shift;

        # Felder aufarbeiten, quote_identifier
        my @fields  = ();
        foreach my $f(keys %{$self->{FIELDS}}){
                my $qf = $self->{DBH}->quote_identifier($f);
                # Attribute hinzu
                push @fields, qq($qf $self->{FIELDS}->{$f}->[0]);
        }
        
        # Datum/Zeitfeld hinzu
        push @fields, qq(datime DATETIME NOT NULL DEFAULT '0000-00-00 00:00:00');

        # Falls ein Primary Key sein soll
        if(defined $self->{PKEY}){ push @fields, qq(PRIMARY KEY ($self->{PKEY})) }
        
        my $fields = join ",", @fields;

        # Statement
        my $q = qq(
                CREATE TABLE $self->{TABN} (
                        $fields
                ) ENGINE=MyISAM DEFAULT CHARSET=utf8 
        );

        eval{ $self->{DBH}->do($q) };
        return $@ ? undef : 1;
}
###########################################################################
# Tabelle entfernen
sub drop_table{
        my $self = shift;
        eval{ $self->{DBH}->do("DROP TABLE $self->{TABN}") };
        return $@ ? undef : 1;
}

# INSERT, nach dem ersten Aufruf liegt das prepared Statement im Objekt
# Damit werden mehrere aufeinanderfolgende Inserts performanter
sub insert{
        my $self = shift;
        my %vals = @_; # hash
        
        # Reihenfolge hier egal aber später beim Einbau genauso wie hier!!!
        my @fields = keys %{$self->{FIELDS}};
        
        # Achtung, das Feld 'datime' geht extra mit NOW()

        # erzeuge prepared Statement
        if(not defined($self->{STH_INSERT})){
                my @qms = ();     # Question Marks
                my @updates = (); # Falls ein Primary Key definiert ist
                for(@fields){
                        push @qms, "?";
                        push @updates, "$_=?";
                }
                my $q = "INSERT INTO $self->{TABN} (".join(",", @fields).", datime) VALUES(".join(",", @qms).", NOW() )";
                $q .= " ON DUPLICATE KEY UPDATE ".join(",", @updates).", datime=NOW()";

                $self->{STH_INSERT} = $self->{DBH}->prepare_cached($q); 
        }
        
        # Konsistenzprüfung der einzugebenden Werte
        my @input = ();
        foreach my $f(@fields){
                if(my $val = $vals{$f}){
                        push @input, $val;
                }
                else{
                        $@ = "Eingabefelder nicht korrekt mit Werten";
                        return;
                }
        }
        eval{ $self->{STH_INSERT}->execute(@input, @input) };

        return $@ ? undef : 1;
}
###########################################################################
# Löschen nach bestimmten Keys
sub delete{
        my $self = shift;
        my %keys = @_; 
        
        if(not keys %keys){
                $@ = "Keine Schluesselwerte definiert",
                return;
        }
        
        # Where Klause zusammenbauen
        my @where = ();
        foreach my $k(keys %keys){
                my $v = $self->{DBH}->quote($keys{$k});
                push @where, qq($k = $v);
        }
        my $where = "WHERE ".join(" AND ", @where);
        eval{ $self->{DBH}->do("DELETE FROM $self->{TABN} $where") };
        return $@ ? undef : 1;
}
1;#########################################################################


# Zum Testen entferne den END-Token und führe die Datei aus mit Perl
# Oder das Modul unter 'Kladde.pm' abspeichern und im Script mit 
# use Kladde;
# einbinden
__END__

package main;

use strict;
use warnings;

# Anwendung im CGI-Script
# Optionen für die Datenbank
my %myopts = (
        base => 'myweb',
        tabn => 'kladde',
        user => '',
        pass => '',
        host => 'localhost',
        port => 3306,
);

# Objekterstellung, DataBaseObject
# Zur Fehlerbehandlung immer $@ abfragen
# Jede Funktion liefert 1 bei Erfolg, undef bei NichtErfolg 
my $dbo = Kladde->new(%myopts) or die $@;;

# erklärt sich von selbst
# $dbo->create_table or die $@;
# $dbo->drop_table or die $@;



# Alle Felder müssen einen Wert bekommen
# Generalprobe mit einigen Inserts
for(1..2000){
        $dbo->insert(
                name => "Larson $_",
                vorname => "Holger $_",
                typ => 'Flaggschiff',
                descr => 'Meine Zeit bei Marina',
                wohnort => 'Buxtehude',
                email => "blonder_hans_$_\@example.com",
                dienstzeit => '1975-1978',
                dienstgrad => 'Vollmatrose',
                dienststellung => 'Klabautermann',
                einheit => 'Hannes Schinder',
                nummer => "abc/0815 $_",
                homepage => "http://example.com/$_",    
        ) or die $@;
}
# entsprechend der Keys wird gelöscht
#$dbo->delete(
#       name => 'Albers',
#       vorname => 'Hanns',
#) or die $@;