# 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');