File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/AusRegistry/Variant.pm

Criterion	Covered	Total	%
statement	12	68	17.6
branch	0	22	0.0
condition	0	6	0.0
subroutine	4	13	30.7
pod	0	9	0.0
total	16	118	13.5

## Domain Registry Interface, EPP AusRegistry Domain Variant Extension
##
## Copyright (c) 2013 Patrick Mevzek . All rights reserved.
##
## This file is part of Net::DRI
##
## Net::DRI is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2 of the License, or
## (at your option) any later version.
##
## See the LICENSE file that comes with this distribution for more details.
####################################################################################################

package Net::DRI::Protocol::EPP::Extensions::AusRegistry::Variant;

use strict;
use warnings;

use Net::DRI::Util;
use Net::DRI::Exception;

####################################################################################################

sub register_commands
{
 my ($class,$version)=@_;
 my %tmp=(
           info   => [ \&info_build, \&info_parse ],
           create => [ undef,        \&create_parse ],
           update => [ \&update_build, undef ],
         );

 return { 'domain' => \%tmp };
}

sub setup
{
 my ($class,$po,$version)=@_;
 $po->ns({ 'variant' => [ 'urn:X-ar:params:xml:ns:variant-1.0','variant-1.0.xsd' ],
         });
 return;
}

sub capabilities_add { return ('domain_update','variants',['add','del']); }

####################################################################################################

## (This extension is mandatory)
##
##
##

sub info_build
{
 my ($epp,$domain,$rd)=@_;
 my $mes=$epp->message();

 my $variants='all'; ## default value
 $variants=$rd->{variants} if Net::DRI::Util::has_key($rd,'variants') && $rd->{variants}=~m/^(?:all|none)$/;

 my $eid=$mes->command_extension_register('variant','info',{variants => $variants});

 return;
}

##
##
##   xn--4xal.example
##
##

sub parse_variant
{
 my ($rh,$data)=@_;

 my %variants;
 foreach my $el (Net::DRI::Util::xml_list_children($data))
 {
  my ($name,$node)=@$el;
  if ($name eq 'variant')
  {
   $variants{$node->textContent()}=$node->getAttribute('userForm'); ## A-label => U-label
  }
 }

 $rh->{variants}=\%variants;
 return;
}

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

 my $data=$mes->get_extension('variant','infData');
 return unless defined $data;

 parse_variant($rinfo->{domain}->{$oname},$data);
 return;
}

##
##
##   xn--4xal.example
##
##

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

 my $data=$mes->get_extension('variant','creData');
 return unless defined $data;

 parse_variant($rinfo->{domain}->{$oname},$data);
 return;
}

##
##
##
##    xn--4xal.example
##
##
##

##
##
##
##    xn--4xal.example
##
##
##

sub build_variants
{
 my ($d)=@_;

 my @v;
 foreach my $alabel ( sort { $a cmp $b } keys %$d)
 {
  push @v,['variants:variant',{userForm => $d->{$alabel}},$alabel];
 }

 return @v;
}

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

 my $toadd=$todo->add('variants');
 my $todel=$todo->del('variants');
 return unless defined $toadd || defined $todel;

 my $eid=$mes->command_extension_register('variants','update');
 my @v;

 if (defined $toadd)
 {
  Net::DRI::Exception::usererr_invalid_parameters(q{add variants value must be a ref hash, not: }.$toadd) unless ref $toadd eq 'HASH';
  push @v,['variants:add',build_variants($toadd)];
 }
 if (defined $todel)
 {
  Net::DRI::Exception::usererr_invalid_parameters(q{del variants value must be a ref hash, not: }.$todel) unless ref $todel eq 'HASH';
  push @v,['variants:rem',build_variants($todel)];
 }

 $mes->command_extension($eid,\@v);

 return;
}

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

__END__