The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package translate_hand;
use t::util;
use t::utilBabel;
use Carp;
use File::Spec;
use Getopt::Long;
use Hash::AutoHash;
use List::Util qw(min);
use Set::Scalar;
use Test::More;
use Text::Abbrev;
use Class::AutoDB;
use Data::Babel;
use strict;
our @ISA=qw(Exporter);

our @EXPORT=qw($OPTIONS %OPTIONS @OPTIONS $OP $autodb $babel $dbh 
	       $data @idtypes @idtypes_subsets @filter_subsets @output_subsets @ids
	       init make_ids make_invalid_ids empty_result);
our($OPTIONS,%OPTIONS,@OPTIONS,$OP,$autodb,$babel,$dbh,$data,@idtypes,
    @idtypes_subsets,@filter_subsets,@output_subsets,@ids);
@idtypes=qw(type_001 type_002 type_003 type_004);
@ids=qw(000 001 010 011 100 101 110 111);

@OPTIONS=qw(op=s history validate user_type=s max_ids=i max_filters=i max_outputs=i);
our %op=abbrev qw(translate count);
our %user_type=abbrev qw(installer developer);
# for some options, defaults depend on user_type
our %DEFAULTS=(op=>'translate',user_type=>'installer',
	       installer=>{max_ids=>2,max_outputs=>2,max_filters=>2},
	       developer=>{max_ids=>scalar(@ids),
			   max_outputs=>scalar(@idtypes),max_filters=>scalar(@idtypes)}
	      );

sub init {
  my $setup=shift @_;
  $OPTIONS=get_options();
  my $power_set=Set::Scalar->new(@idtypes)->power_set;
  @idtypes_subsets=$power_set->members;
  @filter_subsets=grep {$_->size<=$OPTIONS->max_filters} @idtypes_subsets;
  @output_subsets=grep {$_->size<=$OPTIONS->max_outputs} @idtypes_subsets;
  unless ($setup) {
    $autodb=new Class::AutoDB(database=>'test'); 
    isa_ok($autodb,'Class::AutoDB','sanity test - $autodb');
    # expect 'old' to return the babel
    $babel=old Data::Babel(name=>'test',autodb=>$autodb);
    isa_ok($babel,'Data::Babel','sanity test - old Babel returned Babel object');
    my @idtypes=@{$babel->idtypes};
    is_quietly(scalar @idtypes,4,'BAD NEWS old Babel has wrong number of idtypes!!');
    my @maptables=@{$babel->maptables};
    is_quietly(scalar @maptables,3,'BAD NEWS old Babel has wrong number of maptables!!');
  } else {			# setup new database
    $autodb=new Class::AutoDB(database=>'test',create=>1); 
    isa_ok($autodb,'Class::AutoDB','sanity test - $autodb');
    cleanup_db($autodb);		# cleanup database from previous test
    Data::Babel->autodb($autodb);
    # rest of setup done by test
  }
  $dbh=$autodb->dbh;
  my $data_ini=!$OPTIONS{history}? 'translate_hand.data.ini': 'translate_hand.data_history.ini';
  $data=new Data::Babel::Config(file=>File::Spec->catfile(scriptpath,$data_ini))->autohash;
}
# returns Hash::AutoHash
sub get_options {
  %OPTIONS=%DEFAULTS;
  GetOptions(\%OPTIONS,@OPTIONS);
  # expand abbreviations
  for my $option (qw(op user_type)) {
    next unless defined $OPTIONS{$option};
    my %abbrev=eval "\%$option";
    $OPTIONS{$option}=$abbrev{$OPTIONS{$option}} or confess "illegal value for option $option";
  }
  # set defaults that depend on user_type
  my %defaults=%{$DEFAULTS{$OPTIONS{user_type}}};
  map {$OPTIONS{$_}=$defaults{$_} unless exists $OPTIONS{$_}} keys %defaults;
 
  # set special-case defaults
  # $OPTIONS{filter}=1 if !defined($OPTIONS{filter}) && scriptbasename=~/filter/;

  $OP=$OPTIONS{op};
  $OPTIONS=new Hash::AutoHash %OPTIONS;
}
# convert idtype & id indexes to ids. if no indexes, convert all ids
sub make_ids {
  my $idtype=shift;
  my $id_prefix=($OPTIONS->history && grep {$idtype eq $_} qw(type_001 type_002))? 
    "${idtype}/x_": "${idtype}/a_";
  @_? map {"${id_prefix}$_"} @ids[@_]: map {"${id_prefix}$_"} @ids;
}
sub make_invalid_ids {
  my($idtype,$num)=@_;
  my $id_prefix=($OPTIONS->history && grep {$idtype eq $_} qw(type_001 type_002))? 
    "${idtype}/x_": "${idtype}/a_";
  map {"${id_prefix}invalid_".sprintf('%03i',$_)} 1..$num;
}
# result can be table or count
sub empty_result {
  my $result=shift;
  ref $result? scalar @$result: $result;
}
1;