#!/usr/bin/perl
use utf8;
use strict;
use warnings;

BEGIN { unshift(@INC,($ENV{'POPHOME'}||'@POPHOME@').'/lib')
            unless $ENV{'KUNDE_NO_PERLPATH'};
	  }

use Test::More tests => 70; $|=1;
use utf8;

use Dbase::Test;
use Encode;
use Umlaut;
use UTFkram qw(is_utf8 is_ascii is_latin decode_anything safe_encode_utf8);
use Dbase::Help qw(quote qquote Do DoFn DoSelect);

warn "\n# Ab hier: 'wide character'-Warnungen bitte ignorieren. Geht nicht anders.\n";

#print OUT "## Unicode: ${^UNICODE}\n";
my $bla;
my $LEN;
my $LEN2;
{
	use utf8;
	$bla = "äöüß€";
	$LEN = 5;
	$LEN2 = 11; # äöüß sind zwei Bytes lang wenn UTF8, € drei
}

my $lab = Encode::encode("iso-8859-15",$bla);

ok(Encode::is_utf8($bla),"BLA ist UTF8-String");
is(length($bla),$LEN, "$LEN Zeichen (Umlaute): $bla");
ok(! Encode::is_utf8($lab),"LAB ist kein UTF8-String");
is(length($lab),$LEN, "$LEN Zeichen (Latin1): $lab");

my $blax = Encode::decode("iso-8859-15",$lab);
ok(Encode::is_utf8($bla),"BLAx ist UTF8-String");
is(length($blax),$LEN, "$LEN Zeichen (Umlaute): $blax");

my $altx = Encode::encode("utf8",$bla);
ok(! Encode::is_utf8($altx), "ALTX ist kein UTF8-String");
is(length($altx),$LEN2, "$LEN2 Zeichen (UTF8-Unfug): $altx");

my $alt = $bla; # Encode::encode("utf8",$bla);
Encode::_utf8_off($alt);

ok(! Encode::is_utf8($alt), "ALT ist kein UTF8-String");
is(length($alt),$LEN2, "$LEN2 Zeichen (UTF8-Unfug): $alt");

is($bla,$blax, "dasselbe 1: $bla $blax");
TODO:{
	local $TODO = 1;
	is($bla,$lab, "dasselbe 2: $bla $lab");
}
print "# Umlaute: "; print $bla; print "\n";
#print "# UTF8-Unfug: "; print $alt; print "\n";
## das da oben auszugeben resultiert in einem Fehler!

print "# So, und jetzt dasselbe mit internen Funktionen\n";

ok(! is_utf8($bla), "BLA ist nicht sichtbar UTF8-kodiert");
ok(! is_utf8($blax), "BLAx ist nicht sichtbar UTF8-kodiert");
ok(! is_utf8($lab), "LAB ist nicht sichtbar UTF8-kodiert");
ok(is_utf8($alt), "ALT ist sichtbar UTF8-kodiert");
ok(is_utf8($altx), "ALTx ist sichtbar UTF8-kodiert");

ok(is_latin($bla), "BLA ist sichtbar Unicode");
ok(is_latin($blax), "BLAx ist sichtbar Unicode");
ok(is_latin($lab), "LAB ist sichtbar Unicode");
ok(! is_latin($alt), "ALT ist nicht sichtbar Unicode");
ok(! is_latin($altx), "ALTx ist nicht sichtbar Unicode");

ok(is_latin(decode_anything($bla,1)), "BLA konvertiert zu unicode");
ok(is_latin(decode_anything($blax,1)), "BLAx konvertiert zu unicode");
ok(is_latin(decode_anything $lab), "LAB konvertiert zu unicode");
ok(is_latin(decode_anything $alt), "ALT konvertiert zu unicode");
ok(is_latin(decode_anything $altx), "ALTx konvertiert zu unicode");

ok(! is_utf8(decode_anything $bla), "BLA konvertiert zu unicode");
ok(! is_utf8(decode_anything $blax), "BLAx konvertiert zu unicode");
ok(! is_utf8(decode_anything $lab), "LAB konvertiert zu unicode");
ok(! is_utf8(decode_anything $alt), "ALT konvertiert zu unicode");
ok(! is_utf8(decode_anything $altx), "ALTx konvertiert zu unicode");

ok(is_utf8(safe_encode_utf8 $bla), "BLA konvertiert zu utf8");
ok(is_utf8(safe_encode_utf8 $blax), "BLAx konvertiert zu utf8");
ok(is_utf8(safe_encode_utf8 $lab), "LAB konvertiert zu utf8");
ok(is_utf8(safe_encode_utf8 $alt), "ALT konvertiert zu utf8");
ok(is_utf8(safe_encode_utf8 $altx), "ALTx konvertiert zu utf8");

ok(! is_latin(safe_encode_utf8 $bla), "BLA konvertiert zu utf8");
ok(! is_latin(safe_encode_utf8 $blax), "BLAx konvertiert zu utf8");
ok(! is_latin(safe_encode_utf8 $lab), "LAB konvertiert zu utf8");
ok(! is_latin(safe_encode_utf8 $alt), "ALT konvertiert zu utf8");
ok(! is_latin(safe_encode_utf8 $altx), "ALTx konvertiert zu utf8");

print "# Datenbanktests\n";

DoSelect { print "# @_\n";} "show variables like '%char%'";

is(qquote($bla),"'$bla'", "QQuote BLA");
is(qquote($alt),"'$bla'", "QQuote BLA");
is(quote($bla),$bla, "Quote BLA");
is(quote($alt),$bla, "Quote BLA");

okF "drop table if exists test_umlaut";
okF "create table test_umlaut (u varchar($LEN2) character set utf8)";

okF "insert into test_umlaut set u=${\qquote $bla}";
is(DoFn("select u from test_umlaut"),$bla,"Text mit Umlauten in der DB");
is(DoFn("select length(u) from test_umlaut"),$LEN2,"Text mit Umlauten in der DB (Laenge)");
ok(is_latin(DoFn("select u from test_umlaut")),"aus der DB kommt Unicode 1");
ok(Encode::is_utf8(DoFn("select u from test_umlaut")),"aus der DB kommt Unicode 2"); 

okF "drop table if exists test_umlaut";

okF "create table test_umlaut (u varchar($LEN2) character set latin1)";
okF "insert into test_umlaut set u=${\qquote $bla}";
is(DoFn("select u from test_umlaut"),$bla,"Text mit Umlauten in der DB");
is(DoFn("select length(u) from test_umlaut"),$LEN,"Text mit Umlauten in der DB (Laenge)");
ok(is_latin(DoFn("select u from test_umlaut")),"aus der DB kommt Unicode 1");
ok(Encode::is_utf8(DoFn("select u from test_umlaut")),"aus der DB kommt Unicode 2"); 
## Ja, das geht, obwohl's ein Euro ist. Das ist keine Absicht.

okF "drop table if exists test_umlaut";

print "# Das ist ein Umlaut: ",decode_anything safe_encode_utf8 $bla,"\n";
print "# Das ist ein Umlaut: ",decode_anything decode_anything $bla,"\n";
print "###\n\n";

print "### Teste das Kodieren abgeschnittener utf8-Strings\n";
{
	sub bdump($$$) {
		use bytes;
		my($p,$x,$c) = @_;
		Encode::_utf8_off($x);
		$x =~ s/^a*//;
		print "# $p:";
		foreach my $i(split(//,$x)) {
			printf " %03o",ord($i);
		}
		print "\n";
		print "# = :";
		foreach my $i(split(//,$c)) {
			printf " %03o",ord($i);
		}
		print "\n";
		is($x,$c,"Vergleich $p");
	}
	use warnings FATAL => qw(all);
	my $aaa = "a"x1000;
	my $str = $aaa."Straße";
	my($str1,$str2);

	Encode::_utf8_off($str);
	$str1 = substr($str,0,1005);
	$str2 = substr($str,1005);
	Encode::_utf8_on($str1);
	Encode::_utf8_on($str2);

	{ no utf8; bdump("s1",$str1,"\123\164\162\141\303"); }
	my $strx = Encode::Latinize::encode(undef,$str1,258);
	$str = $strx;
	{ no utf8; bdump("x1",$strx,"\123\164\162\141"); }
	{ no utf8; bdump("s1",$str1,"\303"); }
	$str2 = $str1.$str2;
	{ no utf8; bdump("s2",$str2,"\303\237\145"); }
	$strx = Encode::Latinize::encode(undef,$str2,258);
	$str .= $strx;
	{ no utf8; bdump("x2",$strx,"\337\145"); }
	{ no utf8; bdump("s2",$str2,""); }
	{ use bytes;
	  $str =~ s/^a+//;
	  print "#- $str -#\n";
	}
}

warn "\n# Ab hier sollten keine 'wide character'-Warnungen mehr folgen.\n";
#print "# Das ist ein Umlaut: ",safe_encode_utf8 decode_anything $bla,"\n";
#^-- diese Zeile triggert einen Fehler!

ok(! -f "/tmp/log_$<", "No log file yet");

Db::log_trace();

if(open(LOG,"<","/tmp/log_$<")) {
	pass("log file opened");
	my $log = "";
	while(<LOG>) {
		print "# $_";
		$log .= $_;
	}
	close(LOG);
	like($log,qr/Db::log_trace.. called/,"Stack dump worked");
	unlink "/tmp/log_$<";
} else {
	fail("Log file not opened");
}

