use v5.12.0;
use warnings;
use Data::Dump qw/pp dd/;
use DBI;
use Carp;
use Time::HiRes;

my $DBG = 0;

my @tables = tables();



my %localhost =
  (
   host => '127.0.0.1',
   user => 'perl_test',
   pwd  => 'perl_test',
  );

my %src_host =
  (
   host => 'aws-ksrpu12.bku.db.de',
   user => 'root',
   pwd  => 'Referenz98',
  );

my %dst_host =
  (
   host => 'aws-ksrpu14.bku.db.de',
   user => 'root',
   pwd  => 'Referenz98',
  );


my %test_table =
  (
   table => 'tbl_test_inno',
   fields => [qw/foo bar/],
  );

my %table =
  (
   table => 'TMP_tbl_groups_delta',
   fields => [qw/f_usertype f_time f_dbtype f_action/],
  );

#%table=%test_table;

#pp \%table;

my %src =                               # source
  (
   db    => 'transfer_quelle',
   %table,
   %localhost,
   # db    => 'ksr_bf_utf8',
   # %src_host,
  );

my %dst  =                              # destination
  (
   db    => 'transfer_ziel',
   %table,
   %localhost,
  );

warn pp '\%src: ', \%src;

warn pp '\%dst: ', \%dst;


my $driver = 'mysql';
my $port   = '3306';





my $dsn1  = "dbi:$driver:database=$src{db};host=$src{host};port=$port";
my $dsn2  = "dbi:$driver:database=$dst{db};host=$dst{host};port=$port";




my $dbh1 =
  DBI->connect($dsn1, $src{user}, $src{pwd},
                       { RaiseError => 1, AutoCommit => 0 });

#my $sth_info;

# $sth_info = $dbh1->table_info(undef, $src{db}, '%tbl%' );
# warn pp $sth_info->fetchall_hashref('TABLE_NAME');

#warn pp $dbh1->tables(undef, $src{db}, '%tbl%' );
#warn pp $sth_info->fetchall_arrayref();

#$sth_info = $dbh1->column_info(undef, $src{db}, $src{table}, '%' );
#warn pp $sth_info->fetchall_hashref('COLUMN_NAME');
  
#$dbh1->disconnect;

#exit;

my $dbh2 =
  DBI->connect($dsn2, $dst{user}, $dst{pwd},
                       { RaiseError => 1, AutoCommit => 0 });





#if (1) {
my $start = time();
#warn
my $fields = join ", ", $src{fields}->@*;
#warn
my $binds  = join ", ", map {"?"} $src{fields}->@*;

# --- hole Quelldaten
my $sel = $dbh1->prepare("SELECT $fields FROM $src{table}");
$sel->execute;

# --- leere Zieltabelle
$dbh2->do("TRUNCATE TABLE $dst{table}");

# --- bereite Insert im Ziel vor
my $ins = $dbh2->prepare("INSERT INTO $dst{table} ($fields) VALUES ($binds)");

# --- callback für quelldaten
my $fetch_tuple_sub = sub {
    #my $a_row =
    $sel->fetchrow_arrayref;
    #carp pp $a_row;
    #$a_row;
};

my @tuple_status;
my $rc = $ins->execute_for_fetch( $fetch_tuple_sub, \@tuple_status );

# --- ACHTUNG: MyIsam kann keine Rollbacks 
if (defined $rc) {
    warn "--- COMMIT";
    $dbh1->commit();                    # useless?
    $dbh2->commit();
} else {
    warn "--- ROLLBACK";
    $dbh1->rollback;
    $dbh2->rollback;
    my @errors = grep { ref $_ } @tuple_status;

    warn "$#errors ERRORS";
    warn " like: ", join "\n", map {pp $_ } @errors[0..10]; # TODO
}

    
my $end = time();





my $sth = $dbh2->prepare(<<"__SQL__") or die "ERROR prepare";
SELECT count(*)
    FROM $dst{table}
;
__SQL__

$sth->execute();
pp  my $aref = $sth->fetchall_arrayref();

warn "Took :" , $end -$start, " seconds";


$dbh1->disconnect();
$dbh2->disconnect();

sub tables {
    qw(tbl_axxfunction
     tbl_axxfunction_exe
     tbl_axxpw
     tbl_axxrecht
     tbl_axxstatus
     tbl_axxst_elright
     tbl_bffunc_htmlaw
     tbl_bffunktionen
     tbl_bffunktionen_exe
     tbl_budpla_man_right
     tbl_bud_sonder
     tbl_cube_right
     tbl_dbtyp_default_elementright
     tbl_dbtyp_elementright
     tbl_dbtyp_groups_default
     tbl_dbtyp_userprop
     tbl_element_right
     tbl_elright_rw
     tbl_email_absender
     tbl_email_texte
     tbl_gbbstgruppen
     tbl_gbbst_gruppe
     tbl_gbein
     tbl_groups_default
     tbl_groups_delta
     tbl_html_auswertungen
     tbl_info
     tbl_info_txt
     tbl_menue
     tbl_menue_baum
     tbl_param
     tbl_ref
     tbl_userber
     tbl_userprop
     tbl_usertyp
     tbl_usertyp_elright
     tbl_user_stamm
     t_mailv_typ
     t_mailv_user
     );
}
