
| Current Path : /var/www/web-klick.de/dsh/10_customer2017/1183__ud/ |
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/ProcessDomain.pm |
package Process::ProcessDomain;
use strict;
use Data::Dumper;
use Process::BillingDomain;
use AutoTest::AutoTestParam;
use AutoTest::Local;
use Process::InterfaceDomain;
#******************************************************************
sub new {
my $class = shift;
my $self = {};
$self->{'REGNR'} = shift;
$self->{'DBH'} = shift;
$self->{'BILLING'} = Process::BillingDomain->new();
$self->{'AT'} = AutoTest::AutoTestParam->new();
bless($self,$class);
return($self);
}
#**********************************************************************
sub neworder {
my $self = shift;
my $par = shift;
my $text = <<'TEXT_ENDE';
DOMAIN => '---DOMAIN---',
ACCOUNT => '---ACCOUNT---',
STATE => '---ORDER--- at ---TIME---',
TIMESTAMP => '',
AUTHKEY => '---AUTHKEY---',
INTERVAL => '',
RENEWMODE => '',
RENEWDATE => '',
AUTHCODE => '',
NAMESERVER => '-',
OWNER1 => {
firstname => '-',
lastname => '-',
email => '-',
address => '-',
zip => '-',
city => '-',
cc => '-',
houseno => '-',
phone => '-',
fax => '-',
},
ADMIN1 => {
firstname => '-',
lastname => '-',
email => '-',
address => '-',
zip => '-',
city => '-',
cc => '-',
houseno => '-',
phone => '-',
fax => '-',
},
TECH1 => {
firstname => '-',
lastname => '-',
email => '-',
address => '-',
zip => '-',
city => '-',
cc => '-',
houseno => '-',
phone => '-',
fax => '-',
},
ZONE1 => {
firstname => '-',
lastname => '-',
email => '-',
address => '-',
zip => '-',
city => '-',
cc => '-',
houseno => '-',
phone => '-',
fax => '-',
},
BILLING1 => {
firstname => '-',
lastname => '-',
email => '-',
address => '-',
zip => '-',
city => '-',
cc => '-',
houseno => '-',
phone => '-',
fax => '-',
},
TEXT_ENDE
if ($par !~ /^[\n ]*$/) {
$par =~ s/\nACCOUNT( +)\=\>( +)\'(.*?)\'/\nACCOUNT$1\=\>$2\'---ACCOUNT---\'/gs;
$par =~ s/\nAUTHKEY( +)\=\>( +)\'(.*?)\'/\nAUTHKEY$1\=\>$2\'---AUTHKEY---\'/gs;
$par =~ s/\nSTATE( +)\=\>( +)\'(.*?)\'/\nSTATE$1\=\>$2\'---ORDER--- at ---TIME---\'/gs;
# $par =~ s/, *\n +handle +\=\> +\'(.*?)\'//g;
$par =~ s/(DOMAIN|ACCOUNT|STATE|TIMESTAMP|AUTHKEY|UPHOLDMODE|INTERVAL|AUTHCODE|NAMESERVER)( +)\=\>/\:\:\:$1$2\:\:\:/gs;
$par =~ s/([A-Z]+)( +)\=\>([^\{\}]+?)(,|$)//gs;
while ($par =~ s/\n *\n/\n/gs) { 1; }
$par =~ s/\:\:\:([A-Z]+)( +)\:\:\:/$1$2\=\>/gs;
return($par);
}
return($text);
}
#******************************************************************
sub run {
my $self = shift;
my $orders = shift;
my $o; my $o1; my $o2; my $o3; my $o4; my $ee; my $exreg; my $func;
my $action;
my $order; my $domain; my $account; my $zaehler; my $erg; my $order1;
my $bill = $self->{'BILLING'};
my $reg = $self->reg();
my $processed_orders = [];
my $sort_order = {};
my $reg_domains = {};
if ($self->{'PROCESS_POLLS'}) {
$reg->process_polls();
}
foreach $o (@$orders) { # Sort via domain
$o1 = $o->{'DOMAIN'};
if ($o1 eq "process.xx") {
$reg->process_polls();
return([]);
}
if (!($sort_order->{$o1})) {
$sort_order->{$o1} = [];
}
if ($o->{'LOG'} =~ /VOLATILE/ and $o->{'STATE'} !~ /bookup /) {
1;
}
elsif ($o->{'STATE'} =~ /^registered /) {
$reg_domains->{$o1} = $o;
}
else {
push(@{$sort_order->{$o1}},$o);
}
}
foreach $o (keys %$sort_order) { # Synchronize with registry
$o1 = $self->sync_order($reg,$reg_domains->{$o},$o);
if (ref($o1)) { # Fall 1: Domain nur bei Registry bekannt
$reg_domains->{$o} = $o1;
}
# if ($o1->{'EXPIRETIME'} and $o1->{'RENEWALTIME'}) {
# $o2 = $self->timestamp();
#
# if ($o1->{'EXPIRETIME'} ge $o1->{'RENEWALTIME'}) {
# if ($o1->{'UPHOLDMODE'} eq 'renew') {
# if ($o2 ge $o1->{'EXPIRETIME'}) {
# $o3 = $o1->{'___'};
# $o3 = $o1->{'___'};
# $o3 = eval "\{ " . $o1->{'___'} . " \}";
# $o3->{'___'} = $o1->{'___'};
# $o3->{'ACCOUNT'} = "___close___";
# }
# }
# } else {
# if ($o1->{'UPHOLDMODE'} eq 'expire') {
# if ($o2 ge $o1->{'EXPIRETIME'}) {
# $o3 = $o1->{'___'};
# $o3 = eval "\{ " . $o1->{'___'} . " \}";
# $o3->{'___'} = $o1->{'___'};
# $o3->{'ACCOUNT'} = "___close___";
# }
# }
# }
# if ($o3) {
# $o3->{'STATE'} = "register at " . $o2;
# $self->actualize($o3);
# push(@{$sort_order->{$o1}},$o3);
# }
#
# }
}
foreach $o (keys %$sort_order) { # Register
$o3 = <<'TEXT_ENDE';
DOMAIN => '---DOMAIN---',
ACCOUNT => '___registry___',
STATE => 'unregister at ---TIME---',
TIMESTAMP => '',
AUTHKEY => '',
AUTHCODE => '',
NAMESERVER => '-',
LOG => 'POLL 7',
ERROR => 'Transfer Out Request',
TEXT_ENDE
$o3 =~ s/---DOMAIN---/$o/;
$o2 = $self->timestamp();
$o3 =~ s/---TIME---/$o2/;
$o3 =~ s/\'-\'/\'\'/g;
$order1 = eval "\{ " . $o3 . " \}";
$order1->{'___'} = $o3;
foreach $order ( $order1, reverse sort { $a->{'TSTAMP'} cmp
$b->{'TSTAMP'} } @{$sort_order->{$o}}) {
if ($order->{'INTERVAL'}) {
if ($order->{'INTERVAL'} =~ /^(.*)\-(.*)$/) {
$o1 = $self->timestamp();
if ($1 cmp $o1) {
push(@$processed_orders,$order);
next;
}
elsif ($o1 cmp $2) {
next;
}
}
}
if (!($bill->credit($o1))) {
$order->{'ERROR'} = "No credit.";
$order->{'LOG'} = "VOLATILE";
$self->actualize($order,"ERROR");
$self->actualize($order,"LOG");
} else {
$exreg = $reg_domains->{$o};
my $newreg = 0;
if ($order->{'STATE'} =~ /^un/) {
if ($order->{'LOG'} =~ /^POLL +(\d+)/) {
$o3 = $1;
if ($o3 < 10) { $o3 = 0; }
$o2 = $reg->revoke($o3);
if (!$o3) {
if ($o2 == -1) { # Poll not found
$order->{'ERROR'} = "VIRTUALPOLL."
} else {
$order->{'LOG'} =~ s/^POLL +(\d+)/POLL $o2/;
}
} else {
if ($o2 == -1) {
$order->{'STATE'} =~ /^un(\S+)/;
$order->{'STATE'} = $1 . " at " . $self->timestamp();
$order->{'LOG'} = "Action: revoke $1.";
$order->{'ERROR'} = $order->{'ERROR'} .
"\nRevoke of pending action failed.";
} else {
$order->{'LOG'} = "VOLATILE";
$order->{'STATE'} =~ /^un(\S+)/;
$order->{'ERROR'} = "Poll event $o3 to " . $1 .
" revoked.";
}
}
} else {
$order->{'LOG'} = "VOLATILE";
$order->{'STATE'} =~ /^un(\S+)/;
$order->{'ERROR'} = "Attempt to " . $1 . " revoked.";
}
$self->actualize($order,"LOG");
$self->actualize($order,"STATE");
$self->actualize($order,"ERROR");
}
elsif ($order->{'LOG'} =~ /^POLL +(\d+)/) {
$erg = $1;
$erg = $reg->get_poll($erg);
if ($erg) {
$order->{'LOG'} =~ /Action\: +(\S+)\./;
$o1 = $1;
$order->{'LOG'} =~ s/^POLL/PEND/;
$order->{'STATE'} =~ /^(\S+)/;
$order->{'STATE'} = $1 . " at " . $self->timestamp();
$order->{'ERROR'} = "Pending operation $o1 finished. " .
$erg->{'msg'} . "\n" .
$erg->{'msgdetail'};
if ($order->{'ERROR'} =~ /successfully/) {
$newreg = 1;
} else {
if ($order->{'AUTHCODE'} or $order->{'AUTHKEY'}) {
$order->{'LOG'} = "VOLATILE. " . $order->{'LOG'};
} else {
$order->{'LOG'} = "PERSISTENT. " . $order->{'LOG'};
}
}
$self->actualize($order,"ERROR");
$self->actualize($order,"LOG");
$self->actualize($order,"STATE");
}
}
else {
$ee = {};
$change_owner = "";
foreach $o2 (keys %$order,keys %$exreg) {
next if ($o2 !~ /\d$/);
next if ($ee->{$o2});
$ee->{$o2} = 1;
if (!(exists $order->{$o2}) or !(exists $exreg->{$o2})) {
$ee->{$o2} = 2;
} else {
$o3 = Data::Dumper->new([$exreg->{$o2}]);
$o3->Sortkeys(1);
$o3 = $o3->Dump();
$o4 = Data::Dumper->new([$order->{$o2}]);
$o4->Sortkeys(1);
$o4 = $o4->Dump();
if ($o3 ne $o4) {
$ee->{$o2} = 2;
}
}
next if ($ee->{$o2} == 1);
if ($o2 =~ /^OWNER/) {
$change_handles = "trade";
} else {
$change_handles = "update":
last if ($change_owner eq "trade");
}
$action = "noop";
if ( $exreg->{'AUTHKEY'}) and
$exreg->{'AUTHKEY'} ne $order->{'AUTHKEY'} ) {
$order->{'ERROR'} = "AUTHKEY-Mismatch.";
if ($order->{'AUTHCODE'} or $order->{'AUTHKEY'}) {
$order->{'LOG'} = $order->{'LOG'} . "VOLATILE";
} else {
$order->{'LOG'} = $order->{'LOG'} . "PERSISTENT";
}
}
elsif ($exreg->{'ACCOUNT'} =~ /^___registry___$/ and
$order->{'AUTHCODE'} ) {
$action = "transfer";
}
elsif ($order->{'ACCOUNT'} =~ /^___(.*)___$/) {
$action = $1;
}
elsif ($order->{'ACCOUNT'} ne $exreg->{'ACCOUNT'}) {
$action = "change_accounts";
}
elsif ($order->{'PORTFOLIO'} ne $exreg->{'PORTFOLIO'}) {
$action = "change_portfolio";
}
elsif ($order->{'UPHOLDMODE'} ne $exreg->{'UPHOLDMODE'}) {
$action = "change_uphold";
}
elsif ($order->{'NAMESERVER'} ne $exreg->{'NAMESERVER'}) {
$action = "update";
}
elsif ($order->{'AUTHCODE'} ne $exreg->{'AUTHCODE'}) {
$action = "update";
}
elsif ($change_owner eq "trade") {
$action = "trade";
}
elsif ($change_owner eq "update") {
$action = "update";
}
else {
$action = "noop";
}
print "Action: $action\n"; sleep 2;
$order->{'LOG'} = "Action: $action. ";
$self->actualize($order,"LOG");
if ($action eq "change_accounts") {
$order = $exreg;
$order->{'LOG'} = 'Account changed.';
$self->actualize($order,"LOG");
}
elsif ($action eq "noop") {
$order = $exreg;
$order->{'LOG'} = 'No changes.';
$self->actualize($order,"LOG");
}
elsif ($action eq "authkey_mismatch") {
$order->{'ERROR'} = "AUTHKEY-Mismatch.";
if ($order->{'AUTHCODE'} or $order->{'AUTHKEY'}) {
$order->{'LOG'} = $order->{'LOG'} . "VOLATILE";
} else {
$order->{'LOG'} = $order->{'LOG'} . "PERSISTENT";
}
}
else {
$erg = $self->createhandles($reg,$order);
if (!$erg) {
$order->{'ERROR'} = $self->{'___ERROR___'};
delete ($self->{'___ERROR___'});
}
else {
$erg = $reg->$action($erg);
if (!($erg->{'msg'}) and !($erg->{'msgdetail'})) {
$order->{'ERROR'} = "Server-Crash.";
} else {
$order->{'ERROR'} = $erg->{'msg'} . "\n" .
$erg->{'msgdetail'};
}
}
if ($order->{'ERROR'} =~ /Poll number\: +(\d+)/i) {
$order->{'LOG'} = "POLL $1, " . $self->timestamp() .
", " . $order->{'LOG'};
$order->{'INTERVAL'} = "";
$self->actualize($order,"INTERVAL");
}
elsif ($order->{'ERROR'} !~ /successfully/) {
$newreg = 0;
if ($order->{'AUTHCODE'} or $order->{'AUTHKEY'}) {
$order->{'LOG'} = $order->{'LOG'} . "VOLATILE";
} else {
$order->{'LOG'} = $order->{'LOG'} . "PERSISTENT";
}
}
else {
$newreg = 1;
}
$order->{'ERROR'} =~ s/[\'\"]/ /g;
$self->actualize($order,"ERROR");
}
}
else {
$order->{'ERROR'} = "AUTHKEY-Mismatch.";
if ($order->{'AUTHCODE'} or $order->{'AUTHKEY'}) {
$order->{'LOG'} = $order->{'LOG'} . "VOLATILE";
} else {
$order->{'LOG'} = $order->{'LOG'} . "PERSISTENT";
}
}
$self->actualize($order,"ERROR");
$self->actualize($order,"LOG");
}
if ($newreg == 1) {
$order->{'INTERVAL'} = "";
$self->actualize($order,"INTERVAL");
$order->{'STATE'} = "registered at " . $self->timestamp();
$reg_domains->{$o} = $order;
$erg = $self->sync_order($reg,$order,$o);
if (ref($erg)) {
if ($erg->{'ACCOUNT'} =~ /^___(registry|foreign)___$/) {
delete($reg_domains->{$o});
} else {
$order->{'ERROR'} = "Fehler in ProcessDomain\n";
$order->{'LOG'} = $order->{'LOG'} . "VOLATILE";
}
}
if ($order->{'EXPIREDATE'} =~ /^(\d\d\d\d)\-(\d\d)\-(\d\d)T(\d\d)\:(\d\d)\:(\d\d)$/) {
$order->{'EXPIRETIME'} = timelocal($6,$5,$4,$3,$2,$1);
if (!($order->{'RENEWALTIME'})) {
$order->{'RENEWALTIME'} = $order->{'EXPIRETIME'} - 20*86400;
}
}
if ($order->{'RENEWALDATE'} =~ /^(\d\d\d\d)\-(\d\d)\-(\d\d)T(\d\d)\:(\d\d)\:(\d\d)$/) {
$order->{'RENEWALTIME'} = AutoTest::Local->timelocal($6,$5,$4,$3,$2,$1);
if (!($order->{'EXPIRETIME'})) {
$order->{'EXPIRETIME'} = $order->{'EXPIRETIME'} - 20*86400;
}
}
if ($order->{'EXPIRETIME'} and $order->{'RENEWALTIME'}) {
if ($self->{'EXPIRETIME'} > $self->{'RENEWALTIME'}) {
$self->{'RENEWALTIME'} = $self->{'RENEWALTIME'} - 5*86400;
} else {
$self->{'EXPIRETIME'} = $self->{'EXPIRETIME'} - 5*86400;
}
$order->{'EXPIRETIME'} = $self->timestamp($order->{'EXPIRETIME'});
$order->{'RENEWALTIME'} = $self->timestamp($order->{'RENEWALTIME'});
}
$self->actualize($order);
}
}
if ($order->{'STATE'} !~ /^registered / and
$order->{'ERROR'} !~ /^VIRTUALPOLL/) {
push(@$processed_orders,$order);
}
}
if ($reg_domains->{$o} and
$reg_domains->{$o}->{'ACCOUNT'} !~ /^___(registry|foreign)___$/) {
push(@$processed_orders,$reg_domains->{$o});
}
}
# 99. ---- Clean ----
# push(@$processed_orders,values %$orders);
foreach $o (@$processed_orders) {
delete $o->{'___TEMP_TIME___'};
}
return($processed_orders);
}
#**********************************************************************
sub sync_order {
my $self = shift;
my $reg = shift;
my $order = shift; # Aktuelle vermutete Registrierung
my $domain = shift; # Domain, um die es geht
my $o; my $o1; my $o2; my $o3; my $o4;
my $handlenr; my $zaehler; my $field;
my $erg; my $result;
return("___DOMAIN_NOT_FOUND___") if (!$domain);
$erg = $reg->get_domain_data($domain);
if (!$order) {
$o = $self->neworder();
$o =~ s/---AUTHKEY---//;
$o2 = "registered"; $o =~ s/---ORDER---/$o2/;
$o2 = $domain; $o =~ s/---DOMAIN---/$o2/;
$o2 = $self->timestamp(); $o =~ s/---TIME---/$o2/;
$o =~ s/\'-\'/\'\'/g;
$order = eval "\{ " . $o . " \}";
$order->{'___'} = $o;
}
if (!($erg->{'msg'}) or ($erg->{'msg'} =~ /No connection/) or
($erg->{'msg'}.$erg->{'msgdetail'}) =~
/(does not exist|failed|No route)/i) {
# print "ERG: " . Dumper($erg) . "\n"; sleep 5;
$order->{'ACCOUNT'} = "___foreign___";
if (($erg->{'msg'}.$erg->{'msgdetail'}) =~ /does not exist/) {
$order->{'ACCOUNT'} = "___registry___";
}
$order->{'AUTHKEY'} = "";
foreach $o1 (keys %$order) {
delete ($order->{$o1}) if (ref($order->{$o1} eq "HASH"));
}
delete ($order->{'NAMESERVER'});
$self->actualize($order);
return($order);
}
# Ab jetzt: Domain gefunden bei Registry
my $data = $erg->{'data'};
$erg = {};
$result = "___UNCHANGED___";
foreach $o (keys %{$data}) { # Auslesen der Handles
$o1 = $data->{$o};
$o1 =~ s/,//gs;
$o1 =~ s/\n//gs;
next if ($o1 !~ /^\d+$/);
$o1 = $data->{$o};
$o1 =~ s/\n/,/gs;
foreach $handlenr (split(/,/,$o1)) {
next if ($erg->{$handlenr});
$o2 = $reg->get_handle_data($handlenr);
next if ($o2->{'msg'} !~ /successfully/ or
$o2->{'msg'} =~ /warnings/);
$erg->{$handlenr} = $o2->{'data'};
}
}
$o3 = {};
foreach $o (keys %{$data}, keys %{$order}) { # Update der Order
next if ($o =~ /^(DOMAIN|ACCOUNT|AUTHKEY|LOG|STATE|TIMESTAMP)$/);
next if ($o =~ /^(ERROR|INTERVAL|UPHOLDMODE)$/);
next if ($o =~ /^___$/);
next if ($o3->{$o});
$o3->{uc($o)} = 1;
$o1 = $data->{$o};
$o1 =~ s/,/\n/gs;
$o1 =~ s/\n*(.*?)\n*/$1/s;
if ($o1 =~ /^[0-9\n]+$/ and ($o ne "AUTHCODE")) {
$zaehler = 0;
foreach $o2 (split(/\n/,$o1)) {
$zaehler = $zaehler + 1;
$data->{uc($o.$zaehler)} = $erg->{$o2};
}
} else {
if (ref($data->{$o})) {
foreach $o4 (keys %{$data->{$o}},keys %{$order->{$o}}) {
next if ($o3->{uc($o).".".$o4});
$o3->{uc($o).".".$o4} = 1;
if ($data->{$o}->{$o4}) {
if (!($order->{uc($o)})) { $order->{$o} = {}; }
if ($data->{$o}->{$o4} ne $order->{$o}->{$o4}) {
$order->{$o}->{$o4} = $data->{$o}->{$o4};
$result = "___UPDATED___";
}
} else {
if ($order->{$o}->{$o4}) {
$result = "___UPDATED___";
}
delete($order->{$o}->{$o4});
if (!%{$order->{$o}}) { delete ($order->{$o}); }
}
}
}
elsif ($data->{$o}) {
if ($order->{uc($o)} ne $data->{$o}) {
$order->{uc($o)} = $data->{$o};
$result = "___UPDATED___";
}
}
else {
if ($order->{$o}) {
$result = "___UPDATED___";
}
$order->{$o} = "";
if ($o !~ /^(AUTHCODE)$/) {
delete ($order->{$o});
}
}
}
}
if ($result eq "___UPDATED___") {
$order->{"NAMESERVER"} =~ s/\n/,/gs;
$self->actualize($order);
}
if ($order->{'ACCOUNT'} eq "---ACCOUNT---") {
$order->{'ACCOUNT'} = "default";
$self->actualize($order,"ACCOUNT");
$order->{'AUTHKEY'} = "___default___";
$self->actualize($order,"AUTHKEY");
return($order);
}
return($result);
}
#**********************************************************************
sub log {
my $self = shift;
my $text = shift;
print $text;
}
#**********************************************************************
sub createhandles {
my $self = shift;
my $reg = shift;
my $order = shift;
my $erg = {};
my $o; my $o1; my $o2; my $o3; my $contact; my $contacts;
my $at = $self->{'AT'};
$self->{'___ERROR___'} = "";
foreach $o (keys %$order) {
if (ref($order->{$o}) eq "HASH") {
$contact = {%{$order->{$o}}};
$contacts->{$o} = $contact;
if ($contact->{'company'} eq "-") {
$contact->{'company'} = "---5,18,A.z---";
}
if ($contact->{'firstname'} eq "-") {
$contact->{'firstname'} = "---5,18,A.z---";
}
if ($contact->{'lastname'} eq "-") {
$contact->{'lastname'} = "---5,18,A.z---";
}
if ($contact->{'email'} eq "-") {
$contact->{'email'} = "---5,15,A.z---\@---5,18,A.z---.de";
}
if ($contact->{'address'} eq "-") {
$contact->{'address'} = "---5,18,A.z---";
}
if ($contact->{'zip'} eq "-") {
$contact->{'zip'} = "---10000-99999---";
}
if ($contact->{'city'} eq "-") {
$contact->{'city'} = "---5,18,A.z---";
}
if ($contact->{'cc'} eq "-") {
$contact->{'cc'} = "DE";
}
if ($contact->{'houseno'} eq "-") {
$contact->{'houseno'} = "---1-999---";
}
if ($contact->{'phone'} eq "-") {
$contact->{'phone'} = "+" . "---1000000-9999999---";
}
if ($contact->{'fax'} eq "-") {
$contact->{'fax'} = "+" . "---1000000-9999999---";
}
foreach $o1 (keys %$contact) {
$o2 = $contact->{$o1};
while ($o2 =~ s/---(.*?)---/___X_Y_Z___/) {
$o3 = $1;
if ($o3 =~ /^(\d+),(\d+),(.*)$/) {
$o3 = join("",$at->sets("x".join("",$at->sets("0$1-$2")),$3));
} else {
$o3 = join("",$at->sets($o3));
}
$o2 =~ s/___X_Y_Z___/$o3/;
}
$contact->{$o1} = $o2;
}
if (!($contact->{'cc'})) { $contact->{'cc'} = $contact->{'ccode'}; }
$o1 = lc($o);
$o1 =~ s/\d//g;
if (!($contact->{'handle'})) {
$self->log("Create Handle with:\n\n");
$self->log(Dumper($contact));
$self->log("Result:\n\n");
$o2 = $reg->create_handle($contact);
$self->log(Dumper($o2) . "\n-----------------------------------------\n\n");
if ($o2->{'msg'} !~ /successfully/ or
$o2->{'msg'} =~ /warnings/) {
$self->{'___ERROR___'} = $o2->{'msg'} . "\n" .
$o2->{'msgdetail'};
return("");
}
} else {
$o2 = { 'contact' => $contact->{'handle'} };
}
if (!($erg->{$o1})) {
$erg->{$o1} = $o2->{'contact'};
} else {
$erg->{$o1} = $erg->{$o1} . "\n" . $o2->{'contact'};
}
}
}
foreach $o (keys %$order) {
if (ref($order->{$o}) eq "HASH") {
foreach $o1 (keys %{$order->{$o}}) {
if ($order->{$o}->{$o1} ne $contacts->{$o}->{$o1}) {
$order->{$o}->{$o1} = $contacts->{$o}->{$o1};
}
}
}
}
$self->actualize($order);
if ($order->{'NAMESERVER'} eq "-") {
$order->{'NAMESERVER'} = "ns1.sedoparking.com,ns2.sedoparking.com";
$self->actualize($order,"NAMESERVER");
}
$erg->{'domain'} = $order->{'DOMAIN'};
$erg->{'nameserver'} = $order->{'NAMESERVER'};
$erg->{'nameserver'} =~ s/ //gs;
$erg->{'nameserver'} =~ s/,/\n/gs;
$erg->{'nameserver'} =~ s/\n\n/\n/gs;
$erg->{'nameserver'} =~ s/\n\n/\n/gs;
$erg->{'nameserver'} =~ s/\n\n/\n/gs;
$erg->{'nameserver'} =~ s/\n\n/\n/gs;
$erg->{'nameserver'} =~ s/^(\n*)(.*)(\n*)$/$2/gs;
$erg->{'authcode'} = $order->{'AUTHCODE'};
$erg->{'authcode'} =~ s/___request___//;
$order->{'ERROR'} = $self->{'___ERROR___'};
$self->actualize($order,"ERROR");
return($erg);
}
#**********************************************************************
sub get_poll {
my $self = shift;
my $text = "";
my $erg; my $o;
while (0 == 0) {
my $erg = $self->{'IF'}->request_poll();
last if (!$erg);
$self->{'IF'}->verify_poll();
$o = $self->neworder("poll");
$o =~ s/---RAWDATA---/$erg/;
$text = $text . "\n\n" . $o . "\n";
}
return($text);
}
#**********************************************************************
sub actualize {
my $self = shift;
my $order = shift;
my $field = shift;
my $field1 = shift;
my $o; my $o1; my $o2; my $o3;
my $newdump = 0;
if (!$field) {
$newdump = 1;
} else {
if (!$field1) {
$o = $order->{$field};
if (!( exists $order->{$field} )) {
$newdump = 1;
}
elsif ($order->{'___'} !~ s/$field( *)\=\>( *)\'(.*?)\'/$field$1\=\>$2\'$o\'/) {
$newdump = 1;
}
} else {
$o = $order->{$field1};
if (!( exists $order->{$field1})) {
$newdump = 1;
}
elsif (!( exists $order->{$field1}->{$field})) {
$newdump = 1;
}
else {
$o = $order->{$field1}->{$field};
}
if ( $order->{'___'} !~ s/$field1(.*?)\n( +)$field( *)\=\>( *)\'(.*?)\'/$field1$1\n$2$field$3\=\>$4\'$o\'/s) {
$newdump = 1;
}
}
}
if ($newdump) {
my $ee = {};
my $series1 = [];
my $nr = {};
my $series2 = [];
my $series3 = [];
my $model1 = "";
my $model2 = "";
my $model3 = "";
my $order1 = $order->{'___'};
delete ($order->{'___'});
my $model4 = " \}";
if ($order1 =~ /\n( +)\}/) {
$model4 = $1 . "\}";
}
my $order2 = Dumper($order);
$order2 =~ s/ \'//g;
$order2 =~ s/\' \=\>/ \=\>/g;
foreach $o (split(/\n/,$order1.$order2)) {
next if ($o !~ /^( *)(.*?)( +)\=\>/);
$o = $1;
$o1 = $2;
$o2 = $3;
$o3 = "";
next if ($o1 eq "___TEMP_TIME___");
if ($o1 =~ /^(.*?)(\d+)$/) {
$o3 = $2;
$o1 = $1;
if ($nr->{$o1} < $o3) { $nr->{$o1} = $o3; }
}
next if (exists ($ee->{uc($o1)}));
$ee->{uc($o1)} = 1;
if ($o =~ /^ /) {
if (!$model2) { $model2 = $o; $model3 = $o1.$o2; }
push(@$series2,$o1);
} else {
if (!$model1) { $model1 = $o1.$o2; }
if ($o3) {
push(@$series1,$o1);
} else {
push(@$series3,$o1);
}
}
}
$ee = [];
foreach $o (@$series1) {
$o1 = 0;
if (exists $nr->{$o}) {
while ($o1 < $nr->{$o}) {
$o1 = $o1 + 1;
push(@$ee,$o.$o1);
}
} else {
push(@$ee,$o);
}
}
my $d = Data::Dumper->new([$order]);
$d->Sortkeys( sub { [@$series3,@$ee,@$series2] } );
$o = $d->Dump();
while ( $o =~ s/\n([^\n]*?)undef(,?)\n/\n/gs) { 1; }
$o =~ s/\n( *) \'/\n$1/gs;
$o =~ s/\' \=\>/ \=\>/g;
$o =~ s/,\n( *)\}/\n$1\}/gs;
$o =~ s/^(.*?)\n//s;
$o =~ s/^(.*)\n(.*?)\n/$1\n/s;
$ee = "";
$model1 =~ s/./ /g;
$model3 =~ s/./ /g;
foreach $o1 (split(/\n/,$o)) {
if ($o1 =~ s/^ +(.*?) +\=\>/___X_Y_Z___/) {
$o2 = $1;
$o3 = length($model3);
if (length($o2." ") > $o3) {
$o3 = length($o2." ");
}
$o2 = $model2 . substr($o2.$model3,0,$o3) . "\=\>";
$o1 =~ s/___X_Y_Z___/$o2/;
}
elsif ($o1 =~ s/^(.*?) +\=\>/___X_Y_Z___/) {
$o2 = $1;
$o3 = length($model1);
if (length($o2." ") > $o3) {
$o3 = length($o2." ");
}
$o2 = substr($o2.$model1,0,$o3) . "\=\>";
$o1 =~ s/___X_Y_Z___/$o2/;
}
$ee = $ee . $o1 . "\n";
}
$ee =~ s/\n +\}/\n$model4/gs;
$order->{'___'} = $ee;
}
}
#**********************************************************************
sub timestamp {
my $self = shift;
my $o = shift;
if (!$o) {
$o = time();
}
$o = sprintf("%04u",(localtime($o))[5]+1900) .
sprintf("%02u",(localtime($o))[4]+1) .
sprintf("%02u",(localtime($o))[3]) . "_" .
sprintf("%02u",(localtime($o))[2]) .
sprintf("%02u",(localtime($o))[1]) .
sprintf("%02u",(localtime($o))[0]);
return($o);
}
#**********************************************************************
sub reg {
my $self = shift;
my $par = shift;
if (!$par) {
$par = $self->{'REGNR'};
}
delete($self->{'PROCESS_POLLS'});
if (!($self->{'___REG'.$par.'___'})) {
if ($par == 1) {
$self->{'___REG'.$par.'___'} =
Process::InterfaceDomain->new("test",$self->{'DBH'});
$self->{'PROCESS_POLLS'} = 1;
}
elsif ($par == 2) {
$self->{'___REG'.$par.'___'} =
Process::InterfaceDomain->new("test1",$self->{'DBH'});
$self->{'PROCESS_POLLS'} = 1;
}
elsif ($par == 11) {
$self->{'___REG'.$par.'___'} =
Process::InterfaceUDAG->new("udb",$self->{'DBH'});
$self->{'PROCESS_POLLS'} = 1;
}
elsif ($par == 97) {
$self->{'___REG'.$par.'___'} =
Process::InterfaceDomain->new("reloaded",$self->{'DBH'});
}
elsif ($par == 98) {
$self->{'___REG'.$par.'___'} =
Process::InterfaceDomain->new("udag",$self->{'DBH'});
}
elsif ($par == 99) {
$self->{'___REG'.$par.'___'} =
Process::InterfaceDomain->new("",$self->{'DBH'});
}
}
return($self->{'___REG'.$par.'___'});
}
#**********************************************************************
#**********************************************************************
1;