#!/usr/bin/perl -w

use strict;
use warnings;

use Data::Dumper;
$Data::Dumper::Useqq = 1;

use PlexTree;
use PlexTree::Text;

my ($c, $d, $e);

sub cmpnum($$) {
    my ($expr, $expected) = @_;
    my ($package, $filename, $line) = caller;
    my $r = eval $expr;

    if ($@) {
	print STDERR "$@ in '$expr' at $filename line $line.\n";
    } else {
	print STDERR "$expr = $r != $expected at $filename line $line.\n"
	    if $r != $expected;
    }
}

sub cmpstr($$) {
    my ($expr, $expected) = @_;
    my ($package, $filename, $line) = caller;
    my $r = eval $expr;

    if ($@) {
	print STDERR "$@ in '$expr' at $filename line $line.\n";
    } else {
	print STDERR "$expr = '$r' ne '$expected' at $filename line $line.\n"
	    if $r ne $expected;
    }
}

sub cmpcds($$) {
    my ($a, $b) = @_;
    my ($package, $filename, $line) = caller;
    my $r = $a->cmp($b);

    if ($r) {
	print STDERR
	    $a->print('oneline' => 1) . ($r > 0 ? " > " : " < ") .
	    $b->print('oneline' => 1) .
	    " at $filename line $line.\n";
    }
}

sub hexstring {
    my ($s) = @_;
    $s =~ s/([\x00-\x1f\x7f])/sprintf("\\x%02X", ord($1))/ge;
    print "$s\n";
}

print "Basic PlexTreeString tests ...\n";
cmpnum('ctrl("test")->tag()', 0);
cmpnum('ctrl("test")->tag()', CTRL);
cmpnum('text("test")->tag()', 1);
cmpnum('text("test")->tag()', TEXT);
cmpnum('meta("test")->tag()', 2);
cmpnum('hyper("test")->tag()', 3);
cmpnum('super("test")->tag()', 4);
cmpnum('ultra("test")->tag()', 5);
cmpnum('para("test")->tag()', 6);
cmpnum('trans("test")->tag()', 7);
cmpstr('ctrl("test")->str()', 'test');
cmpstr('meta("test")->str()', 'test');
cmpstr('text("test")->str()', 'test');
cmpstr('text("test")->str(2)', 'st');
cmpstr('text("test")->str(2,1)', 's');
cmpstr('text("test")->str(0)', "test");
cmpstr('text("test")->str(0,1)', "t");
cmpnum('text("test")->len()', 4);
cmpnum('text("")->len()', 0);
cmpnum('tstring(0, "test")->tag()', 0);
cmpnum('tstring(1, "test")->tag()', 1);
cmpnum('tstring(15, "test")->tag()', 15);
cmpstr('tstring(1, "test")->str()', 'test');
cmpstr('tstring(1, "test")->str(0)', "test");
cmpstr('tstring(1, "test")->str(1)', "est");
cmpstr('tstring(1, "test")->str(1,2)', "es");
cmpnum('tstring(1, "test")->len()', 4);
cmpnum('text("test")->listlen()', 0);
cmpnum('text("test")->dirlen()', 0);
cmpstr('text("te\0st")->crfs()', "\x11te\0\xffst");
cmpnum('ctrl("")->isempty()', 1);
cmpnum('ctrl("a")->isempty()', 0);
cmpnum('text("")->isempty()', 0);

# test PlexTreeMem
print "Basic PlexTreeMem tests ...\n";
$c = PlexTree->new;
cmpnum('$c->tag()', 0);
cmpstr('$c->str()', '');
cmpnum('$c->dirlen()', 0);
cmpnum('$c->listlen()', 0);
$c->settag(12);
cmpnum('$c->tag()', 12);
cmpstr('$c->str()', '');
$c->setstr('Hello world!');
cmpnum('$c->tag()', 12);
cmpstr('$c->str()', 'Hello world!');

$c->settag(4);
$c->setstr("trampoline", 0);
cmpnum('$c->tag()', 4);
cmpstr('$c->str()', 'trampoline');
cmpstr('$c->str(0)', "trampoline");
cmpstr('$c->str(1)', "rampoline");
cmpstr('$c->str(6)', "line");
cmpstr('$c->str(6,0)', "");
cmpstr('$c->str(6,2)', "li");
cmpstr('$c->str(6,20)', "line");
$c->setstr("baba", 4, 2);
cmpstr('$c->str(0)', "trambabaline");

print "Construct a PlexTreeMem ...\n";
my $d_txt = 'a(b=c(d), e, <00>, <000100>)';
$d = PlexTree->new;
$d->copyfrom(text('a'));
$d = $d->addkey(text('b'));
$d->copyfrom(text('c'));
$d = $d->append0;
$d->copyfrom(text('d'));
$d = $d->up(2);
$d = $d->append0;
$d->copyfrom(text('e'));
$d = $d->up(1);
$d = $d->append0;
$d->copyfrom(binary("\x00"));
$d = $d->up(1);
$d->append0->copyfrom(binary("\x00\x01\x00"));
$d->top;
my $dd = c($d_txt);
cmpcds($d, $dd);

print "Copy this PlexTreeMem ...\n";
$e = PlexTree->new;
$e->copyfrom_crfs($d->crfs());
cmpcds($d, $e);
$e = PlexTree->new;
$e->copyfrom_crfs($d->crfs());
cmpcds($d, $e);

print "Construct another PlexTreeMem ...\n";
my $c_txt =
    'root(a(b=c(d), e, <00>, <000100>)=(key11=value11, key12=value12), .key2=value2, .key3=.(list1(list11), list2))';
$c->copyfrom(text('root'));
$c = $c->addkey($d);
$c = $c->addkey(text('key11'));
$c->copyfrom(text('value11'));
$c = $c->up;
$c = $c->addkey(text('key12'));
$c->copyfrom(text('value12'));
$c = $c->top;
$c = $c->addkey(ctrl('key2'));
$c->copyfrom(text('value2'));
$c = $c->up;
$c = $c->addkey(ctrl('key3'));
$c = $c->append0;
$c->copyfrom(text('list1'));
$c = $c->append0;
$c->copyfrom(text('list11'));
$c = $c->up;
$c = $c->up;
$c = $c->append0;
$c->copyfrom(text('list2'));

print "Query that PlexTreeMem ...\n";
$c = $c->top;
#c($c_txt)->debug("\$c_txt");
cmpcds($c, c($c_txt));
cmpstr('$c->str(0)', "root");
cmpnum('$c->dirlen()', 3);
cmpnum('$c->listlen()', 0);
$c = $c->cd(ctrl('key3'));
cmpstr('$c->str(0)', "");
cmpnum('$c->dirlen()', 0);
cmpnum('$c->listlen()', 2);
$c = $c->cl(0);
cmpstr('$c->str(0)', "list1");
cmpnum('$c->dirlen()', 0);
cmpnum('$c->listlen()', 1);
$c = $c->cl(0);
cmpstr('$c->str(0)', "list11");
cmpnum('$c->dirlen()', 0);
cmpnum('$c->listlen()', 0);
$c = $c->up;
cmpstr('$c->str(0)', "list1");
cmpnum('$c->dirlen()', 0);
cmpnum('$c->listlen()', 1);
cmpnum('$c->pos()', 0);
$c = $c->next;
cmpstr('$c->str(0)', "list2");
cmpnum('$c->dirlen()', 0);
cmpnum('$c->listlen()', 0);
cmpnum('$c->pos()', 1);

$c = $c->top;
print $c->print('oneline' => 1) . "\n";

my $t = 'a ( b , d , e = f , k1 = a ( b = c,  "test test" ) )';
$c = c($t);
$d = $c->print('oneline' => 1);
$e = c($d);
cmpcds($c, $e);


print "Sorting test ...\n";
$c = c(<<'------');
  .{1<>=., 1<00>=., 1<0000>, 1<000000>, 1<0001>, 1<0100>, 1<01>,
    1<>(1<>), 1<>(1<>, 1<>), 1<>(1<>=1<>),
    a, a(a), a(a(a)), a(a(b)), a(a(a), c), a(a(a)=a, a(a)),
    a(b(a)=a, a(a)), a(a(b)=a, a(a)), a(a(a)=b, a(a)), a(a(a)=a, b(a)),
    a(a(a)=a, a(b)), b(a(a)=a, a(b)) }
------
print $c->print('oneline' => 1) . "\n";
#$c->debug;

my $a = $c->cl(-2 * $c->dirlen);
printf("   %-20s\n", $a->print('oneline' => 1));
for (my $i = -2 * $c->dirlen; $i < -2; $i += 2) {
    my $a = $c->cl($i);
    my $b = $c->cl($i+2);
    my $r = $a->cmp($b);

    printf(" %s %-20s\n",
	   ['<', '=', '>']->[$r+1], $b->print('oneline' => 1));
}

print "Path handling ...\n";
$c = c('a/b/c');
cmpnum('$c->tag', 0);
cmpnum('$c->ispath', 1);
cmpnum('$c->isempty', 0);
$d = PlexTree->new;
$d->copyfrom_crfs($c->crfs);
cmpcds($c, $d);
print Dumper($c->crfs);
cmpnum('$c->cd(ctrl("depth"))->str', 0);
cmpnum('$c->cd("a")->cd(ctrl("depth"))->str', 1);
cmpnum('$c->cd(text("a"))->cd(text("b"))->cd(ctrl("depth"))->str', 2);
cmpnum('$c->cd(text("a"))->cd(ctrl("depth"))->up(2)->cd(ctrl("depth"))->str', 0);
cmpcds($c->cd(text("a"))->key, text("a"));
print "Transcoding transparency ...\n";
my $t256 = '';
for (my $i = 0; $i < 256; $i++) { $t256 .= chr($i); }
my $c256 = PlexTree->new;
for (my $i = 0; $i < 16; $i++) {
    my $n = $c256->addkey(sprintf("t%02d", $i));
    $n->setstr($t256);
    $n->settag($i);
}
cmpcds($c256, c($c256->print));
cmpcds($c256, PlexTree->new->copyfrom_crfs($c256->crfs));

cmpcds(c('a(b=c)'), c('a')->addkey('b', 'c')->top);
cmpcds(c('a(b(c))'), c('a')->append(c('b')->append('c')));
cmpcds(c('a(b, c)'), c('a')->append('b')->append('c'));
cmpcds(c('a(b, c)'), c('a')->append('b', 'c'));
cmpcds(c('a(c, .)'), c('a')->append0->insert('c')->top);
cmpcds(c('a(c, (b=))'), c('a')->append0->insert('c')->addkey('b')->top);
