| Current Path : /var/www/web-klick.de/dsh/10_customer2017/1183__ud/appserv/Migration/ |
Linux ift1.ift-informatik.de 5.4.0-216-generic #236-Ubuntu SMP Fri Apr 11 19:53:21 UTC 2025 x86_64 |
| Current File : /var/www/web-klick.de/dsh/10_customer2017/1183__ud/appserv/Migration/uu.zip |
Database.pm 0000644 0001750 0001750 00000044505 11245467423 012136 0 ustar joerg joerg package Database;
# vim:set ai tabstop=4 shiftwidth=4 foldmethod=marker fileencoding=utf-8:
use strict;
use UD::DB::Connection;
use UD::Tools;
use Data::Dumper;
my $InternalData = undef;
my $dbhandle = undef;
sub getDBhandle { # {{{
unless( defined $dbhandle ) {
my $data = {
cfg => {
RaiseError => 0,
PrintError => 0,
AutoCommit => 0,
},
user => "reloadedmigratio",
pwd => "AsMDQwYjrUA5NBvL",
db => "reloaded_migration",
};
my $h = UD::DB::Connection->new( $data );
$h->connect;
$dbhandle = $h->{dbhdl};
}
return $dbhandle;
} # }}}
# read_* read the table and return it (used for reading it into InternalData)
# get_*: given: ID, returned: name of parameter
# get_*_id: given: Name, returned: ID
# upd_*: given: domainid, new value, returned: OK/Not OK
sub read_domtld { return _read_helpertable( "dom_tld" ) }
sub get_domtld_id { return _getstatus( "domtld_rev", $_[0] ) }
sub get_domtld { return _getstatus( "domtld", $_[0] ) }
sub read_domstatus { return _read_helpertable( "dom_status" ) }
sub get_domstatus_id { return _getstatus( "domstatus_rev", $_[0] ) }
sub get_domstatus { return _getstatus( "domstatus", $_[0] ) }
sub read_domregistrar { return _read_helpertable( "dom_registrar" ) }
sub get_domregistrar_id { return _getstatus( "domregistrar_rev", $_[0] ) }
sub get_domregistrar { return _getstatus( "domregistrar", $_[0] ) }
sub read_migrstatus { return _read_helpertable( "migr_status" ) }
sub get_migrstatus_id { return _getstatus( "migrstatus_rev", $_[0] ) }
sub get_migrstatus { return _getstatus( "migrstatus", $_[0] ) }
sub upd_migrstatus { return _update_status( "migr_status", $_[0], $_[1] ) }
sub read_regmail { return _read_helpertable( "reg_mail" ) }
sub get_regmail_id { return _getstatus( "regmail_rev", $_[0] ) }
sub get_regmail { return _getstatus( "regmail", $_[0] ) }
sub read_regwhois { return _read_helpertable( "reg_whois" ) }
sub get_regwhois_id { return _getstatus( "regwhois_rev", $_[0] ) }
sub get_regwhois { return _getstatus( "regwhois", $_[0] ) }
sub read_regconnected { return _read_helpertable( "reg_connected" ) }
sub get_regconnected_id { return _getstatus( "regconnected_rev", $_[0] ) }
sub get_regconnected { return _getstatus( "regconnected", $_[0] ) }
sub read_regstatus { return _read_helpertable( "reg_status" ) }
sub get_regstatus_id { return _getstatus( "regstatus_rev", $_[0] ) }
sub get_regstatus { return _getstatus( "regstatus", $_[0] ) }
sub read_regusermail { return _read_helpertable( "reg_usermail" ) }
sub get_regusermail_id { return _getstatus( "regusermail_rev", $_[0] ) }
sub get_regusermail { return _getstatus( "regusermail", $_[0] ) }
sub read_contacttypes { return _read_helpertable( "contact_types" ) }
sub get_contacttypes_id { return _getstatus( "contacttypes_rev", $_[0] ) }
sub get_contacttypes { return _getstatus( "contacttypes", $_[0] ) }
sub upd_ourns { return _update_status( "our_ns", $_[0], $_[1] ) }
sub upd_domain_exist { return _update_status( "domain_exist", $_[0], $_[1] ) }
sub upd_domain_ours { return _update_status( "domain_ours", $_[0], $_[1] ) }
sub _getstatus { # {{{
my ( $key, $status ) = @_;
_read_internal_data();
return $InternalData->{$key}->{$status};
} # }}}
sub _reverse_it { # {{{
my( $data ) = @_;
my $hash = {};
for my $k ( keys %$data ) {
$hash->{ $data->{$k} } = $k;
}
return $hash;
} # }}}
sub _read_internal_data { # {{{
return if defined $InternalData;
$InternalData = {
domstatus => read_domstatus(),
domtld => read_domtld(),
domregistrar => read_domregistrar(),
migrstatus => read_migrstatus(),
regmail => read_regmail(),
regwhois => read_regwhois(),
regconnected => read_regconnected(),
regstatus => read_regstatus(),
regusermail => read_regusermail(),
contacttypes => read_contacttypes(),
};
$InternalData->{domstatus_rev} = _reverse_it( $InternalData->{domstatus} );
$InternalData->{domtld_rev} = _reverse_it( $InternalData->{domtld} );
$InternalData->{domregistrar_rev} = _reverse_it( $InternalData->{domregistrar} );
$InternalData->{migrstatus_rev} = _reverse_it( $InternalData->{migrstatus} );
$InternalData->{regmail_rev} = _reverse_it( $InternalData->{regmail} );
$InternalData->{regwhois_rev} = _reverse_it( $InternalData->{regwhois} );
$InternalData->{regconnected_rev} = _reverse_it( $InternalData->{regconnected} );
$InternalData->{regstatus_rev} = _reverse_it( $InternalData->{regstatus} );
$InternalData->{regusermail_rev} = _reverse_it( $InternalData->{regusermail} );
$InternalData->{contacttypes_rev} = _reverse_it( $InternalData->{contacttypes} );
# print Dumper $InternalData;
} # }}}
sub _read_helpertable { # {{{
my( $table ) = @_;
my $dbh = getDBhandle();
return unless $dbh;
my $select = qq{
SELECT
id,
name
FROM
reloaded_migration.$table
ORDER BY id
};
my $sel = $dbh->prepare( $select ) or die $dbh->errstr;
$sel->execute or die $dbh->errstr;
my $hash = {};
while( my $res = $sel->fetchrow_hashref ) {
$hash->{ $res->{id} } = $res->{name};
}
return $hash;
} # }}}
sub read_domains_by_status { # {{{
my( $status, $limit, $registrar ) = @_;
$limit = 10 unless $limit;
# print "S:[$status] L:[$limit]\n";
my $dbh = getDBhandle();
return unless $dbh;
my $select = qq{
SELECT
d.id,
d.userid,
d.domain,
d.dom_tld,
d.dom_regdate,
d.dom_status,
d.dom_registrar,
d.reg_mail,
d.reg_whois,
d.reg_connected,
d.reg_status,
d.reg_action,
d.reg_usermail,
d.migr_status,
d.our_ns,
d.domain_in_registry_list,
d.authcode,
d.domain_exist,
d.domain_ours,
d.error,
d.lasterrormsg
FROM
reloaded_migration.domains AS d
LEFT JOIN reloaded_migration.locks AS l ON l.id = d.id
WHERE
l.id IS NULL
AND error = 0
AND d.migr_status = $status
};
$select .= qq{ AND d.dom_registrar = $registrar } if $registrar;
$select .= qq{ LIMIT $limit };
my $sel = $dbh->prepare( $select ) or print STDERR $dbh->errstr && return;
$sel->execute() or print STDERR $dbh->errstr && return;
my $domains = {};
while( my $res = $sel->fetchrow_hashref ) {
my $id = $res->{id};
for my $key ( keys %$res ) {
$domains->{$id}->{$key} = $res->{$key};
}
}
return $domains;
} # }}}
sub read_domain_by_id { # {{{
my( $domainid, $criteria ) = @_;
# criteria (hash) can be the following:
# -value: select all but the named value (for DB load reasons)
# +value: select only named values
# if undefined: load everything.
#
# named values are:
# domain: domain data from reloaded_migration.domains itself
# ns: the delegated NS
# nsrecords: the NS records
# history: The domainhistory
# contacts: All the contacts
# auftraege: Alle aktiven Auftraege fuer diese Domain
my $load_hash = {
domain => 1,
ns => 1,
nsrecords => 1,
history => 1,
contacts => 1,
auftraege => 1,
};
# easy alter ... wenn ein Plus gefunden wird, dann werden
# alle auf 0 gesetzt und nur die plus hergenommen ...
my $plus = 0;
for my $v ( keys %$load_hash ) {
$plus++ if defined $criteria->{ '+' . $v };
}
if ( $plus ) {
for my $v ( keys %$load_hash ) {
$load_hash->{$v} = 0;
$load_hash->{$v} = 1 if defined $criteria->{ '+' . $v };
}
}
else {
for my $v ( keys %$load_hash ) {
$load_hash->{$v} = 0 if defined $criteria->{ '-' . $v };
}
}
my $dbh = getDBhandle();
return unless $dbh;
my $domaindata = {};
## The domain itself {{{
if( $load_hash->{domain} ) {
my $select_domain = qq{
SELECT
id,
userid,
domain,
dom_tld,
dom_regdate,
dom_status,
dom_registrar,
reg_mail,
reg_whois,
reg_connected,
reg_status,
reg_action,
reg_usermail,
migr_status,
our_ns,
domain_in_registry_list,
authcode,
domain_exist,
domain_ours,
error,
lasterrormsg
FROM
reloaded_migration.domains
WHERE
id = ?
};
my $sel_dom = $dbh->prepare( $select_domain ) or print STDERR $dbh->errstr . "\n" && return;
$sel_dom->execute( $domainid ) or print STDERR $dbh->errstr . "\n" && return;
while( my $res = $sel_dom->fetchrow_hashref ) {
for my $n ( keys %$res ) {
$domaindata->{domain}->{$n} = $res->{$n};
}
}
}
# }}}
## The delegated NS {{{
if ( $load_hash->{ns} ) {
my $select_ns = qq{
SELECT
id,
ns,
reloaded_id
FROM
reloaded_migration.delegated_ns
WHERE
domain_id = ?
};
my $sel_ns = $dbh->prepare( $select_ns ) or print STDERR $dbh->errstr . "\n" && return;
$sel_ns->execute( $domainid ) or print STDERR $dbh->errstr . "\n" && return;
while( my $res = $sel_ns->fetchrow_hashref ) {
$domaindata->{ns}->{ $res->{id} } = {
id => $res->{id},
ns => $res->{ns},
reloadedid => $res->{reloaded_id},
};
}
}
# }}}
## The NS records {{{
if ( $load_hash->{nsrecords} ) {
my $select_nsrecords = qq{
SELECT
id,
name,
type,
ttl,
content
FROM
reloaded_migration.ns_records
WHERE
domain_id = ?
};
my $sel_nsrr = $dbh->prepare( $select_nsrecords ) or print STDERR $dbh->errstr . "\n" && return;
$sel_nsrr->execute( $domainid ) or print STDERR $dbh->errstr . "\n" && return;
while( my $res = $sel_nsrr->fetchrow_hashref ) {
$domaindata->{nsrr}->{ $res->{id} } = {
id => $res->{id},
name => $res->{name},
type => $res->{type},
ttl => $res->{ttl},
content => $res->{content},
};
}
}
# }}}
## The domain history # {{{
if( $load_hash->{history} ) {
my $hdbh = UD::DB::Connection::getReadDBHandle();
my $select_history = qq{
SELECT
id,
date,
history
FROM
udag.domain_history
WHERE
domainid = ?
};
my $sel_his = $hdbh->prepare( $select_history ) or print STDERR $hdbh->errstr . "\n" && return;
$sel_his->execute( $domainid ) or print STDERR $hdbh->errstr . "\n" && return;
while( my $res =$sel_his->fetchrow_hashref ) {
$domaindata->{history}->{ $res->{id} } = {
id => $res->{id},
date => $res->{date},
history => $res->{history},
};
}
}
# }}}
## The contacts # {{{
if( $load_hash->{contacts} ) {
my $select_contacts = qq{
SELECT
id,
contact_type,
reloaded_contact_id
FROM
reloaded_migration.contacts
WHERE
domain_id = ?
};
my $select_contact_data = qq{
SELECT
id,
schluessel,
wert
FROM
reloaded_migration.contact_data
WHERE
contact = ?
};
my $sel_c = $dbh->prepare( $select_contacts )
or print STDERR $dbh->errstr . "\n" && return;
my $sel_cd = $dbh->prepare( $select_contact_data )
or print STDERR $dbh->errstr . "\n" && return;
$sel_c->execute( $domainid )
or print STDERR $dbh->errstr . "\n" && return;
while( my $res = $sel_c->fetchrow_hashref ) {
$domaindata->{contacts}->{ $res->{id} } = {
id => $res->{id},
type => $res->{contact_type},
reloadedid => $res->{reloaded_contact_id},
};
$sel_cd->execute( $res->{id} )
or print STDERR $dbh->errstr . "\n" && next;
while( my $_res = $sel_cd->fetchrow_hashref ) {
$domaindata->{contacts}->{ $res->{id} }->{data}->{ $_res->{schluessel} } = $_res->{wert};
}
}
}
# }}}
## The auftraege {{{
if ( $load_hash->{auftraege} ) {
my $select_auftraege = qq{
SELECT
id,
auftrag_id AS auftrag,
old_status AS status
FROM
reloaded_migration.auftraege
WHERE
domain_id = ?
};
my $sel_auftr = $dbh->prepare( $select_auftraege )
or print STDERR $dbh->errstr . "\n" && return;
$sel_auftr->execute( $domainid )
or print STDERR $dbh->errstr . "\n" && return;
while( my $res = $sel_auftr->fetchrow_hashref ) {
$domaindata->{auftraege}->{ $res->{id} } = {
id => $res->{id},
auftrag => $res->{auftrag},
status => $res->{status},
};
}
}
# }}}
return $domaindata;
} # }}}
sub update_authcode { # {{{
my( $domainid, $authcode ) = @_;
my $dbh = getDBhandle();
return 0 unless $dbh;
my $update = qq{
UPDATE
reloaded_migration.domains
SET
authcode = ?
WHERE
id = ?
};
my $upd = $dbh->prepare( $update ) or print STDERR $dbh->errstr . "\n" && return 0;
$upd->execute( $authcode, $domainid ) or print STDERR $dbh->errstr . "\n" && return 0;
$dbh->commit;
return 1;
} # }}}
sub _update_status { # {{{
my( $field, $domainid, $newstatus ) = @_;
my $dbh = getDBhandle();
return 0 unless $dbh;
my $update = qq{
UPDATE
reloaded_migration.domains
SET
$field = ?
WHERE
id = ?
};
my $upd = $dbh->prepare( $update ) or print STDERR $dbh->errstr . "\n" && return 0;
$upd->execute( $newstatus, $domainid ) or print STDERR $dbh->errstr . "\n" && return 0;
$dbh->commit;
return 1;
} # }}}
sub insert_delegated_ns { # {{{
my( $domainid, $ns_arr ) = @_;
my $dbh = getDBhandle();
return 0 unless $dbh;
my $insert = qq{
INSERT INTO
reloaded_migration.delegated_ns (
domain_id, ns
)
VALUES (
?, ?
)
};
my $ins = $dbh->prepare( $insert ) or print STDERR $dbh->errstr . "\n" && return 0;
for my $ns ( @$ns_arr ) {
# print "Insert $ns for DomainID $domainid ...\n";
$ins->execute( $domainid, $ns ) or print STDERR $dbh->errstr . "\n";
}
$dbh->commit;
return 1;
} # }}}
sub insert_ns_records { # {{{
my( $domainid, $data ) = @_;
my $dbh = getDBhandle();
return 0 unless $dbh;
my $insert = qq{
INSERT INTO
reloaded_migration.ns_records (
domain_id,
name,
type,
ttl,
content
)
VALUES (
?,
?,
?,
?,
?
)
};
my $ins = $dbh->prepare( $insert ) or print STDERR $dbh->errstr . "\n" && return 0;
$ins->execute( $domainid,
$data->{name}, $data->{type}, $data->{ttl}, $data->{content} )
or print STDERR "INS-ERR: " . $dbh->errstr . "\n";
$dbh->commit;
return 1;
} # }}}
sub write_whois_contact { # {{{
my( $domainid, $contact_type, $hdl ) = @_;
my $dbh = getDBhandle();
return 0 unless $dbh;
my $insert_contact = qq{
INSERT INTO
reloaded_migration.contacts (
contact_type,
domain_id
)
VALUES ( ?, ? )
};
my $insert_contact_data = qq{
INSERT INTO
reloaded_migration.contact_data (
contact,
schluessel,
wert
)
VALUES ( ?, ?, ? )
};
my $select = qq{ SELECT LAST_INSERT_ID() };
my $ins_contact = $dbh->prepare( $insert_contact )
or print STDERR $dbh->errstr && return 0;
my $ins_cd = $dbh->prepare( $insert_contact_data )
or print STDERR $dbh->errstr && return 0;
my $sel = $dbh->prepare( $select )
or print STDERR $dbh->errstr && return 0;
my $ct = Database::get_contacttypes_id( $contact_type );
# print "Contact-Type: $contact_type is $ct\n";
$ins_contact->execute( $ct, $domainid )
or print STDERR $dbh->errstr && return 0;
$sel->execute
or print STDERR $dbh->errstr && return 0;
my $contactid = 0;
while( my $res = $sel->fetchrow_hashref ) {
for my $n ( keys %$res ) { $contactid = $res->{$n} }
}
for my $key ( qw/handle company firstname lastname
address zip city country phone fax email/ ) {
if( defined $hdl->{$key} && $hdl->{$key} ) {
$ins_cd->execute( $contactid, $key, $hdl->{$key} )
or print STDERR $dbh->errstr;
}
}
$dbh->commit;
return $contactid;
} # }}}
sub update_reloaded_contact_id { # {{{
my( $contactid, $reloaded_contact_id ) = @_;
my $dbh = getDBhandle();
return 0 unless $dbh;
my $update = qq{
UPDATE
reloaded_migration.contacts
SET
reloaded_contact_id = ?
WHERE
id = ?
};
my $upd = $dbh->prepare( $update )
or print STDERR $dbh->errstr . "\n" && return 0;
$upd->execute( $reloaded_contact_id, $contactid )
or print STDERR $dbh->errstr . "\n" && return 0;
$dbh->commit;
return 1;
} # }}}
sub update_reloaded_host_id { # {{{
my( $nsid, $reloaded_host_id ) = @_;
my $dbh = getDBhandle();
return 0 unless $dbh;
my $update = qq{
UPDATE
reloaded_migration.delegated_ns
SET
reloaded_id = ?
WHERE
id = ?
};
my $upd = $dbh->prepare( $update )
or print STDERR $dbh->errstr . "\n" && return 0;
$upd->execute( $reloaded_host_id, $nsid )
or print STDERR $dbh->errstr . "\n" && return 0;
$dbh->commit;
return 1;
} # }}}
sub insert_auftrag { # {{{
my( $domainid, $auftragid, $auftragstatus ) = @_;
my $dbh = getDBhandle();
return 0 unless $dbh;
my $insert = qq{
INSERT INTO
reloaded_migration.auftraege (
domain_id,
auftrag_id,
old_status
)
VALUES (
?,
?,
?
)
};
my $ins = $dbh->prepare( $insert )
or print STDERR $dbh->errstr . "\n" && return 0;
$ins->execute( $domainid, $auftragid, $auftragstatus )
or print STDERR "INS-ERR: " . $dbh->errstr . "\n";
$dbh->commit;
return 1;
} # }}}
sub update_error_status { # {{{
my( $domainid, $errorcount, $lastmessage ) = @_;
my $dbh = getDBhandle();
return 0 unless $dbh;
my $update = qq{
UPDATE
reloaded_migration.domains
SET
error = ?,
lasterrormsg = ?
WHERE
id = ?
};
my $upd = $dbh->prepare( $update )
or print STDERR $dbh->errstr . "\n" && return 0;
$upd->execute( $errorcount, $lastmessage, $domainid )
or print STDERR $dbh->errstr . "\n" && return 0;
$dbh->commit;
return 1;
} # }}}
sub lock_domain { # {{{
my( $_data ) = @_;
my $dbh = getDBhandle();
return 0 unless $dbh;
# check param
my $data = {};
if( ref $_data eq "HASH" ) {
for my $key ( keys %$_data ) {
$data->{$key} = $_data->{$key};
}
}
else {
$data->{id} = $_data;
}
return 0 unless defined $data->{id};
my $insert = qq{
INSERT INTO
reloaded_migration.locks (
id, host, ppid, script
)
VALUES (
?, ?, ?, ?
)
};
my $ins = $dbh->prepare( $insert ) or print STDERR $dbh->errstr && return 0;
$ins->execute(
$data->{id},
( defined $data->{host} ? $data->{host} : UD::Tools::gethostname() ),
( defined $data->{ppid} ? $data->{ppid} : $$ ),
( defined $data->{script} ? $data->{script} : $0 ) ) or print STDERR $dbh->errstr && return 0;
$dbh->commit;
return 1;
} # }}}
sub unlock_domain { # {{{
my( $domainid ) = @_;
my $dbh = getDBhandle();
return 0 unless $dbh;
my $delete = qq{
DELETE FROM
reloaded_migration.locks
WHERE
id = ?
LIMIT 1
};
my $del = $dbh->prepare( $delete ) or print STDERR $dbh->errstr && return 0;
if ( $del->execute( $domainid ) ) {
$dbh->commit;
return 1;
}
return 0;
} # }}}
sub domain_is_locked { # {{{
my( $domainid ) = @_;
my $dbh = getDBhandle();
return 0 unless $dbh;
my $select = qq{
SELECT
*
FROM
reloaded_migration.locks
WHERE
id = ?
};
my $sel = $dbh->prepare( $select ) or print STDERR $dbh->errstr && return 0;
$sel->execute( $domainid ) or print STDERR $dbh->errstr && return 0;
my $res;
my $resid;
while( $res = $sel->fetchrow_hashref ) {
$resid = $res->{id};
}
return 1 if $resid == $domainid;
return 0;
} # }}}
1;
Migration.pm 0000755 0001750 0001750 00000010164 11245476575 012370 0 ustar joerg joerg package Migration;
# vim:set ai tabstop=4 shiftwidth=4 foldmethod=marker fileencoding=utf-8:
use strict;
use lib "../lib";
use lib "../../lib";
use Database;
use IO::File;
use UD::DateTools;
use Data::Dumper;
our $sigintset = 0;
my $error = 0;
my $lasterror = "";
my $logger_fh = undef;
######################################################################
# subs
sub ctrl_c_handler { # {{{
print "\n *** received SIGINT ***\n";
$sigintset = 1;
} # }}}
sub _logger { # {{{
my( $str ) = @_;
unless( defined $logger_fh ) {
my $fname = $0;
$fname =~ s/^.*\///;
$fname =~ s/\.pl$//;
my $date = UD::DateTools::getdate( "now", "YYYYMMDD-HHMM" );
$logger_fh = IO::File->new( ">> logs/$fname.$date.$$.log" );
if ( $logger_fh ) {
print $logger_fh "=" x 79 . "\n";
print $logger_fh " *** Log file opened " . localtime( time ) . "\n";
}
}
print $logger_fh $str . "\n" if $logger_fh;
print $str . "\n";
} # }}}
sub _error { # {{{
my( $str ) = @_;
$error++;
$lasterror = $str;
_logger( $str );
} # }}}
sub _is_error { # {{{
return 1 if $error;
return 0;
} # }}}
sub _counter { # {{{
my( $a, $b ) = @_;
printf( "%06d/%06d\r", $a, $b );
} # }}}
sub start { # {{{
my( $param ) = @_;
# check param
for my $st ( qw/start_status end_status limit registrar/ ) {
unless( defined $param->{$st} ) {
_error( "Status $st is not defined in param ... exiting" );
return;
}
}
_logger( "Startstatus: [" . $param->{start_status} .
"] Endstatus: [" . $param->{end_status} .
"] Limit: [" . $param->{limit} . "]" .
( defined $param->{registrar} && $param->{registrar} ?
" Registrar: [" . $param->{registrar} . " (" .
Database::get_domregistrar( $param->{registrar} ) . ")]" : "" ) );
my $domains = Database::read_domains_by_status( $param->{start_status}, $param->{limit}, $param->{registrar} );
my $num_domains = scalar keys %$domains;
unless( $num_domains ) {
_logger( "Found no domain with status " . $param->{start_status} .
" ... exiting" );
exit 0;
}
_logger( "Found $num_domains Domains" );
# Pre Lock all domains
_logger( "Pre-Lock all Domains" );
my $domainlocks = {};
for my $domainid ( keys %$domains ) {
$domainlocks->{$domainid} = 1;
unless( Database::lock_domain( $domainid ) ) {
_logger( "Could not Lock DomainID $domainid ... delete from record set" );
delete $domains->{$domainid};
delete $domainlocks->{$domainid};
next;
}
}
my $num_domains = scalar keys %$domains;
_logger( "Start working on $num_domains Domains ..." );
$| = 1;
my $counter = 0;
#
# Here will be done actual work ...
#
for my $domainid ( keys %$domains ) {
# reset error
$error = 0;
$lasterror = "";
# Display counter only?
$counter++;
if( $param->{counter} ) {
_counter( $counter, $num_domains )
}
else {
_logger( "Domain: " .
$domains->{$domainid}->{domain} .
" (ID: $domainid)" );
}
# Check if someone pressed CTRL-C
if( $sigintset ) {
_logger( "unlocking all Domains because of SIGINT" );
for my $did ( keys %$domainlocks ) {
unless( Database::unlock_domain( $did ) ) {
_error( "ERR: unlockind $did ...\n" );
}
delete $domainlocks->{$did};
}
last;
}
my $work_data = {
domainid => $domainid,
domain => $domains->{$domainid}->{domain},
domaindata => Database::read_domain_by_id( $domainid, $param->{read_domain_by_id_param} ),
tld => Database::get_domtld( $domains->{$domainid}->{dom_tld} ),
dom => UD::Tools::getdomain( $domains->{$domainid}->{domain} ),
};
my $res = main::do_work( $work_data );
if ( $error > 0 ) {
_logger( "Error found ... do not update migr_status" );
Database::update_error_status( $domainid, $error, $lasterror );
}
else {
unless( Database::upd_migrstatus( $domainid, $param->{end_status} ) ) {
_error( "ERR: Could not update migr_status for Domain " . $work_data->{domain} );
Database::update_error_status( $domainid, $error, $lasterror );
}
}
unless( Database::unlock_domain( $domainid ) ) {
_error( "Err: unlockind $domainid ..." );
Database::update_error_status( $domainid, $error, $lasterror );
}
delete $domainlocks->{$domainid};
}
} # }}}
1;