# Dateiname: Base.pm


# general pragmas
use strict;
use warnings;

package Base;

# Main-Object der Superklasse
sub new{
        my $class = shift;
        # Definiere die erforderlichen Felder
        # [0]-> Attribute DB
        my $self = bless{
                FIELDS => {
                        name =>  ["varchar(100) NOT NULL DEFAULT ''"],
                        vname => ["varchar(100) NOT NULL DEFAULT ''"],
                        type =>  ["varchar(100) NOT NULL DEFAULT ''"],
                        descr => ["text"],
                },
                DBH => undef,
                CGI => undef,
        }, $class;
        return $self;
}
1;#########################################################################

package Base::DBI::CGI;

# Bestimmung: 
# Object und Methoden für Zugriff auf Datenbank (wird geerbt)
# Darstellung HTML-Formular
# Formularverarbeitung, delegierung param()-method, header()-method

use CGI;
use base qw(Base::DBI);

# Inherit from Base::DBI
sub new{
        my $param = shift;
        my $class = ref($param) || $param;
        my $self = $class->SUPER::new(@_);
        # add the CGI-Attribute, perform the param-method
        $self->{CGI} = CGI->new;
        return $self;
}

############################ PUBLIC METHODS ###############################
# delegiere CGI::param
sub param{
        my $self = shift;
        return $self->{CGI}->param(@_);
}
# delegiere CG::header Method
sub header{
        my $self = shift;
        return $self->{CGI}->header(@_);
}
1;#########################################################################

package Base::DBI;

# Bestimmung: Zugriff auf die Datenbank

use DBI;
use base qw(Base);
use Carp;


# Inherit from 'Base'
sub new{
        my $param = shift;
        my $class = ref($param) || $param;
        my $self = $class->SUPER::new;
        # add the DatabaseHandle
        $self->_handle(@_) or croak "Keine Verbindung zur DB: $@";
        return $self;
}

########################## PRIVATE METHODS ################################
sub _handle{
        my $self = shift;
        # Default Settings
        my %opts = (
                base => undef,         # Name der Datenbank
                user => '',
                pass => '',
                port => 3306,
                host => 'localhost',
                tabn => undef,         # Name der Tabelle
                @_,                    # Parameter
        );
        $self->{TABN} = $opts{tabn} or croak "No Tablename specified";
        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,
                        }
                );
                # sicherheitshalber quote Tabellenname
                $self->{TABN} = $self->{DBH}->quote_identifier($self->{TABN});
        };
        return $@ ? undef : 1;
}
######## Base::DBI ####### PUBLIC METHODS #################################
# Tabelle erstellen
sub create_table{
        my $self = shift;

        # Felder aufarbeiten, quote_identyfier
        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]);
        }
        my $fields = join ",", @fields;

        # Statement
        my $q = qq(
                CREATE TABLE IF NOT EXISTS $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
sub insert{
        my $self = shift;
        my %vals = @_; # hash
        
        # Reihenfolge hier egal aber später beim Einbau genauso wie hier!!!
        my @fields = keys %{$self->{FIELDS}};

        # erzeuge prepared Statement
        if(not defined($self->{STH_INSERT})){
                my @qms = ();
                push @qms, "?" for @fields;
                my $q = "INSERT INTO $self->{TABN} (".join(",", @fields).") VALUES(".join(",", @qms).")";
                $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;
                }
        }
        eval{ $self->{STH_INSERT}->execute(@input) };

        return $@ ? undef : 1;
}
1;#########################################################################

__END__

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

# Objekterstellung
use Base;
my $o = Base::DBI::CGI->new(%myopts);

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

# Es sind noch die Methoden für den DB-Zugriff zu schreiben
# diese Methoden gehören in die package Base::DBI

# insert funktioniert bereits
$o->insert(
        name => 'Rosti',
        vname => 'Rolf',
        type => 'Flaggschiff',
        descr => 'Meine Zeit bei der Marine',
) or die "$@";



# Du kannst einen HTTP-Header erzeugen
# print $o->header('text/html; charset=UTF-8');

# oder die Parameter erfassen
# my $name = $o->param('name');