########################################
# 020.chain -- translate. chain schema. 'staggered' & 'binary' data
# OBSOLETE (030.tree covers this case) but still used.
########################################
use t::lib;
use t::utilBabel;
use Carp;
use Test::More;
use Test::Deep;
use File::Spec;
use Text::Abbrev;
use Class::AutoDB;
use Data::Babel;
use Data::Babel::Config;
use strict;
my($db_type,$num_maptables)=@ARGV;
my %db_type=abbrev qw(staggered binary);
$db_type=$db_type{$db_type} || ' ';
defined $num_maptables or $num_maptables=6;
my $last_maptable=$num_maptables-1;
my $num_links=$num_maptables-1;
my $last_link=$num_links-1;
# create AutoDB database
my $autodb=new Class::AutoDB(database=>'test',create=>1);
isa_ok($autodb,'Class::AutoDB','sanity test - $autodb');
Data::Babel->autodb($autodb);
my $dbh=$autodb->dbh;
# make component objects and Babel
#
# 'link' IdTypes connect MapTables. link type $i_$j connects tables $i, $j ($j=$i+1)
# 'leaf' IdTypes are private to each MapTable
#
# MapTable 0 contains link IdType 0_1, leaf IdType 0
# MapTable $i (0<$i<$last_maptable) contains link IdTypes $i-1_$i, $i_$i+1, leaf $i
# MapTable $last_maptable contains link IdType $i-1_$i, leaf $i
# make explicit Masters for even-numbered leafs
#
my $sql_type='VARCHAR(255)';
my(@idtypes,@masters,@maptables);
for (0..$last_maptable) { # make leaf IdTypes & Masters
my $idtype_name='leaf_'.sprintf('%03d',$_);
push(@idtypes,new Data::Babel::IdType(name=>$idtype_name,sql_type=>$sql_type));
push(@masters,new Data::Babel::Master(name=>$idtype_name.'_master')) unless $_%2;
}
for (0..$last_link) { # make link IdTypes
my($i,$j)=(sprintf('%03d',$_),sprintf('%03d',$_+1));
my $idtype_name="link_${i}_${j}";
push(@idtypes,new Data::Babel::IdType(name=>$idtype_name,sql_type=>$sql_type));
}
# make 1st and last MapTables - special cases
my($i,$j)=(sprintf('%03d',0),sprintf('%03d',1));
my $maptable_name="maptable_$i";
push(@maptables,new Data::Babel::MapTable(name=>$maptable_name,idtypes=>"leaf_$i link_${i}_${j}"));
my($i,$j)=(sprintf('%03d',$last_maptable-1),sprintf('%03d',$last_maptable));
my $maptable_name="maptable_$j";
push(@maptables,new Data::Babel::MapTable(name=>$maptable_name,idtypes=>"link_${i}_${j} leaf_$j"));
for (1..$last_maptable-1) { # make regular MapTables
my($i,$j,$k)=(sprintf('%03d',$_-1),sprintf('%03d',$_),sprintf('%03d',$_+1));
my $maptable_name='maptable_'.sprintf('%03d',$_);
push(@maptables,new Data::Babel::MapTable(name=>$maptable_name,
idtypes=>"link_${i}_${j} leaf_$j link_${j}_${k}"))
}
my $babel=new Data::Babel
(name=>'test',idtypes=>\@idtypes,masters=>\@masters,maptables=>\@maptables);
isa_ok($babel,'Data::Babel','sanity test - $babel');
my @errstrs=$babel->check_schema;
ok(!@errstrs,'sanity test - check_schema');
diag(join("\n",@errstrs)) if @errstrs;
# $babel->show;
# setup the database
#
for (0..$last_maptable) {
my $maptable_name='maptable_'.sprintf('%03d',$_);
my $data=maptable_data($_);
load_maptable($babel,$maptable_name,$data);
}
for my $master (@{$babel->masters}) {
my $master_name=$master->name;
my $data=($master->explicit)? master_data($master): undef;
load_master($babel,$master_name,$data);
}
load_ur($babel,'ur');
# run the queries.
#
my @idtypes=@{$babel->idtypes};
my @leafs=grep {$_->name=~/^leaf/} @idtypes;
my @links=grep {$_->name=~/^link/} @idtypes;
@idtypes=(@leafs,@links);
# iterate over all idtypes
for my $input_idtype (@idtypes) {
my $ok=1;
$ok&=doit($input_idtype,[],__FILE__,__LINE__); # no outputs
$ok&=doit($input_idtype,[@idtypes[0..$#idtypes]],__FILE__,__LINE__); # all
$ok&=doit($input_idtype,[@leafs[0,int($#leafs/2),$#leafs]],__FILE__,__LINE__); # triple leafs
$ok&=doit($input_idtype,[@links[0,int($#links/2),$#links]],__FILE__,__LINE__); # triple links
$ok&=doit($input_idtype,[@leafs[1,int($#leafs/2)+1],@links[0,$#links]],__FILE__,__LINE__);
# mixed quad
for my $j0 (0..$#idtypes-1) {
$ok&=doit($input_idtype,[@idtypes[$j0]],__FILE__,__LINE__); # single
for my $j1 ($j0+1..$#idtypes) {
$ok&=doit($input_idtype,[@idtypes[$j0,$j1]],__FILE__,__LINE__); # pair
}}
report_pass($ok,"$db_type: input=".$input_idtype->name);
}
cleanup_ur($babel); # clean up intermediate files
done_testing();
# args are idtypes
sub doit {
my($input_idtype,$output_idtypes,$file,$line)=@_;
my $input_ids=idtype2ids($input_idtype);
my $correct=select_ur
(babel=>$babel,
input_idtype=>$input_idtype,input_ids=>$input_ids,output_idtypes=>$output_idtypes);
my $actual=$babel->translate
(input_idtype=>$input_idtype,input_ids=>$input_ids,output_idtypes=>$output_idtypes);
my $label="$db_type: input_idtype=".$input_idtype->name.
', output_idtypes='.join(' ',map {$_->name} @$output_idtypes);
report_fail(scalar @$correct,"BAD NEWS: \$correct empty. $label",$file,$line);
cmp_table_quietly($actual,$correct,$label,$file,$line);
# unless (@$correct && cmp_table($actual,$correct,$label,$file,$line)) {
# print "break here\n";
# }
# NG 11-01-21: added 'translate all'
my $correct=select_ur
(babel=>$babel,
input_idtype=>$input_idtype,input_ids_all=>1,output_idtypes=>$output_idtypes);
my $actual=$babel->translate
(input_idtype=>$input_idtype,input_ids_all=>1,output_idtypes=>$output_idtypes);
$label.=', input_ids_all';
report_fail(scalar @$correct,"BAD NEWS: \$correct empty. $label",$file,$line);
cmp_table_quietly($actual,$correct,$label,$file,$line);
}
# arg is maptable number
sub maptable_data {
$db_type eq 'staggered'? maptable_data_staggered(@_): maptable_data_binary(@_);
}
# arg can be link number or Master object
sub master_data {
my $leaf=ref $_[0]? $_[0]->idtype->name: 'leaf_'.sprintf('%03d',$_[0]);
$db_type eq 'staggered'? master_data_staggered($leaf): master_data_binary($leaf);
}
sub maptable_data_staggered {
my($i)=@_;
my $num=sprintf('%03d',$i);
my $leaf="leaf_$num";
my @leafs=((map {"$leaf/a_".sprintf('%03d',$_)} ($i..$last_maptable)),
(map {"$leaf/b_".sprintf('%03d',$last_maptable-$_)} (0..$i)));
my(@data,@link_befores,@link_afters);
my $link_before=join('_','link',sprintf('%03d',$i-1),$num);
@link_befores=map {"${link_before}/l_$_"} map {/.*_(\d+)/} @leafs;
my $link_after=join('_','link',$num,sprintf('%03d',$i+1));
@link_afters=map {"${link_after}/l_$_"} map {/.*_(\d+)/} @leafs;
if ($i==$last_maptable) {
@data=(["${link_before}/multi","$leaf/multi_000"],
["${link_before}/multi","$leaf/multi_001"],
map {[$link_befores[$_],$leafs[$_]]} (0..$#leafs));
} elsif($i==0) {
@data=(["$leaf/multi_000","${link_after}/multi"],
["$leaf/multi_001","${link_after}/multi"],
map {[$leafs[$_],$link_afters[$_]]} (0..$#leafs));
} else { # general case
@data=(["${link_before}/multi","$leaf/multi_000","${link_after}/multi"],
["${link_before}/multi","$leaf/multi_001","${link_after}/multi"],
map {[$link_befores[$_],$leafs[$_],$link_afters[$_]]} (0..$#leafs));
}
\@data;
}
sub master_data_staggered {
my($leaf)=@_;
my @leafs=("${leaf}/multi_000","${leaf}/multi_001",
map {("${leaf}/a_$_","${leaf}/b_$_")} map {sprintf('%03d',$_)} (0..$last_maptable));
\@leafs;
}
sub maptable_data_binary {
my($i)=@_;
my @binvals=binary_series($num_maptables,$i);
my $num=sprintf('%03d',$i);
my $leaf="leaf_$num";
my @leafs=map {"$leaf/c_$_"} @binvals;
my(@data,@link_befores,@link_afters);
my $link_before=join('_','link',sprintf('%03d',$i-1),$num);
@link_befores=map {"${link_before}/l_$_"} @binvals;
my $link_after=join('_','link',$num,sprintf('%03d',$i+1));
@link_afters=map {"${link_after}/l_$_"} @binvals;
if ($i==$last_maptable) {
@data=(["${link_before}/multi","$leaf/multi_000"],
["${link_before}/multi","$leaf/multi_001"],
map {[$link_befores[$_],$leafs[$_]]} (0..$#leafs));
} elsif($i==0) {
@data=(["$leaf/multi_000","${link_after}/multi"],
["$leaf/multi_001","${link_after}/multi"],
map {[$leafs[$_],$link_afters[$_]]} (0..$#leafs));
} else { # general case
@data=(["${link_before}/multi","$leaf/multi_000","${link_after}/multi"],
["${link_before}/multi","$leaf/multi_001","${link_after}/multi"],
map {[$link_befores[$_],$leafs[$_],$link_afters[$_]]} (0..$#leafs));
}
\@data;
}
# arg is link number
sub master_data_binary {
my($leaf)=@_;
my @binvals=binary_series($num_maptables);
my @leafs=("${leaf}/multi_000","${leaf}/multi_001",map {"${leaf}/c_$_"} @binvals);
\@leafs;
}
sub binary_series {
my($bits,$my_bit)=@_;
if (defined $my_bit) { # return $bits-wide numbers with $my_bit set
my $mask=1<<$my_bit;
return map {sprintf '%0*b',$bits,$_} grep {$_&$mask} (0..2**$bits-1);
} else { # return all $bits-wide numbers
return map {sprintf '%0*b',$bits,$_} (0..2**$bits-1);
}
}
# for debugging. args are number of bits, and number to convert
sub as_binary_string {sprintf '%0*b',@_}
# these functions generate lists of input ids
# arg is IdType
sub idtype2ids {
my($idtype)=@_;
my $name=$idtype->name;
$name=~/^leaf/? leaf_ids($name): link_ids($name)}
sub leaf_ids {
$db_type eq 'staggered'? leaf_ids_staggered(@_): leaf_ids_binary(@_);
}
sub link_ids {
$db_type eq 'staggered'? link_ids_staggered(@_): link_ids_binary(@_);
}
# # arg is maptable index
# sub link_before_ids {
# my($i)=@_;
# confess "Bad news: link_before_ids called with \$i=0" if $i==0;
# my $link_before=join('_','link',sprintf('%03d',$i-1),sprintf('%03d',$i));
# $db_type eq 'staggered'? link_ids_staggered($link_before): link_ids_binary($link_before);
# }
# sub link_after_ids {
# my($i)=@_;
# confess "Bad news: link_before_ids called with \$i=\$last_maptable" if $i==$last_maptable;
# my $link_after=join('_','link',sprintf('%03d',$i),sprintf('%03d',$i+1));
# $db_type eq 'staggered'? link_ids_staggered($link_after): link_ids_binary($link_after);
# }
sub leaf_ids_staggered {
my($leaf)=@_;
["${leaf}/none","${leaf}/multi_000","${leaf}/multi_001",
map {"${leaf}/a_".sprintf('%03d',$_),"${leaf}/b_".sprintf('%03d',$_)} (0..$last_maptable)];
}
sub link_ids_staggered {
my($link)=@_;
["${link}/none","${link}/multi",map {"${link}/l_".sprintf('%03d',$_)} (0..$last_maptable)];
}
sub leaf_ids_binary {
my($leaf)=@_;
["${leaf}/none","${leaf}/multi_000","${leaf}/multi_001",
map {"${leaf}/c_$_"} binary_series($num_maptables)];
}
sub link_ids_binary {
my($link)=@_;
my @binvals=binary_series($num_maptables);
["${link}/none","${link}/multi",map {"${link}/l_$_"} @binvals];
}