Можно добавить «шаблоны» для новых таблиц(причесанных) по структуре. В текущем варианте скрипт не зависит от изменений структуры, т.к. переносит полностью всю структуру таблицы с текущей(рабочей).

#!/usr/bin/perl -w
use DBI;
use strict;
my $dbh; my $sth; my $ts; my @res; my $tmp;
# Обязательно сменить
my $dbuser='';
my $dbpass='';
my $dbhost='';
# Дальше лучше не менять
$dbh=DBI->connect("DBI:mysql:UTM5:$dbhost", $dbuser, $dbpass, {RaiseError=>1})
         or die "\nConnection failed...\nError: $DBI::errstr\n";
$sth=$dbh->prepare("select unix_timestamp(concat(year(now()),'-',month(now()),'-01 00:00:00'))");
$sth->execute();
$ts=($sth->fetchrow_array)[0];
$dbh->do("rename table discount_transactions_all to UTM5H.discount_transactions_all_$ts");
$dbh->do("rename table discount_transactions_iptraffic_all to UTM5H.discount_transactions_iptraffic_all_$ts");
$sth=$dbh->prepare("show create table UTM5H.discount_transactions_iptraffic_all_$ts");
$sth->execute();
if (@res=$sth->fetchrow_array) {
    $tmp= $res[1];
    $tmp=~ s/UTM5H\.discount_transactions_iptraffic_all_$ts/discount_transactions_iptraffic_all/g;
    };
$dbh->do($tmp);
$sth=$dbh->prepare("show create table UTM5H.discount_transactions_all_$ts");
$sth->execute();
if (@res=$sth->fetchrow_array) {
    $tmp= $res[1];
    $tmp=~ s/UTM5H\.discount_transactions_all_$ts/discount_transactions_all/g;
    };
$dbh->do($tmp);
$dbh->do("insert into discount_transactions_all select * from UTM5H.discount_transactions_all_$ts where discount_date>=$ts");
$dbh->do("insert into discount_transactions_iptraffic_all select * from UTM5H.discount_transactions_iptraffic_all_$ts where discount_date>=$ts");
$dbh->do("delete from UTM5H.discount_transactions_all_$ts where discount_date>=$ts");
$dbh->do("delete from UTM5H.discount_transactions_iptraffic_all_$ts where discount_date>=$ts");
$sth=$dbh->prepare("select max(archive_id) from archives");
$sth->execute();
$tmp=($sth->fetchrow_array)[0];
$tmp+=1;
$dbh->do("insert into archives(archive_id,table_type,table_name,start_date,end_date) SELECT $tmp,1,".$dbh->quote("UTM5H.discount_transactions_all_$ts").",min(discount_date),max(discount_date) from UTM5H.discount_transactions_all_$ts");
$dbh->do("insert into archives(archive_id,table_type,table_name,start_date,end_date) SELECT $tmp,2,".$dbh->quote("UTM5H.discount_transactions_iptraffic_all_$ts").",min(discount_date),max(discount_date) from UTM5H.discount_transactions_iptraffic_all_$ts");

#!/usr/bin/perl 
 
use DBI; 
sub move_table_tmp; 
sub copy_delta; 
sub move_to_archiv; 
 
$ArchiveDBname = "UTM5H"; 
$DBhost = "localhost"; 
$DBname = "UTM5"; 
$Login = "login"; 
$Password = "password"; 
$hc_locks = "discount_transactions_all WRITE, discount_transactions_iptraffic_all WRITE, dhs_sessions_log WRITE, messages WRITE"; 
 
    $dbh = DBI->connect( "DBI:mysql:$DBname:$DBhost", $Login, $Password, {RaiseError=>1} ) or die "\nConnection failed...\nError: $DBI::errstr\n"; 
 
    #get end_date of period to archive
    $sth = $dbh->prepare( "select UNIX_TIMESTAMP(concat(YEAR(now()),'-',MONTH(now()),'-1 0:0:0')),from_unixtime(UNIX_TIMESTAMP(DATE_ADD(now(), INTERVAL -1 MONTH)),'%Y%m')" );
    $sth->execute() or die "DB Error: $DBI::errstr\n"; 
    ($enddate,$date_for_name)=$sth->fetchrow_array; 
    print "END DATE for archive: $enddate ,$date_for_name)\n"; 
 
  ############################################ 
  # MAIN START 
  ############################################ 
 
  ############################################ 
  # TRANSACTION 
  ############################################ 
    $dbh->do("USE $DBname"); 
    $dbh->do("LOCK TABLES $hc_locks"); 
    $dbh->do("START TRANSACTION"); 
    &move_table_tmp ("discount_transactions_all"); 
    &move_table_tmp ("discount_transactions_iptraffic_all"); 
    &move_table_tmp ("dhs_sessions_log"); 
    &move_table_tmp ("messages"); 
    $dbh->do("UNLOCK TABLES"); 
    $dbh->do("COMMIT"); 
  ############################################ 
  # END TRANSACTION 
  ############################################ 
 
  ############################################ 
  # Copy to archive 
  ############################################ 
    &copy_delta("discount_transactions_all", "discount_date", $enddate); 
    &copy_delta("discount_transactions_iptraffic_all", "discount_date", $enddate); 
    &copy_delta("messages", "send_date", $enddate); 
    &copy_delta("dhs_sessions_log", "recv_date", $enddate); 
    &move_to_archiv($ArchiveDBname, "dhs_sessions_log", "_$date_for_name", "recv_date"); 
    &move_to_archiv($ArchiveDBname, "messages", "_$date_for_name", "send_date"); 
    &move_to_archiv($ArchiveDBname, "discount_transactions_all", "_$date_for_name", "discount_date"); 
    &move_to_archiv($ArchiveDBname, "discount_transactions_iptraffic_all", "_$date_for_name", "discount_date"); 
  ############################################ 
  # END Copy to archive 
  ############################################ 
    $sth->finish; 
    $dbh->disconnect; 
  ############################################ 
  # MAIN END 
  ############################################ 
 
sub move_table_tmp { 
    my $t_name = shift; 
    my $SQL = "SHOW CREATE TABLE $t_name"; 
    $sth = $dbh->prepare($SQL); 
    $sth->execute() or die "DB Error: $DBI::errstr\n"; 
    my ($t_name,$t_conf_sql)=$sth->fetchrow_array; 
    print "Movie $t_name to $t_name" . "_bak\n\n"; 
    print "SQL: $t_conf_sql\n\n"; 
    $SQL = "RENAME TABLE `".$DBname."`.`".$t_name."` TO `".$DBname."`.`".$t_name."_bak`"; 
    $dbh->do($SQL); 
    $dbh->do($t_conf_sql); 
} 
 
sub copy_delta { 
    my $t_name = shift; 
    my $t_col  = shift; 
    my $e_date = shift; 
    print "Copy delta: $t_name\n"; 
    $dbh->do("INSERT INTO $t_name SELECT * FROM $t_name"."_bak WHERE $t_col>=$e_date"); 
    $dbh->do("DELETE FROM $t_name"."_bak WHERE $t_col>=$e_date"); 
} 
 
sub move_to_archiv { 
    my $a_DB_name = shift; 
    my $t_name    = shift; 
    my $t_prefix  = shift; 
    my $t_col     = shift; 
    my $a_t_name = $a_DB_name . "." . $t_name.$t_prefix; 
    print "Copy: $t_name to archive $a_t_name\n"; 
    $dbh->do("RENAME TABLE $t_name"."_bak TO $a_t_name"); 
    $sth = $dbh->prepare("SELECT min($t_col),max($t_col) from $a_t_name"); 
    $sth -> execute() or die "DB Error: $DBI::errstr\n"; 
    my ($start_date,$end_date)=$sth->fetchrow_array; 
    $sth = $dbh->prepare("SELECT archive_id,table_type FROM archives WHERE table_name LIKE '$a_DB_name.$t_name%' ORDER BY archive_id DESC LIMIT 0,1"); 
    $sth -> execute() or die "DB Error: $DBI::errstr\n"; 
    my ($archive_id,$table_type)=$sth->fetchrow_array; 
    $dbh->do("INSERT INTO archives (archive_id,table_type,table_name,start_date,end_date) VALUES ($archive_id+1,'$table_type','$a_t_name',$start_date,$end_date)"); 
}