#!/usr/bin/perl
# dbtabsave.pl -- Sichern von Daten aus der Datenbank
#
# Erstellt: 18.11.2004 - Alfred Mickautsch
# Geändert: 30.11.2004 - Alfred Mickautsch - Kopfinformation angepaßt und Fehlerbehebung
# Geändert: 07.09.2004 - Alfred Mickautsch - Datenbankspezifischen Code entfernt
# Geändert: --.--.---- - ----------------- - ------------------------------------
#
# Aufrufbeispiele:
# 1. SQL Server mit ODBC
# dbtabsave.pl -D SqlServer -r ODBC -c "Driver={SQL Server};Server=sponde;Database=C033_DEV1" -s dbo -u sa -p sa -d test_sqlserver -i T065_RULE
# 2. SQL Server mit ADO über ODBC
# dbtabsave.pl -D SqlServer -r ADO -c "Provider=MSDASQL;Driver={SQL Server};Server=sponde;Database=C033_DEV1" -s dbo -u sa -p sa -d C028_DEV -i T065_RULE
# dbtabsave.pl -D SqlServer -r ODBC -c "Driver={SQL Server};Server=sponde;Database=C033_DEV1" -s dbo -u sa -p sa -d test_sqlserver -i T065_RULE
# 3. SQL Server mit ADO
# dbtabsave.pl -D SqlServer -r ADO -c "Provider=SQLOLEDB;Data Source=sponde;Initial Catalog=C033_DEV1" -s dbo -u sa -p sa -d C028_DEV -i T065_RULE
# 4. DB2
# dbtabsave.pl -D DB2 -r DB2 -c coe -s INSTCOEP -u coe -p coe -d C028_DEV -i T065_RULE
# 5. Oracle
# dbtabsave.pl -D Oracle -r Oracle -c coe -s C028_DEV -u coe -p coe -d C028_DEV -i T065_RULE

use strict;
use POSIX;
use DBI;
use Getopt::Long;
use IO::File;
use XML::Writer;
use Encode;

use vars '$CONFIG';

my $VERSION = '1.4';
$CONFIG =
{
	'db' =>
	{
		'savdir'  => 'COE',
		'driver'  => 'DB2',
		'database'  => 'DB2',
		'connect' => 'COE',
		'schema'  => 'COE',
		'user'    => 'coe',
		'pass'    => 'coe',
#		'loblen'  => 10000000,
		'loblen'  => 100000,
		'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;


main();


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

	help() if not init_options();

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

	mkdirhier($CONFIG->{'db'}->{'savdir'}) unless -d $CONFIG->{'db'}->{'savdir'};

	setlocale(LC_NUMERIC, 'C');

	Save($CONFIG);
}

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

	my $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->{'LongReadLen'} = $cfg->{'db'}->{'loblen'};
	$dbh->{'LongTruncOk'} = 1;
	$dbh->{'PrintError'} = 1;
	$dbh->{'RaiseError'} = 1;
	if($cfg->{'db'}->{'database'} =~ /Oracle/i)
	{
		my $sql = 'alter session set NLS_DATE_FORMAT = \'YYYY-MM-DD HH24:MI:SS\'';

		eval
		{
			my $rc;

			$rc = $dbh->do($sql);
		};
		print $@ if $@;

		$sql = 'alter session set NLS_NUMERIC_CHARACTERS = ".,"';

		eval
		{
			my $rc;

			$rc = $dbh->do($sql);
		};
		print $@ if $@;
	}


	# All table names go into array $tables
	$tables = $cfg->{'db'}->{'tables'};
	$tables = GetTableNamesFromDB($cfg, $dbh) if @$tables == 0;

	$tables = remove_excludes($tables, $cfg->{'db'}->{'exclude'});

	DoSave($cfg, $dbh, $cfg->{'db'}->{'schema'}, $tables);

	$dbh->rollback();
	$dbh->disconnect();
}

sub GetTableNamesFromDB
{
	my ($cfg, $dbh) = @_;
	my $sql;
	my $rows;
	my $tables;

	if($cfg->{'db'}->{'database'} =~ /Oracle/i)
	{
		$sql = "select TABLE_NAME from ALL_TABLES where OWNER = UPPER('$cfg->{'db'}->{'schema'}') order by 1";
	}
	elsif($cfg->{'db'}->{'database'} =~ /DB2/i)
	{
		$sql = "select TABNAME from SYSCAT.TABLES where TABSCHEMA = UPPER('$cfg->{'db'}->{'schema'}') order by 1";
	}
	elsif($cfg->{'db'}->{'database'} =~ /SqlServer/i)
	{
		$sql = "select a.name from sysobjects a, sysusers b where a.xtype = 'U' and b.name = 'dbo' and a.uid = b.uid order by 1";
	}

	eval
	{
		my $sth = $dbh->prepare($sql);
		my $rv = $sth->execute();
	
#       DBI::dump_results($sth);
	
		# All table names go into array $tables
		$rows = $sth->fetchall_arrayref();

		my $rc = $sth->finish();
	};
	print $@ if $@;

	foreach my $item (@$rows)
	{
		push @$tables, $item->[0];
	}

	return $tables;
}

sub DoSave
{
	my ($cfg, $dbh, $schema, $tables) = @_;
	my $tabfile;
	my $table;
	my $table_utf8;

	$tabfile = $cfg->{'db'}->{'savdir'} . "/tables.txt";
	open(TABFILE, ">$tabfile")  or die "Fehler beim Öffnen der Datei '$tabfile' im Schreib-Modus: $!\n";
	binmode(TABFILE);
	
	foreach $table (@$tables)
	{
		my $coeversion_utf8;
		my $driver_utf8;
		my $db_utf8;
		my $schema_utf8;
		my $user_utf8;
		my $rows;
		my $savefile;
		my $writer;
		my $fh;
		my $timestamp;
		my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();

		{
			local $| = 1;
			print "$table: ";
		}

		$table_utf8 = encode_utf8($table);

		print TABFILE "$table\n";

		$savefile = $cfg->{'db'}->{'savdir'} . "/$table.xml";
		$fh = new IO::File;
		if(!$fh->open("> $savefile"))
		{
			die "Fehler beim Öffnen der Datei '$savefile' im Schreib-Modus: $!\n";
    }
		binmode($fh);

		$writer = new XML::Writer(OUTPUT => $fh, DATA_MODE => 1, DATA_INDENT => 2);
		$writer->xmlDecl('UTF-8', $cfg->{'xml'}->{'standalone'});

		$coeversion_utf8 = encode_utf8($VERSION);
		$driver_utf8 = encode_utf8($cfg->{'db'}->{'driver'});
		$db_utf8 = encode_utf8($cfg->{'db'}->{'connect'});
		$schema_utf8 = encode_utf8($cfg->{'db'}->{'schema'});
		$user_utf8 = encode_utf8($cfg->{'db'}->{'user'});

		$year += 1900;
		$mon += 1;
		$hour += $isdst;
		$timestamp = sprintf("%04d-%02d-%02d %02d:%02d:%02d",$year,$mon,$mday,$hour,$min,$sec);

		$writer->startTag('COEDATA',
			'version' => $cfg->{'xml'}->{'version'},
			'dbms' => $driver_utf8,
			'database' => $db_utf8,
			'schema' => $schema_utf8,
			'user' => $user_utf8,
			'date' => $timestamp);

		$writer->comment("\n##############################\n# VERSION: $coeversion_utf8\n# DBMS:    $driver_utf8\n# DB:      $db_utf8\n# SCHEMA:  $schema_utf8\n# USER:    $user_utf8\n# DATE:    $timestamp\n##############################\n");

		$writer->startTag("TABLE", "name" => $table_utf8);

		$rows = SaveRowsFromDB($cfg, $dbh, $writer, $schema, $table);

		$writer->endTag('TABLE');
		$writer->endTag('COEDATA');
		$writer->end();
		$fh->close();

		print "$rows rows\n";
	}

	close(TABFILE);
	print "OK\n";
}

sub SaveRowsFromDB
{
	my ($cfg, $dbh, $writer, $schema, $table) = @_;
	my $i;

	my $table_utf8;
	my $col_utf8;
	my $row;
	my $sql;
	my $sth;
	my $rc;
	my $cols;
	my $types;
	my $count;

	$count = 0;

	$sql = "select * from $schema.$table";
	eval
	{
		$sth = $dbh->prepare($sql);
		$rc = $sth->execute();
	};
	print $@ if $@;

	$cols = $sth->{NAME};
	$types = $sth->{TYPE};

	$writer->startTag('FIELDS');
	for($i = 0;$i < @$cols;$i++)
	{
		$col_utf8 = encode_utf8($cols->[$i]);
		eval
		{
			my $tinfo;
			my $catalog;
			my $col_sth;
			my $coldesc;

			$tinfo = $dbh->type_info($types->[$i]);

			$catalog = undef;
			$col_sth = $dbh->column_info($catalog, $schema, $table, $cols->[$i]);
			$coldesc = $col_sth->fetchrow_hashref();
			$col_sth->finish();

			$writer->emptyTag('FIELD',
				'id' => $i,
				'name' => $col_utf8,
				'type' => $types->[$i],
				'type_name' => $tinfo->{'TYPE_NAME'},
				'sql_type' => $tinfo->{'SQL_DATA_TYPE'},
				'length' => $coldesc->{'COLUMN_SIZE'},
				'precision' => $coldesc->{'DECIMAL_DIGITS'},
				'nullable' => $coldesc->{'IS_NULLABLE'});
		};
		print $@ if $@;
	}
	$writer->endTag('FIELDS');

	$writer->startTag('ROWS');

	eval
	{
		my $val_utf8;

		while($row = $sth->fetchrow_arrayref())
		{
			last if $row == undef;

			$writer->startTag('ROW', 'id' => $count);
			$count++;

			if($cfg->{'appl'}->{'verbose'})
			{
				my $num = "$count";
				print STDERR $num, "\b" x length($num);
			}	

			for($i = 0; $i < @$row; $i++)
			{
				$writer->startTag('FIELD', 'id' => $i, 'null' => (defined $row->[$i])? 'no': 'yes');

				if(defined $row->[$i])
				{
					if(($types->[$i] == -98)
					    or ($types->[$i] == -99)
					    or ($types->[$i] == -1)
					    or ($types->[$i] == -4)
					    or ($types->[$i] == 30)
					    or ($types->[$i] == 40))
					{
						my $file;

						$file = $cfg->{'db'}->{'savdir'} . "/$table\_$i\_$count.lob";
						open(LOBOUT, ">$file") or die "error at open \"$file\" for writing: $!\n";
						binmode LOBOUT;
						print LOBOUT $row->[$i];
						close LOBOUT;
						$row->[$i] = "$table\_$i\_$count.lob";
					}

#					$row->[$i] =~ s/\&/\&amp;/g;
#					$row->[$i] =~ s/</\&lt;/g;
#					$row->[$i] =~ s/>/\&gt;/g;
#					$row->[$i] =~ s/,/\./ if ($types->[$i] == 3) or ($types->[$i] == 2);

					$val_utf8 = encode_utf8($row->[$i]);
					$writer->characters($val_utf8);
				}
				$writer->endTag('FIELD');
			}
			$writer->endTag('ROW');
		}
		$rc = $sth->finish;
	};
	print $@ if $@;
	$writer->endTag('ROWS');

	return $count;
}

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',
		'maxloblen|m=i');

	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->{'db'}->{'loblen'} = $options{'maxloblen'} if defined $options{'maxloblen'};
	$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 ":\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;
}

sub mkdirhier
{
	my($directory, $mode) = @_;
    my @dirs;
    my $path;
    my $result;

	$directory =~ s/\\/\//g;
	@dirs = split(/\//, $directory);
	$path = shift(@dirs);   # build it as we go
	$result = 1;   # assume it will work

	$result &&= mkdir($path, $mode) unless -d $path;

	foreach(@dirs)
	{
		$path .= "/$_";

		if(! -d $path)
		{
			$result &&= mkdir($path, $mode);
		}
	}

	return $result;
}

#misc
sub help
{
	print "Aufruf: $prog <Optionen>\n";
	print "<Optionen> =\n";
	print "\t--database=DATENBANK, -D DATENBANK:\tDatenbank (Oracle, DB2, SqlServer)\n";
	print "\t--dbdriver=DATENBANKTREIBER, -r DATENBANKTREIBER:\tDBI Datenbanktreiber (Oracle, DB2, ADO, ODBC)\n";
	print "\t--connect=DBALIAS, -c DBALIAS:\tDatenbankalias\n";
	print "\t--schema=SCHEMA, -s SCHEMA:\tDatenabnkschema\n";
	print "\t--user=BENUTZER, -u BENUTZER:\tBenutzer\n";
	print "\t--pass=PASSWORT, -p PASSWORT:\tPasswort\n";
	print "\t--maxloblen=ZAHL, -m ZAHL:\tMaximale Größe eines LOBs\n";
	print "\t--tabledir=VERZEICHNIS, -d VERZEICHNIS:\Sicherungsverzeichnis\n";
	print "\t--config=DATEI,-f DATEI:\tKonfiguration aus Datei DATEI lesen\n";
	print "\t--include=NAME, -i NAME:\tName der Tabelle\n";
	print "\t--exclude=NAME, -x NAME:\tTabelle, die nicht gesichert werden soll\n";
	print "\t--infile=DATEI, -I DATEI:\tListe der Tabellen aus DATEI lesen\n";
	print "\t--exfile=DATEI, -X DATEI:\tListe der Tabellen, die nicht gesichert werden sollen\n";
	print "\t--help, -h, -?:\tdiese Hilfe\n";
	print "\t--version, -V:\tVersionsinfo ausgeben\n";
	print "\t--verbose, -v:\tMehr Daten ausgeben\n";
	exit(0);
}

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