view release on metacpan or  search on metacpan

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

sub parse_disclose
{
 my $c=shift;
 my $flag=Net::DRI::Util::xml_parse_boolean($c->getAttribute('flag'));
 my %tmp;
 my $n=$c->getFirstChild();
 while($n)
 {
  next unless ($n->nodeType() == 1);
  my $name=$n->localname() || $n->nodeName();
  next unless $name;
  if ($name=~m/^(name|org|addr)$/)
  {
   my $t=$n->getAttribute('type');
   $tmp{$1.'_'.$t}=$flag;
  } elsif ($name=~m/^(voice|fax|email)$/)
  {
   $tmp{$1}=$flag;
  }
 } continue { $n=$n->getNextSibling(); }
 return \%tmp;
}

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

sub build_tel
{
 my ($name,$tel)=@_;
 if ($tel=~m/^(\S+)x(\S+)$/)
 {
  return [$name,$1,{x=>$2}];
 } else
 {
  return [$name,$tel];
 }
}

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=shift;
 my @d;

 my (@post,@addr);
 _do_locint(\@post,$contact,'type','type');
 _do_locint(\@post,$contact,'name','name');
 _do_locint(\@post,$contact,'organisation','org');
 _do_locint(\@addr,$contact,'address','street');
 _do_locint(\@addr,$contact,'postalCode','pc');
 _do_locint(\@addr,$contact,'city','city');
 _do_locint(\@addr,$contact,'countryCode','cc');
 push @post,['contact:postal',@addr] if @addr;

 push (@d,@post) if @post;

 push @d,build_tel('contact:phone',$contact->voice()) if defined($contact->voice());
 push @d,build_tel('contact:fax',$contact->fax()) if defined($contact->fax());
 push @d,['contact:email',$contact->email()] if defined($contact->email());
 push @d,['contact:sip',$contact->sip()] if defined($contact->sip());
 push @d,build_disclose($contact);
 return @d;
}

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

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

 Net::DRI::Exception->die(1,'protocol/RRI',10,'Invalid contact '.$contact) unless (Net::DRI::Util::isa_contact($contact));
 $contact->validate(); ## will trigger an Exception if needed
 push @d,build_cdata($contact);
 $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_content('creData',$mes->ns('contact'));
 return unless $credata;

 my $c=$credata->getFirstChild();
 while ($c)
 {
  next unless ($c->nodeType() == 1); ## only for element nodes
  my $name=$c->localname() || $c->nodeName();
  if ($name eq 'id')
  {
   my $new=$c->getFirstChild()->getData();
   $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}=DateTime::Format::ISO8601->new()->parse_datetime($c->getFirstChild()->getData());
  }
 } continue { $c=$c->getNextSibling(); }
}

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

 Net::DRI::Exception::usererr_invalid_parameters($todo.' must be a Net::DRI::Data::Changes object') unless Net::DRI::Util::isa_changes($todo);
 if ((grep { ! /^(?:add|del)$/ } $todo->types('status')) ||
     (grep { ! /^(?:set)$/ } $todo->types('info'))
    )
 {
  Net::DRI::Exception->die(0,'protocol/RRI',11,'Only status add/del or info set available for contact');
 }

 my @d=build_command($mes,'update',$contact);

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

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