File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/UnitedTLD/Charge.pm

Criterion	Covered	Total	%
statement	18	111	16.2
branch	0	70	0.0
condition	0	3	0.0
subroutine	6	20	30.0
pod	0	12	0.0
total	24	216	11.1

## Domain Registry Interface, Charge Extension Mapping for EPP
##
## Copyright (c) 2015 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::UnitedTLD::Charge;

use strict;
use warnings;
use feature 'state';

use Net::DRI::Util;
use Net::DRI::Exception;
use Net::DRI::Protocol::EPP::Util;

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

sub register_commands
{
 my ($class,$version)=@_;

 state $rops = { 'domain' => { check            => [ undef,           \&check_parse    ],
                               check_multi      => [ undef,           \&check_parse    ],
                               create           => [ \&add_agreement, \&create_parse   ],
                               info             => [ undef,           \&info_parse     ],
                               renew            => [ \&add_agreement, \&renew_parse    ],
                               transfer_request => [ \&add_agreement, \&transfer_parse ],
                               update           => [ \&update_build,  \&update_parse   ],
                             }
               };

 return $rops;
}

sub setup
{
 my ($class,$po,$version)=@_;
 state $ns = { 'charge' => [ 'http://www.unitedtld.com/epp/charge-1.0','charge-1.0.xsd' ] };
 $po->ns($ns);
 return;
}

sub implements { return 'http://rightside.co/fileadmin/downloads/policies/Rightside_Price_Categories.pdf'; }

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

sub _parse_set
{
 my ($node)=@_;

 my %s;
 foreach my $el (Net::DRI::Util::xml_list_children($node))
 {
  my ($name,$node)=@$el;
  if ($name eq 'category')
  {
   my $v=$node->textContent();
   $s{category}=$node->hasAttribute('name') ? { name => $node->getAttribute('name'), value => $v } : $v;
  } elsif ($name eq 'type')
  {
   my $v=$node->textContent();
   $s{type}=$node->hasAttribute('name') ? { name => $node->getAttribute('name'), value => $v } : $v;
  } elsif ($name eq 'amount')
  {
   my $key=$node->getAttribute('command');
   $key.='.'.$node->getAttribute('name') if $node->hasAttribute('name');
   $s{$key}=0+$node->textContent();
  }
 }
 return \%s;
}

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

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

 foreach my $cd (grep { $_->[0] eq 'cd' } Net::DRI::Util::xml_list_children($data))
 {
  my ($domain,@p);
  foreach my $el (Net::DRI::Util::xml_list_children($cd->[1]))
  {
   my ($name,$node)=@$el;
   if ($name eq 'name')
   {
    $domain=$node->textContent();
   } elsif ($name eq 'set')
   {
    push @p,_parse_set($node);
   }
  }
  $rinfo->{$otype}->{$domain}->{price}=@p > 1 ? \@p : $p[0];
 }

 return;
}

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

 return unless Net::DRI::Util::has_key($rp,'price');

 my @d;
 foreach my $charge (ref $rp->{price} eq 'ARRAY' ? @{$rp->{price}} : ($rp->{price}))
 {
  push @d,['charge:set',add_set($charge)];
 }

 my $eid=$mes->command_extension_register('charge','agreement');
 $mes->command_extension($eid,\@d);
 return;
}

sub add_set
{
 my ($charge)=@_;
 Net::DRI::Exception::usererr_invalid_parameters('price element must be ref hash') unless ref $charge eq 'HASH';

 my @d;

 Net::DRI::Exception::usererr_insufficient_parameters('missing category element in price structure') unless Net::DRI::Util::has_key($charge,'category');
 if (ref $charge->{category} eq 'HASH')
 {
  Net::DRI::Exception::usererr_insufficient_parameters('category missing value') unless Net::DRI::Util::has_key($charge->{category},'value');
  Net::DRI::Exception::usererr_invalid_parameters('category value must be an XML token') unless Net::DRI::Util::xml_is_token($charge->{category}->{value});
  Net::DRI::Exception::usererr_insufficient_parameters('category missing name') unless Net::DRI::Util::has_key($charge->{category},'name');
  Net::DRI::Exception::usererr_invalid_parameters('category name must be an XML token') unless Net::DRI::Util::xml_is_token($charge->{category}->{name});
  push @d,['charge:category',{ name => $charge->{category}->{name} },$charge->{category}->{value}];
 } else
 {
  Net::DRI::Exception::usererr_invalid_parameters('category must be an XML token') unless Net::DRI::Util::xml_is_token($charge->{category});
  push @d,['charge:category',$charge->{category}];
 }

 Net::DRI::Exception::usererr_insufficient_parameters('missing type element in price structure') unless Net::DRI::Util::has_key($charge,'type');
 if ($charge->{type} eq 'HASH')
 {
  Net::DRI::Exception::usererr_insufficient_parameters('type missing value') unless Net::DRI::Util::has_key($charge->{type},'value');
  Net::DRI::Exception::usererr_invalid_parameters('type value must be an XML token') unless Net::DRI::Util::xml_is_token($charge->{type}->{value});
  Net::DRI::Exception::usererr_insufficient_parameters('type missing name') unless Net::DRI::Util::has_key($charge->{type},'name');
  Net::DRI::Exception::usererr_invalid_parameters('type name must be an XML token') unless Net::DRI::Util::xml_is_token($charge->{type}->{name});
  push @d,['charge:type',{ name => $charge->{type}->{name} },$charge->{type}->{value}];
 } else
 {
  Net::DRI::Exception::usererr_invalid_parameters('type value must be "price", "fee" or "custom"') unless $charge->{type}=~m/^(?:price|fee|custom)$/;
  Net::DRI::Exception::usererr_invalid_parameters('type name must be set if type value is "custom"') if $charge->{type} eq 'custom';
  push @d,['charge:type',$charge->{type}];
 }

 foreach my $key (sort { $a cmp $b } grep { ! /^(?:category|type)$/ } keys %$charge)
 {
  my ($command,$name)=split(/\./,$key);
  push @d,['charge:amount',{ command => $command, defined $name ? (name => $name) : ()},0+$charge->{$key}];
 }

 return @d;
}

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

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

 my @p=map { _parse_set($_) } Net::DRI::Util::xml_list_children($data,'set');
 $rinfo->{$otype}->{$oname}->{price}=@p > 1 ? \@p : $p[0];
 return;
}

sub create_parse   { return _parse(@_,'creData'); } ## no critic (Subroutines::RequireArgUnpacking)
sub info_parse     { return _parse(@_,'infData'); } ## no critic (Subroutines::RequireArgUnpacking)
sub renew_parse    { return _parse(@_,'renData'); } ## no critic (Subroutines::RequireArgUnpacking)
sub transfer_parse { return _parse(@_,'trnData'); } ## no critic (Subroutines::RequireArgUnpacking)
sub update_parse   { return _parse(@_,'upData');  } ## no critic (Subroutines::RequireArgUnpacking)

sub update_build
{
 my ($epp,$domain,$todo,$rp)=@_;

 my $rgp=$todo->set('rgp');
 return unless Net::DRI::Util::has_key($rgp,'op') && $rgp->{op} eq 'request';
 Net::DRI::Exception::usererr_insufficient_parameters('price structure is mandatory for a domain:update RGP request') unless Net::DRI::Util::has_key($rp,'price');
 return add_agreement($epp,$domain,$rp);
}


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

__END__