Hide Show 42 lines of Pod
sub
register_commands {
my
(
$class
,
$version
) =
@_
;
my
%tmp
= (
noretrieve
=> [ \
&pollreq
, \
&parse_poll
],
nodelete
=> [ \
&pollack
, \
&Net::DRI::Protocol::EPP::Extensions::NO::Result::condition_parse
],
);
return
{
'message'
=> \
%tmp
};
}
sub
facet {
my
(
$epp
,
$rd
) =
@_
;
return
Net::DRI::Protocol::EPP::Extensions::NO::Host::build_facets(
$epp
,
$rd
);
}
sub
pollack {
my
(
$epp
,
$msgid
,
$rd
) =
@_
;
my
$mes
=
$epp
->message();
my
$r
= (
$mes
->command( [ [
'poll'
, {
op
=>
'ack'
,
msgID
=>
$msgid
} ] ] ) );
if
(
defined
(
$rd
->{facets}) &&
$rd
->{facets}) {
$r
= facet(
$epp
,
$rd
);
}
return
$r
;
}
sub
pollreq {
my
(
$epp
,
$rd
) =
@_
;
my
$mes
=
$epp
->message();
my
$r
= (
$mes
->command( [ [
'poll'
, {
op
=>
'req'
} ] ] ) );
if
(
defined
(
$rd
->{facets}) &&
$rd
->{facets}) {
$r
= facet(
$epp
,
$rd
);
}
return
$r
;
}
sub
parse_resp_result
{
my
(
$node
,
$NS
,
$rinfo
,
$msgid
)=
@_
;
push
@{
$rinfo
->{message}->{
$msgid
}->{results}},Net::DRI::Protocol::EPP::Util::parse_node_result(
$node
,
$NS
,
'no'
);
return
;
}
sub
transfer_resp_parse {
my
(
$po
,
$trndata
,
$oname
,
$rinfo
,
$msgid
)=
@_
;
return
unless
$trndata
;
foreach
my
$el
(Net::DRI::Util::xml_list_children(
$trndata
))
{
my
(
$name
,
$c
)=
@$el
;
if
(
$name
eq
'name'
) {
$oname
=
lc
(
$c
->textContent());
$rinfo
->{message}->{
$msgid
}->{domain}->{
$oname
}->{action}=
'transfer'
;
$rinfo
->{message}->{
$msgid
}->{domain}->{
$oname
}->{exist}=1;
}
elsif
(
$name
=~m/^(trStatus|reID|acID)$/mx) {
$rinfo
->{message}->{
$msgid
}->{domain}->{
$oname
}->{$1}=
$c
->textContent()
if
(
$c
->getFirstChild());
}
elsif
(
$name
=~m/^(reDate|acDate|exDate)$/mx) {
$rinfo
->{message}->{
$msgid
}->{domain}->{
$oname
}->{$1}=
$po
->parse_iso8601(
$c
->textContent());
}
}
return
;
}
sub
contact_resp_parse {
my
(
$po
,
$credata
,
$oname
,
$rinfo
,
$msgid
)=
@_
;
return
unless
$credata
;
foreach
my
$el
(Net::DRI::Util::xml_list_children(
$credata
))
{
my
(
$name
,
$c
)=
@$el
;
if
(
$name
eq
'id'
)
{
my
$new
=
$c
->getFirstChild()->getData();
$rinfo
->{message}->{
$msgid
}->{contact}->{
$oname
}->{id}=
$new
if
(
defined
(
$oname
) && (
$oname
ne
$new
));
$oname
=
$new
;
$rinfo
->{message}->{
$msgid
}->{contact}->{
$oname
}->{id}=
$oname
;
$rinfo
->{message}->{
$msgid
}->{contact}->{
$oname
}->{action}=
'create'
;
$rinfo
->{message}->{
$msgid
}->{contact}->{
$oname
}->{exist}=1;
}
elsif
(
$name
=~m/^(crDate)$/)
{
$rinfo
->{message}->{
$msgid
}->{contact}->{
$oname
}->{$1}=
$po
->parse_iso8601(
$c
->textContent());
}
}
return
;
}
sub
parse_poll {
my
(
$po
,
$otype
,
$oaction
,
$oname
,
$rinfo
) =
@_
;
my
$mes
=
$po
->message();
my
$eppNS
=
$mes
->ns(
'epp'
);
my
$NS
=
$mes
->ns(
'no-ext-result'
);
return
unless
$mes
->is_success();
return
if
$mes
->result_is(
'COMMAND_SUCCESSFUL_QUEUE_EMPTY'
);
my
$msgid
=
$mes
->msg_id();
$rinfo
->{message}->{session}->{last_id} =
$msgid
;
my
$mesdata
=
$mes
->get_response(
'no-ext-result'
,
'message'
);
$rinfo
->{
$otype
}->{
$oname
}->{message} =
$mesdata
;
return
unless
$mesdata
;
my
(
$epp
,
$rep
,
$ext
,
$ctag
,
@conds
,
@tags
);
my
$command
=
$mesdata
->getAttribute(
'type'
);
@tags
=
$mesdata
->getElementsByTagNameNS(
$NS
,
'desc'
);
if
(
@tags
&&
$tags
[0]->getFirstChild() &&
$tags
[0]->getFirstChild()->getData()) {
$rinfo
->{message}->{
$msgid
}->{nocontent} =
$tags
[0]->getFirstChild()->getData();
}
@tags
=
$mesdata
->getElementsByTagNameNS(
$NS
,
'data'
);
return
unless
@tags
;
my
$data
=
$tags
[0];
foreach
my
$result
(
$data
->getElementsByTagNameNS(
$eppNS
,
'result'
)) {
parse_resp_result(
$result
,
$eppNS
,
$rinfo
,
$msgid
);
}
@tags
=
$data
->getElementsByTagNameNS(
$NS
,
'entry'
);
foreach
my
$entry
(
@tags
) {
next
unless
(
defined
(
$entry
->getAttribute(
'name'
) ) );
if
(
$entry
->getAttribute(
'name'
) eq
'objecttype'
) {
$rinfo
->{message}->{
$msgid
}->{object_type}
=
$entry
->getFirstChild()->getData();
}
elsif
(
$entry
->getAttribute(
'name'
) eq
'command'
) {
$rinfo
->{message}->{
$msgid
}->{action}
=
$entry
->getFirstChild()->getData();
}
elsif
(
$entry
->getAttribute(
'name'
) eq
'objectname'
) {
$rinfo
->{message}->{
$msgid
}->{object_id}
=
$entry
->getFirstChild()->getData();
}
elsif
(
$entry
->getAttribute(
'name'
) =~ /^(domain|contact|host)$/mx )
{
$rinfo
->{message}->{
$msgid
}->{object_type} = $1;
$rinfo
->{message}->{
$msgid
}->{object_id}
=
$entry
->getFirstChild()->getData();
}
}
$rinfo
->{message}->{
$msgid
}->{action} ||=
$command
;
if
(
my
$trid
=((
$data
->getElementsByTagNameNS(
$eppNS
,
'trID'
))[0])) {
my
$tmp
=Net::DRI::Util::xml_child_content(
$trid
,
$eppNS
,
'clTRID'
);
$rinfo
->{message}->{
$msgid
}->{trid}->{cltrid} =
$tmp
if
defined
(
$tmp
);
$tmp
= Net::DRI::Util::xml_child_content(
$trid
,
$eppNS
,
'svTRID'
);
$rinfo
->{message}->{
$msgid
}->{trid}->{svtrid} =
$tmp
if
defined
(
$tmp
);
}
if
(
my
$infdata
=
$mes
->get_response(
'domain'
,
'infData'
)) {
Net::DRI::Protocol::EPP::Core::Domain::info_parse(
$po
,
'domain'
,
'info'
,
$oname
,
$rinfo
);
if
(
defined
(
$rinfo
->{domain}) &&
$rinfo
->{domain}) {
$rinfo
->{message}->{
$msgid
}->{domain} =
$rinfo
->{domain};
delete
(
$rinfo
->{domain});
}
}
if
(
my
$trndata
= ((
$data
->getElementsByTagNameNS(
$mes
->ns(
'domain'
),
'trnData'
))[0])) {
transfer_resp_parse(
$po
,
$trndata
,
$oname
,
$rinfo
,
$msgid
);
}
if
(
my
$credata
= ((
$data
->getElementsByTagNameNS(
$mes
->ns(
'contact'
),
'creData'
))[0])) {
contact_resp_parse(
$po
,
$credata
,
$oname
,
$rinfo
,
$msgid
);
}
if
(
my
$condata
=
$mes
->get_extension(
'no-ext-contact'
,
'infData'
)) {
Net::DRI::Protocol::EPP::Extensions::NO::Contact::parse_info(
$po
,
'contact'
,
'info'
,
$oname
,
$rinfo
);
if
(
defined
(
$rinfo
->{contact}) &&
$rinfo
->{contact}) {
$rinfo
->{message}->{
$msgid
}->{contact} =
$rinfo
->{contact};
delete
(
$rinfo
->{contact});
}
}
if
(
my
$condata
=
$mes
->get_extension(
'no-ext-host'
,
'infData'
)) {
Net::DRI::Protocol::EPP::Extensions::NO::Host::parse_info(
$po
,
'host'
,
'info'
,
$oname
,
$rinfo
);
if
(
defined
(
$rinfo
->{host}) &&
$rinfo
->{host}) {
$rinfo
->{message}->{
$msgid
}->{host} =
$rinfo
->{host};
delete
(
$rinfo
->{host});
}
}
my
$innerepp
=
$data
->getElementsByTagNameNS(
$eppNS
,
'epp'
)->
shift
();
my
$condata
;
if
(
defined
(
$innerepp
) && (
$condata
=
$innerepp
->getElementsByTagNameNS(
$NS
,
'conditions'
))) {
Net::DRI::Protocol::EPP::Extensions::NO::Result::parse(
$mes
,
$otype
,
$oname
,
$rinfo
,
$condata
->
shift
());
if
((
defined
(
$rinfo
->{
$otype
}->{
$oname
}->{conditions})) &&
$rinfo
->{
$otype
}->{
$oname
}->{conditions}) {
$rinfo
->{message}->{
$msgid
}->{conditions} =
$rinfo
->{
$otype
}->{
$oname
}->{conditions};
}
}
return
1;
}
1;