#!/usr/bin/perl
# dbtabrest.pl -- Einspielen von Daten in die Datenbank
#
# Erstellt: 18.11.2004 - Alfred Mickautsch
# Geändert: 30.11.2004 - Alfred Mickautsch - Fehler bei Zeichenumsetztung behoben
# Geändert: 07.09.2004 - Alfred Mickautsch - Datenbankspezifischen Code behandeln
# Geändert: --.--.---- - ----------------- - ------------------------------------

use strict;
use POSIX;
#use DBI;
use DBI qw(:sql_types);
BEGIN
{
	eval 'use DBD::DB2 qw( $attrib_dec $attrib_int $attrib_char $attrib_float $attrib_date $attrib_ts $attrib_binary $attrib_blobfile $attrib_clobfile $attrib_dbclobfile );';
	eval 'use vars qw( $attrib_dec $attrib_int $attrib_char $attrib_float $attrib_date $attrib_ts $attrib_binary $attrib_blobfile $attrib_clobfile $attrib_dbclobfile );' if $@;
	eval 'use DBD::Oracle qw(:ora_types);';
	eval 'sub ORA_VARCHAR2{0;} sub ORA_STRING{0;} sub ORA_NUMBER{0;} sub ORA_LONG{0;} sub ORA_ROWID{0;} sub ORA_DATE{0;} sub ORA_RAW{0;} sub ORA_LONGRAW{0;} sub ORA_CHAR{0;} sub ORA_CHARZ{0;} sub ORA_MLSLABEL{0;} sub ORA_NTY{0;} sub ORA_CLOB{0;} sub ORA_BLOB{0;} sub ORA_RSET{0;}' if $@;
}
use XML::Parser;
use Encode;
use Getopt::Long;

no encoding;

use vars '$CONFIG';

my $VERSION = '1.4';
$CONFIG =
{
	'db' =>
	{
		'savdir'  => 'COE',
		'driver'  => 'DB2',
		'database'  => 'DB2',
		'connect' => 'COE',
		'schema'  => 'COE',
		'user'    => 'coe',
		'pass'    => 'coe',
		'tables'  => [],
		'exclude' => [],
	},
	'xml' =>
	{
		'version'  => '1.0',
		'encoding' => 'ISO-8859-1',
		'standalone' => undef,
	},
	'appl' =>
	{
		'verbose' => 0,
	},
};

my @DATABASES = qw(Oracle DB2 SqlServer);

my $prog;
my %options;

#restore
my $Dbh;
my $Sth;
my @State_stk;
my $Tabname;
my $Fields;
my $Field;
my $Rows;
my $Row;
my $Identity;


main();


sub main
{
	$prog = $0;
	$prog =~ s/^.*\/|^.*\\//g;

	help() if not init_options();

	$CONFIG->{'db'}->{'savdir'} =~ s/\\/\//g;
	$CONFIG->{'db'}->{'savdir'} =~ s/\/$//;

	die "Verzeichnis \"$CONFIG->{'db'}->{'savdir'}\" nicht gefunden: $!\n" if not -e $CONFIG->{'db'}->{'savdir'};

	setlocale(LC_NUMERIC, 'C');

	Restore($CONFIG);
}

sub Restore
{
	my($cfg) = @_;
	my $tables;

	$Dbh = DBI->connect("dbi:$cfg->{'db'}->{'driver'}:$cfg->{'db'}->{'connect'}", $cfg->{'db'}->{'user'}, $cfg->{'db'}->{'pass'}) or
		die "Unable to connect to database '$cfg->{'db'}->{'connect'}: $DBI::errstr\n";

	$Dbh->{'AutoCommit'} = 0;
	$Dbh->{'PrintError'} = 0;
	$Dbh->{'RaiseError'} = 1;

	if($cfg->{'db'}->{'database'} eq 'Oracle')
	{
		my $sql = "alter session set NLS_DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS'";

		my $sth = $Dbh->prepare($sql) or die "DoSave: Error at prepare ($sql): @{[$Dbh->errstr()]}\n";
		my $rv = $sth->execute or die "DoSave: Error at execute ($sql): @{[$Dbh->errstr()]}\n";
		my $rc = $sth->finish;
	}

	# All table names go into array $tables
	$tables = $cfg->{'db'}->{'tables'};
	$tables = remove_excludes($tables, $cfg->{'db'}->{'exclude'});

	DoRestore($cfg, $tables);

	$Dbh->commit();
	$Dbh->disconnect();
}

sub DoRestore
{
	my ($cfg, $tables) = @_;
	my $xmlp;

	$xmlp = new XML::Parser(
		'ErrorContext' => 3,
		'ProtocolEncoding' => $cfg->{'xml'}->{'encoding'},
		'Handlers' => {
			'Start' => \&handle_start,
			'End'   => \&handle_end,
			'Char'  => \&handle_char});

	foreach my $item (@$tables)
	{
		my $savefile;

		$savefile = $cfg->{'db'}->{'savdir'} . "/$item.xml";
		eval
		{
			open(RESTOREFILE,"<$savefile") or die "Unable to open savefile '$savefile' for reading: $!\n";
			binmode(RESTOREFILE);

			$xmlp->parse(*RESTOREFILE);
		};
		print $@ if $@;

		close(RESTOREFILE);
	}
}

sub handle_start
{
	my($expat, $elem, %attr) = @_;

	if($elem =~ 'COEDATA')
	{
		die "data file is corrupt\n" if 0 != @State_stk;

#		setlocale(LC_ALL, $attr{'locale'}) if defined $attr{'locale'};

#print "$elem:\n";
#foreach(keys %attr)
#{
#	print "\t$_='$attr{$_}'\n";
#}
#print "\n";
	}
	elsif($elem eq 'TABLE')
	{
		my $sql;

		die "data file is corrupt\n" if $State_stk[0] !~ 'COEDATA';

		$Tabname = decode_utf8($attr{'name'});
		{
			local $| = 1;
			print "$Tabname: ";
		}

		if($CONFIG->{'db'}->{'database'} =~ /SqlServer/i)
		{
			my $sth;

			$sql  = 'select 1 from sys.columns c, sys.tables t, sys.schemas s where t.object_id = c.object_id and t.schema_id = s.schema_id';
			$sql .= " and s.name = '$CONFIG->{'db'}->{'schema'}' and t.name = '$Tabname' and c.is_identity <> 0";

			$sth = $Dbh->prepare($sql);
			$sth->execute();
			$Identity = $sth->fetchrow_array();

			if($Identity)
			{
				$sql = "set identity_insert $CONFIG->{'db'}->{'schema'}.$Tabname on";
				eval
				{
					$Dbh->do($sql);
				};
				print $@ if $@;
			}
		}

#		eval
#		{
#			$sql = "delete from $CONFIG->{'db'}->{'schema'}.$Tabname";
#print "*****deleting...\n";
#			$Dbh->do($sql);
#		};
#		print $@ if $@;
	}
	elsif($elem eq 'ROWS')
	{
		my $sql;
		my $i;

		$Rows = 0;

#		eval { $Dbh->begin_work(); };
#print $@ if $@;

#		eval
#		{
#			if($cfg->{'db'}->{'database'} =~ /DB2/i)
#			{
#				$sql = "set integrity for $CONFIG->{'db'}->{'schema'}.$Tabname all immediate unchecked";
#			}
#			elsif($cfg->{'db'}->{'database'} =~ /Oracle/i)
#			{
#				$sql = "alter table $CONFIG->{'db'}->{'schema'}.$Tabname disable constraints";
#			}
##print "$sql\n";
#			$Dbh->do($sql);
#
#			$sql = "delete from $CONFIG->{'db'}->{'schema'}.$Tabname";
#print "$sql\n";
#			$Dbh->do($sql);
#
#			$Dbh->commit();
#		};
#		print $@ if $@;
	
		$sql = "insert into $CONFIG->{'db'}->{'schema'}.$Tabname (";
		for($i = 0; $i < @$Fields; $i++)
		{
			$sql .= ', ' if $i > 0;
			$sql .= $Fields->[$i]->{'name'};
		}
		$sql .= ') values (';
		for($i = 0; $i < @$Fields; $i++)
		{
			$sql .= ', ' if $i > 0;
			$sql .= '?';
		}
		$sql .= ')';
#print "$sql\n";
		eval
		{
			$Sth = $Dbh->prepare($sql);
		};
		print $@ if $@;
	}
	elsif($elem eq 'ROW')
	{
		die "data file is corrupt\n" if $State_stk[0] !~ 'ROWS';
		$Row = $attr{'id'};
	}
	elsif($elem eq 'FIELDS')
	{
		die "data file is corrupt\n" if $State_stk[0] !~ 'TABLE';
		$Fields = [];
	}
	elsif($elem eq 'FIELD')
	{
		if($State_stk[0] =~ 'FIELDS')
		{
			my $catalog;
			my $col_sth;
			my $coldesc;

			$attr{'name'} = decode_utf8($attr{'name'});

			$catalog = undef;
			eval
			{
				$col_sth = $Dbh->column_info($catalog, $CONFIG->{'db'}->{'schema'}, $Tabname, $attr{'name'});
				$coldesc = $col_sth->fetchrow_hashref();
				$col_sth->finish();
			};
			print $@ if $@;

			if($coldesc->{'DATA_TYPE'} != $attr{'type'})
			{
				local $| = 1;
				print "\n\t$Tabname: column type mismatch for column \"$attr{'name'}\":\n\t(in savefile: \"$attr{'type_name'}\" <> \"$coldesc->{'TYPE_NAME'}\" in db table)\n";

				if(defined $coldesc->{'DATA_TYPE'})
				{
					$attr{'type'} = $coldesc->{'DATA_TYPE'};
					$attr{'type_name'} = $coldesc->{'TYPE_NAME'};
				}
			}

			push @$Fields, {%attr, 'value' => undef};
		}
		elsif($State_stk[0] =~ 'ROW')
		{
			$Field = undef;
			($Field) = grep { $_->{'id'} eq $attr{'id'} } @$Fields;
			if(defined $Field)
			{
				$Field->{'value'} = '';
				$Field->{'null'} = $attr{'null'};
			}
#foreach(keys %$Field)
#{
#	print "$_ => '$Field->{$_}'\n";
#}
		}
		else
		{
			die "data file is corrupt\n";
		}
	}

	unshift @State_stk, $elem;
}

sub handle_end
{
	my($expat, $elem) = @_;
	my $state;

	$state = shift @State_stk;

	if($elem =~ 'TABLE')
	{
		my $sql;

		if($CONFIG->{'db'}->{'database'} =~ /SqlServer/i)
		{
			if($Identity)
			{
				$sql = "set identity_insert $CONFIG->{'db'}->{'schema'}.$Tabname off";
				eval
				{
					$Dbh->do($sql);
				};
				print $@ if $@;
			}
			$Identity = undef;
		}

		print "$Rows rows\n";
	}
	elsif($elem =~ 'ROWS' and $State_stk[0] =~ 'TABLE')
	{
		eval
		{
			my $sql;

			$Sth->finish();
			$Dbh->commit();

#			if($cfg->{'db'}->{'database'} =~ /DB2/i)
#			{
#				$sql = "set integrity for $cfg->{'db'}->{'schema'}.$Tabname immediate checked full access";
#			}
#			elsif($cfg->{'db'}->{'database'} =~ /Oracle/i)
#			{
#				$sql = "alter table $cfg->{'db'}->{'schema'}.$Tabname enable constraints";
#			}
##print "$sql\n":
#
#			$Dbh->do($sql);
		};
		print $@ if $@;
	}
	elsif($elem =~ 'FIELDS')
	{
#foreach my $field(@$Fields)
#{
#	foreach(keys %$field)
#	{
#		print "$_ => '$field->{$_}'\n";
#	}
#}
	}
	elsif($elem =~ 'ROW' and $State_stk[0] =~ 'ROWS')
	{
		my $i;

		$Rows++;

		if($CONFIG->{'appl'}->{'verbose'})
		{
			local $| = 1;
			my $num = "$Rows";
			print $num, "\b" x length($num);
		}	

		eval
		{
			for($i = 0; $i < @$Fields; $i++)
			{
				my $value;
				my $rc;
#print "$Fields->[$i]->{'name'} = ", ($Fields->[$i]->{'null'} =~ 'yes')? "NULL\n": "'$Fields->[$i]->{'value'}'\n";
				$value = ($Fields->[$i]->{'null'} =~ /yes/i)? undef: decode_utf8($Fields->[$i]->{'value'});

				if($CONFIG->{'db'}->{'database'} =~ /Oracle/i)
				{
					if($Fields->[$i]->{'type'} == -98 or $Fields->[$i]->{'type'} == -4	#BLOB + LONG RAW
					or $Fields->[$i]->{'type'} == -99 or $Fields->[$i]->{'type'} == -1	#CLOB + LONG
					or $Fields->[$i]->{'type'} == 30 or $Fields->[$i]->{'type'} == 40)	#BLOB + CLOB
					{
						my $len;
						my %attrib_lob;

						$attrib_lob{'ora_field'} = $Fields->[$i]->{'name'};

						if(defined $value)
						{
							local $/;

							$value =~ s/(.*)[\\\/](.*)/$2/;

							open(IN, "$CONFIG->{'db'}->{'savdir'}/$value") or die "cannot open file \"$CONFIG->{'db'}->{'savdir'}/$value\" for reading: $!\n";
							binmode(IN);

							$value = <IN>;
							close(IN);
						}
						if($Fields->[$i]->{'type'} == -4)
						{
							$attrib_lob{'ora_type'} = ORA_LONGRAW;
						}
						elsif($Fields->[$i]->{'type'} == -1)
						{
							$attrib_lob{'ora_type'} = ORA_LONG;
						}
						elsif($Fields->[$i]->{'type'} == -98)
						{
							$attrib_lob{'ora_type'} = ORA_BLOB;
						}
						elsif($Fields->[$i]->{'type'} == -99)
						{
							$attrib_lob{'ora_type'} = ORA_CLOB;
						}
						$Sth->bind_param($i+1, $value, \%attrib_lob);
					}
					elsif($Fields->[$i]->{'type'} == 93)	#TIMESTAMP: Oracle 19 Zeichen, DB2 26 Zeichen
					{
						$value =~ s/^(.*)\..*$/$1/;
						$Sth->bind_param($i+1, $value);
					}
					else
					{
						$Sth->bind_param($i+1, $value);
					}
				}
				elsif($CONFIG->{'db'}->{'database'} =~ /DB2/i)
				{
					if($Fields->[$i]->{'type'} == -98 or $Fields->[$i]->{'type'} == -4 or $Fields->[$i]->{'type'} == 30)	#BLOB + LONG RAW
					{
						if(defined $value)
						{
							$value =~ s/(.*)[\\\/](.*)/$2/;
							$value = "$CONFIG->{'db'}->{'savdir'}/$value";
						}
						$Sth->bind_param($i+1, $value, $attrib_blobfile);
					}
					elsif($Fields->[$i]->{'type'} == -99 or $Fields->[$i]->{'type'} == -1 or $Fields->[$i]->{'type'} == 40)	#CLOB + LONG
					{
						if(defined $value)
						{
							$value =~ s/(.*)[\\\/](.*)/$2/;
							$value = "$CONFIG->{'db'}->{'savdir'}/$value";
						}
						$Sth->bind_param($i+1, $value, $attrib_clobfile);
					}
					elsif($Fields->[$i]->{'type'} == 93)
					{
						$Sth->bind_param($i+1, $value, $attrib_ts);
					}
					elsif($Fields->[$i]->{'type'} == -5 || $Fields->[$i]->{'type'} == 5)
					{
						$Sth->bind_param($i+1, $value, $attrib_int);
					}
					elsif($Fields->[$i]->{'type'} == 3)
					{
						$Sth->bind_param($i+1, $value, $attrib_float);
					}
					else
					{
						$Sth->bind_param($i+1, $value, $attrib_char);
					}
				}
				elsif($CONFIG->{'db'}->{'database'} =~ /SqlServer/i)
				{
					if($Fields->[$i]->{'type'} == -98 or $Fields->[$i]->{'type'} == -4	#BLOB + LONG RAW
					or $Fields->[$i]->{'type'} == -99 or $Fields->[$i]->{'type'} == -1	#CLOB + LONG
					or $Fields->[$i]->{'type'} == 30 or $Fields->[$i]->{'type'} == 40	#BLOB + CLOB
					or $Fields->[$i]->{'type'} == -10)	#NTEXT
					{
						my $len;

						if(defined $value)
						{
							local $/;

							$value =~ s/(.*)[\\\/](.*)/$2/;
							open(IN, "$CONFIG->{'db'}->{'savdir'}/$value") or die "cannot open file \"$CONFIG->{'db'}->{'savdir'}/$value\" for reading: $!\n";
							binmode(IN);

							$value = <IN>;
							close(IN);
						}
					}

					if(($Fields->[$i]->{'type'} == SQL_REAL) || ($Fields->[$i]->{'type'} == SQL_FLOAT) || ($Fields->[$i]->{'type'} == SQL_DOUBLE) || ($Fields->[$i]->{'type'} == SQL_NUMERIC) || ($Fields->[$i]->{'type'} == SQL_DECIMAL))
					{
						$Sth->bind_param($i+1, ((defined $value)? 0 + $value: undef));
					}
					else
					{
						$Sth->bind_param($i+1, ((defined $value)? '' . $value: undef));
					}
				}
			}

			$Sth->execute();

		};
		if($@)
		{
			print "\nRow $Row: ";
			print $@;
		}
	}
}

sub handle_char
{
	my($expat, $string) = @_;

	if($State_stk[0] =~ 'FIELD' and $State_stk[1] =~ 'ROW')
	{
		$Field->{'value'} .= $string;
	}
}

sub init_options
{
	Getopt::Long::Configure ("bundling");
	GetOptions(
		\%options,
		'help|h|?' => \&help,
		'version|V' => \&version,
		'verbose|v!',
		'schema|s=s',
		'tabledir|d=s',
		'connect|c=s',
		'user|u=s',
		'pass|p=s',
		'database|D=s',
		'dbdriver|r=s',
		'config|f=s',
		'include|i=s@',
		'exclude|x=s@',
		'infile|I=s',
		'exfile|X=s');

	read_options_from_file($options{'config'}) if defined $options{'config'};

	read_tables_from_file($CONFIG->{'db'}->{'tables'}, $options{'infile'}) if defined $options{'infile'};
	read_tables_from_file($CONFIG->{'db'}->{'exclude'}, $options{'exfile'}) if defined $options{'exfile'};

	push(@{$CONFIG->{'db'}->{'tables'}}, @{$options{'include'}}) if defined $options{'include'};
	push(@{$CONFIG->{'db'}->{'exclude'}}, @{$options{'exclude'}}) if defined $options{'exclude'};

	$CONFIG->{'db'}->{'savdir'} = $options{'tabledir'} if defined $options{'tabledir'};
	$CONFIG->{'db'}->{'driver'} = $options{'dbdriver'} if defined $options{'dbdriver'};
	$CONFIG->{'db'}->{'database'} = $options{'database'} if defined $options{'database'};
	$CONFIG->{'db'}->{'database'} = $options{'dbdriver'} if !defined $CONFIG->{'db'}->{'database'};

	if(!grep /$CONFIG->{'db'}->{'database'}/i, @DATABASES)
	{
		print "Database \"$CONFIG->{'db'}->{'database'}\" not supported\n";
		return 0;
	}
	$CONFIG->{'db'}->{'connect'} = $options{'connect'} if defined $options{'connect'};
	$CONFIG->{'db'}->{'schema'} = $options{'schema'} if defined $options{'schema'};
	$CONFIG->{'db'}->{'user'} = $options{'user'} if defined $options{'user'};
	$CONFIG->{'db'}->{'pass'} = $options{'pass'} if defined $options{'pass'};
	$CONFIG->{'appl'}->{'verbose'} = $options{'verbose'} if defined $options{'verbose'};

	if($CONFIG->{'appl'}->{'verbose'})
	{
		local $| = 1;

		foreach my $key (keys %$CONFIG)
		{
			print "$key:\n";
			foreach(keys %{$CONFIG->{$key}})
			{
				print "\t$_";
				if(ref $CONFIG->{$key}->{$_})
				{
					print " = ARRAY\n";
					foreach my $item (@{$CONFIG->{$key}->{$_}})
					{
						print "\t\t$item\n";
					}
				}
				else
				{
					print " = \"$CONFIG->{$key}->{$_}\"\n";
				}
			}
		}
	}
	return scalar keys %options;
}

sub read_options_from_file
{
	my($cfgfile) = @_;
	my $return;

	unless($return = do $cfgfile)
	{
		warn "$0: read_options_from_file: couldn't parse '$cfgfile': $@" if $@;
		warn "$0: read_options_from_file: couldn't do '$cfgfile': $!"    unless defined $return;
		warn "$0: read_options_from_file: couldn't run '$cfgfile'"       unless $return;
		die "$0: can't continue\n";
	}

	# Fehlende Parameter in $CONFIG eintragen
#	foreach(keys %$config)
#	{
#		$cfg->{$_} = $config->{$_} if !defined $cfg->{$_};
#	}
}

sub read_tables_from_file
{
	my($tables, $file) = @_;

	open(IN, "<$file") or die "Fehler beim Öffnen der Datei \"$file\" zum Lesen: $!n"; 

	@$tables = <IN>;
	chomp(@$tables);

	close(IN);

	return scalar @$tables;
}

sub remove_excludes
{
	my($tables, $exclude) = @_;
	my %seen;
	my @diff;

	@seen{@$exclude} = ();

	foreach my $item (@$tables)
	{
		push(@diff, $item) unless exists $seen{$item};
	}

	return \@diff;
}

#misc
sub help
{
	print "Usage: $prog <Options>\n";
	print "<Options> =\n";
	print "\t--database=DATABASE, -D DATABASE:\tDatabase (Oracle, DB2, SqlServer)\n";
	print "\t--dbdriver=DATABASEDRIVER, -r DATABASEDRIVER:\tDBI database driver (Oracle, DB2, ADO, ODBC)\n";
	print "\t--connect=DBALIAS, -c DBALIAS:\tDatabase alias\n";
	print "\t--schema=SCHEMA, -s SCHEMA:\tDatabase schema\n";
	print "\t--user=USER, -u USER:\tUser\n";
	print "\t--pass=PASSWORD, -p PASSWORD:\tPassword\n";
	print "\t--tabledir=DIR, -d DIR:\tSave directory\n";
	print "\t--config=FILE,-f FILE:\tRead configuration from FILE\n";
	print "\t--include=NAME, -i NAME:\tTable name\n";
	print "\t--exclude=NAME, -x NAME:\tName of excluded table\n";
	print "\t--infile=FILE, -I FILE:\tRead list of tables from FILE\n";
	print "\t--exfile=FILE, -X FILE:\tRead list of tables to be excluded from FILE\n";
	print "\t--help, -h, -?:\tThis help\n";
	print "\t--version, -V:\tPrint version info\n";
	print "\t--verbose, -v:\tMore output\n";
	exit(0);
}

sub version
{
	print "$prog V$VERSION -- (c) 2004 schuler business solutions AG\n";
}