# $Id: Database.pm,v 1.4 2001/08/29 19:49:28 joern Exp $

package JaM::Database;

use strict;
use Carp;
use Data::Dumper;
use DBI;

sub dbi_source		{ my $s = shift; $s->{dbi_source}
		          = shift if @_; $s->{dbi_source}	}
sub dbi_username	{ my $s = shift; $s->{dbi_username}
		          = shift if @_; $s->{dbi_username}	}
sub dbi_password	{ my $s = shift; $s->{dbi_password}
		          = shift if @_; $s->{dbi_password}	}
sub filename		{ my $s = shift; $s->{filename}
		          = shift if @_; $s->{filename}		}
sub sql_code		{ my $s = shift; $s->{sql_code}
		          = shift if @_; $s->{sql_code}		}
sub database_version	{ my $s = shift; $s->{database_version}
		          = shift if @_; $s->{database_version}	}

sub scramble {
	my $self = shift;
	my ($text) = @_;
	$text =~  tr/n-za-mN-ZA-M0-45-9/a-zA-Z5-90-4/;
	return $text;
}

sub load {
	my $type = shift;

	# read connection configuration from ~/.JaMrc
	my $filename = $ENV{JAMRC};
	$filename ||= "$ENV{HOME}/.JaMrc";

	# if filename does not exist, return default object
	if ( not -f $filename ) {
		return bless {
			dbi_source => 'dbi:mysql:jam',
			dbi_username => '',
			dbi_password => '',
			filename     => $filename,
		}, $type;
	}
	
	# chmod 0600 due to security reasons
	my @stat = stat $filename;
	chmod 0600, $filename if $stat[2] != 0600;
	
	# read config
	my $config;
	eval { $config = do $filename };
	confess "Error reading $filename: $@" if $@;
	
	# return object
	return bless {
		filename     => $filename,
		dbi_source   => $config->{dbi_source},
		dbi_username => $config->{dbi_username},
		dbi_password => $type->scramble($config->{dbi_password})
	}, $type;
}

sub save {
	my $self = shift;
	
	my %config = (
		dbi_source   => $self->{dbi_source},
		dbi_username => $self->{dbi_username},
		dbi_password => $self->scramble($self->{dbi_password})
	);
	
	my $dump = Dumper(\%config);
	$dump =~ s/\$\w+\s*=\s*//;
	
	open (OUT, ">".$self->filename)
		or confess "can't write ".$self->filename;
	print OUT $dump;
	close OUT;

	1;
}

sub test {
	my $self = shift;
	
	my $dbh;
	eval {
		$dbh = DBI->connect (
			$self->dbi_source,
			$self->dbi_username,
			$self->dbi_password,
			{ RaiseError => 1,
			  PrintError => 0, }
		);
	};

	if ( not $dbh or $@ or $DBI::errstr ) {
		my $err = $DBI::errstr if $DBI::errstr;
		$err ||= $@ || "Fatal database error, can't get error message.";
		print "'$err'\n";
		if ( $err =~ /^Unknown database/ ) {
			$err = "Connection: Ok\nDatabase: missing\n";
		}
		return $err;
	}

	eval {
		$dbh->do ("select value from Config where name='foo'");
	};
	my $err = $@;
	
	$dbh->disconnect;

	return "Connection: Ok\nDatabase: Ok\nTables: missing\n" if $err;

	return "Connection: Ok\nDatabase: Ok\nTables: Ok\n";
}

sub connect {
	my $thing = shift;

	my $self;
	if ( ref $thing ) {
		$self = $thing;
	} else {
		$self = $thing->load;
	}

	my $dbh;
	eval {
		$dbh = DBI->connect (
			$self->dbi_source,
			$self->dbi_username,
			$self->dbi_password,
			{ RaiseError => 1,
			  PrintError => 0, }
		);
	};

	return if not $dbh or $@ or $DBI::errstr;
	return $dbh;
}

sub create {
	my $self = shift;

	my $dbi_source = $self->dbi_source;
	if ( $dbi_source !~ /^dbi:mysql:(.*)/ ) {
		return  "Database creation is supported on MySQL only.\n";
			"Please create database by hand and execute\n".
			"just 'Create Tables' here.";
	}

	my $db_name = $1;

	my $dbi_source_wo_db = "dbi:mysql:";
	$self->dbi_source($dbi_source_wo_db);

	my $dbh;
	eval {
		$dbh = $self->connect;
	};
	return  "Can't connect to database.\n".
		"Please test the configuration first!"
			if $@ or not $dbh;

	$self->dbi_source($dbi_source);

	eval {
		$dbh->do (
			"create database $db_name"
		);
	};
	my $err = $@;

	$dbh->disconnect;

	if ( $err ) {
		$err =~ s/at .*line\s+\d+.$//;
		return $err;
	}
	
	return "Database created.\n";
}

sub create_tables {
	my $self = shift;

	my $dbh;
	eval {
		$dbh = $self->connect;
	};
	return  "Can't connect to database.\n".
		"Please test the configuration first!"
			if $@;

	my $error = $self->execute_sql (
		dbh => $dbh,
		section => 'init'
	);

	$self->set_schema_version (
		dbh => $dbh,
		version => $self->init_version
	);

	$dbh->disconnect;
	
	return $error;
}

sub execute_sql {
	my $self = shift;
	my %par = @_;
	my ($dbh, $section) = @par{'dbh','section'};
	
	my $sql_code = $self->get_sql_section (
		section => $section
	);
	
	my $statement = "";
	my $error;
	my $nr = 1;
	my $line;
	while ( $sql_code =~ m!^(.*)$!mg ) {
		$line = $1;
		next if $line =~ /^\s*#/;
		$statement .= $line."\n";
		if ( $statement =~  s/;\s*$// ) {
			if ( $statement !~ /^\s*$/ ) {
				eval {
					$dbh->do ($statement);
				};
				if ( $@ ) {
					$error = $@;
					$error =~ s/at .*line\s+\d+.$/at line $nr/;
					last;
				}
			}
			$statement = "";
		}
		++$nr;
	}
	
	return $error;
}

sub get_sql_section {
	my $self = shift;
	my %par = @_;
	my ($section) = @par{'section'};
	
	my $sql_code = $self->load_sql_code;
	
	$sql_code =~ m!#<$section>#(.*?)#</$section>#!s;
	
	return $1;
}

sub load_sql_code {
	my $self = shift;
	my $sql_code = $self->sql_code;
	return $sql_code if $sql_code;

	my $filename = "lib/JaM/init.sql";
	open (IN, $filename) or confess "can't read $filename";
	$sql_code = join ('',<IN>);
	close IN;
	
	$self->sql_code($sql_code);
	
	return $sql_code;
}

sub init_version {
	my $self = shift;
	return $self->{init_version} if defined $self->{init_version};
	
	my $sql = $self->load_sql_code;

	my $init_version;
	while ( $sql =~ m/#\s*<\s*version\s*(\d+)\s*>\s*#/g ) {
		$init_version = $1;
	}

	$init_version ||= 1;

	$JaM::SCHEMA = $init_version;
	
	return $self->{init_version} = $init_version;
}

sub schema_ok {
	my $self = shift;
	my %par = @_;
	my ($dbh) = @par{'dbh'};

	my $db_version;
	eval {
		($db_version) = $dbh->selectrow_array (
			"select value
			 from	Config
			 where  name='database_schema_version'"
		);
	};
	$db_version = 0 if $@;

	$self->database_version($db_version);
	my $init_version = $self->init_version;

	return $init_version <= $db_version;
}

sub set_schema_version {
	my $self = shift;
	my %par = @_;
	my ($dbh, $version) = @par{'dbh','version'};
	
	$dbh->do (
		"update Config set value=?
		 where name='database_schema_version'", {},
		$version
	);
	
	$self->database_version ($version);

	1;
}

#---------------------------------------------------------------------
# methods for database updates
#---------------------------------------------------------------------

sub db_update_version_4 {
	my $self = shift;
	my %par = @_;
	my ($dbh) = @par{'dbh'};

	require JaM::Filter::IO;
	
	# save all filters to get the folder_id column
	
	my $filters = JaM::Filter::IO->list (
		dbh => $dbh
	);
	
	my $filter;
	foreach my $entry ( @{$filters} ) {
		$filter = JaM::Filter::IO->load (
			dbh => $dbh,
			filter_id => $entry->{id}
		);
		$filter->save;
	}
	
	1;
}

1;
