view release on metacpan or  search on metacpan

lib/Net/DRI/Protocol/EPP/Core/Contact.pm  view on Meta::CPAN

{
 my ($po,$otype,$oaction,$oname,$rinfo)=@_;
 my $mes=$po->message();
 return unless $mes->is_success();

 my $trndata=$mes->get_response('contact','trnData');
 return unless defined $trndata;

 foreach my $el (Net::DRI::Util::xml_list_children($trndata))
 {
  my ($name,$c)=@$el;
  if ($name eq 'id')
  {
   $oname=$c->textContent();
   $rinfo->{contact}->{$oname}->{id}=$oname;
   $rinfo->{contact}->{$oname}->{action}='transfer';
   $rinfo->{contact}->{$oname}->{exist}=1;
  } elsif ($name=~m/^(trStatus|reID|acID)$/)
  {
   $rinfo->{contact}->{$oname}->{$1}=$c->textContent();
  } elsif ($name=~m/^(reDate|acDate)$/)
  {
   $rinfo->{contact}->{$oname}->{$1}=$po->parse_iso8601($c->textContent());
  }
 }
}

############ Transform commands

sub build_authinfo
{
 my $contact=shift;
 my $az=$contact->auth();
 return () unless ($az && ref($az) && exists($az->{pw}));
 return ['contact:authInfo',['contact:pw',$az->{pw}]];
}

sub build_disclose
{
 my $contact=shift;
 my $d=$contact->disclose();
 return () unless ($d && ref($d));
 my %v=map { $_ => 1 } values(%$d);
 return () unless (keys(%v)==1); ## 1 or 0 as values, not both at same time
 my @d;
 push @d,['contact:name',{type=>'int'}] if (exists($d->{name_int}) && !exists($d->{name}));
 push @d,['contact:name',{type=>'loc'}] if (exists($d->{name_loc}) && !exists($d->{name}));
 push @d,['contact:name',{type=>'int'}],['contact:name',{type=>'loc'}] if exists($d->{name});
 push @d,['contact:org',{type=>'int'}] if (exists($d->{org_int}) && !exists($d->{org}));
 push @d,['contact:org',{type=>'loc'}] if (exists($d->{org_loc}) && !exists($d->{org}));
 push @d,['contact:org',{type=>'int'}],['contact:org',{type=>'loc'}] if exists($d->{org});
 push @d,['contact:addr',{type=>'int'}] if (exists($d->{addr_int}) && !exists($d->{addr}));
 push @d,['contact:addr',{type=>'loc'}] if (exists($d->{addr_loc}) && !exists($d->{addr}));
 push @d,['contact:addr',{type=>'int'}],['contact:addr',{type=>'loc'}] if exists($d->{addr});
 push @d,['contact:voice'] if exists($d->{voice});
 push @d,['contact:fax']   if exists($d->{fax});
 push @d,['contact:email'] if exists($d->{email});
 return ['contact:disclose',@d,{flag=>(keys(%v))[0]}];
}

sub build_cdata
{
 my ($contact,$v)=@_;
 my $hasloc=$contact->has_loc();
 my $hasint=$contact->has_int();
 if ($hasint && !$hasloc && (($v & 5) == $v))
 {
  $contact->int2loc();
  $hasloc=1;
 } elsif ($hasloc && !$hasint && (($v & 6) == $v))
 {
  $contact->loc2int();
  $hasint=1;
 }

 my (@postl,@posti,@addrl,@addri);
 _do_locint(\@postl,\@posti,$contact,'name');
 _do_locint(\@postl,\@posti,$contact,'org');
 _do_locint(\@addrl,\@addri,$contact,'street');
 _do_locint(\@addrl,\@addri,$contact,'city');
 _do_locint(\@addrl,\@addri,$contact,'sp');
 _do_locint(\@addrl,\@addri,$contact,'pc');
 _do_locint(\@addrl,\@addri,$contact,'cc');
 push @postl,['contact:addr',@addrl] if @addrl;
 push @posti,['contact:addr',@addri] if @addri;

 my @d;
 push @d,['contact:postalInfo',@postl,{type=>'loc'}] if (($v & 5) && $hasloc); ## loc+int OR loc
 push @d,['contact:postalInfo',@posti,{type=>'int'}] if (($v & 6) && $hasint); ## loc+int OR int

 push @d,Net::DRI::Protocol::EPP::Util::build_tel('contact:voice',$contact->voice()) if defined($contact->voice());
 push @d,Net::DRI::Protocol::EPP::Util::build_tel('contact:fax',$contact->fax()) if defined($contact->fax());
 push @d,['contact:email',$contact->email()] if defined($contact->email());
 push @d,build_authinfo($contact);
 push @d,build_disclose($contact);

 return @d;
}

sub _do_locint
{
 my ($rl,$ri,$contact,$what)=@_;
 my @tmp=$contact->$what();
 return unless @tmp;
 if ($what eq 'street')
 {
  if (defined($tmp[0])) { foreach (@{$tmp[0]}) { push @$rl,['contact:street',$_]; } };
  if (defined($tmp[1])) { foreach (@{$tmp[1]}) { push @$ri,['contact:street',$_]; } };
 } else
 {
  if (defined($tmp[0])) { push @$rl,['contact:'.$what,$tmp[0]]; }
  if (defined($tmp[1])) { push @$ri,['contact:'.$what,$tmp[1]]; }
 }
}

sub create
{
 my ($epp,$contact)=@_;
 my $mes=$epp->message();
 my @d=build_command($mes,'create',$contact);

 Net::DRI::Exception->die(1,'protocol/EPP',10,'Invalid contact '.$contact) unless Net::DRI::Util::isa_contact($contact);
 $contact->validate(); ## will trigger an Exception if needed
 push @d,build_cdata($contact,$epp->{contacti18n});
 $mes->command_body(\@d);
}

sub create_parse
{
 my ($po,$otype,$oaction,$oname,$rinfo)=@_;
 my $mes=$po->message();
 return unless $mes->is_success();

 my $credata=$mes->get_response('contact','creData');
 return unless defined $credata;

 foreach my $el (Net::DRI::Util::xml_list_children($credata))
 {
  my ($name,$c)=@$el;
  if ($name eq 'id')
  {
   my $new=$c->textContent();
   $rinfo->{contact}->{$oname}->{id}=$new if (defined $oname && ($oname ne $new)); ## registry may give another id than the one we requested or not take ours into account at all !
   $oname=$new;
   $rinfo->{contact}->{$oname}->{id}=$oname;
   $rinfo->{contact}->{$oname}->{action}='create';
   $rinfo->{contact}->{$oname}->{exist}=1;
  } elsif ($name=~m/^(crDate)$/)
  {
   $rinfo->{contact}->{$oname}->{$1}=$po->parse_iso8601($c->textContent());
  }
 }
}

sub delete
{
 my ($epp,$contact)=@_;
 my $mes=$epp->message();
 my @d=build_command($mes,'delete',$contact);
 $mes->command_body(\@d);
}

sub transfer_request
{
 my ($epp,$c)=@_;
 my $mes=$epp->message();
 my @d=build_command($mes,['transfer',{'op'=>'request'}],$c);
 $mes->command_body(\@d);
}

sub transfer_cancel
{
 my ($epp,$c)=@_;
 my $mes=$epp->message();
 my @d=build_command($mes,['transfer',{'op'=>'cancel'}],$c);
 $mes->command_body(\@d);
}

sub transfer_answer
{
 my ($epp,$c,$approve)=@_;
 my $mes=$epp->message();
 my @d=build_command($mes,['transfer',{'op'=>((defined($approve) && $approve)? 'approve' : 'reject' )}],$c);
 $mes->command_body(\@d);
}

sub update
{
 my ($epp,$contact,$todo)=@_;
 my $mes=$epp->message();

 Net::DRI::Exception::usererr_invalid_parameters($todo.' must be a non empty Net::DRI::Data::Changes object') unless Net::DRI::Util::isa_changes($todo);

 my $sadd=$todo->add('status');
 my $sdel=$todo->del('status');

 my @d=build_command($mes,'update',$contact);
 push @d,['contact:add',$sadd->build_xml('contact:status')] if Net::DRI::Util::isa_statuslist($sadd);
 push @d,['contact:rem',$sdel->build_xml('contact:status')] if Net::DRI::Util::isa_statuslist($sdel);

 my $newc=$todo->set('info');
 if (defined $newc)
 {
  Net::DRI::Exception->die(1,'protocol/EPP',10,'Invalid contact '.$newc) unless Net::DRI::Util::isa_contact($newc);
  $newc->validate(1); ## will trigger an Exception if needed
  my @c=build_cdata($newc,$epp->{contacti18n});
  push @d,['contact:chg',@c] if @c;
 }
 $mes->command_body(\@d);
}

####################################################################################################
## RFC4933 §3.3 Offline Review of Requested Actions

sub pandata_parse
{
 my ($po,$otype,$oaction,$oname,$rinfo)=@_;
 my $mes=$po->message();
 return unless $mes->is_success();

 my $pandata=$mes->get_response('contact','panData');
 return unless defined $pandata;

 foreach my $el (Net::DRI::Util::xml_list_children($pandata))
 {
  my ($name,$c)=@$el;
  if ($name eq 'id')
  {
   $oname=$c->textContent();
   $rinfo->{contact}->{$oname}->{action}='review';
   $rinfo->{contact}->{$oname}->{result}=Net::DRI::Util::xml_parse_boolean($c->getAttribute('paResult'));
  } elsif ($name eq 'paTRID')
  {
   my $ns=$mes->ns('_main');
   my $tmp=Net::DRI::Util::xml_child_content($c,$ns,'clTRID');
   $rinfo->{contact}->{$oname}->{trid}=$tmp if defined $tmp;
   $rinfo->{contact}->{$oname}->{svtrid}=Net::DRI::Util::xml_child_content($c,$ns,'svTRID');
  } elsif ($name eq 'paDate')
  {
   $rinfo->{contact}->{$oname}->{date}=$po->parse_iso8601($c->textContent());
  }
 }
}

####################################################################################################
1;