File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/VeriSign/ClientAttributes.pm
Criterion Covered Total %
statement 12 67 17.9
branch 0 30 0.0
condition 0 3 0.0
subroutine 4 11 36.3
pod 0 7 0.0
total 16 118 13.5


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, VeriSign EPP Client Object Attribute Extension
2             ## From epp-client-object-attribute.pdf
3             ##
4             ## Copyright (c) 2011-2013 Patrick Mevzek . All rights reserved.
5             ##
6             ## This file is part of Net::DRI
7             ##
8             ## Net::DRI is free software; you can redistribute it and/or modify
9             ## it under the terms of the GNU General Public License as published by
10             ## the Free Software Foundation; either version 2 of the License, or
11             ## (at your option) any later version.
12             ##
13             ## See the LICENSE file that comes with this distribution for more details.
14             ####################################################################################################
15              
16             package Net::DRI::Protocol::EPP::Extensions::VeriSign::ClientAttributes;
17              
18 1     1   850 use strict;
  1         2  
  1         29  
19 1     1   3 use warnings;
  1         1  
  1         20  
20              
21 1     1   4 use Net::DRI::Util;
  1         2  
  1         15  
22 1     1   3 use Net::DRI::Exception;
  1         2  
  1         540  
23              
24             ####################################################################################################
25              
26             sub register_commands
27             {
28 0     0 0   my ($class,$version)=@_;
29              
30 0           return { 'domain' => { 'info' => [ undef, \&info_parse ],
31             'create' => [ \&create, undef ],
32             'update' => [ \&update, undef ],
33             } };
34             }
35              
36             sub setup
37             {
38 0     0 0   my ($class,$po,$version)=@_;
39 0           $po->ns({ 'coa' => [ 'urn:ietf:params:xml:ns:coa-1.0','coa-1.0.xsd' ] });
40 0           return;
41             }
42              
43 0     0 0   sub capabilities_add { return ('domain_update','client_attributes',['add','del']); }
44              
45             ####################################################################################################
46              
47             sub info_parse
48             {
49 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
50 0           my $mes=$po->message();
51 0 0         return unless $mes->is_success();
52              
53 0           my $infdata=$mes->get_extension('coa','infData');
54 0 0         return unless defined $infdata;
55              
56 0           my %coa;
57 0           my $ns=$mes->ns('coa');
58              
59 0           foreach my $el (Net::DRI::Util::xml_list_children($infdata))
60             {
61 0           my ($name,$node)=@$el;
62 0 0         next unless $name eq 'attr';
63 0           $coa{Net::DRI::Util::xml_child_content($node,$ns,'key')}=Net::DRI::Util::xml_child_content($node,$ns,'value');
64             }
65              
66 0           $rinfo->{domain}->{$oname}->{'client_attributes'}=\%coa;
67 0           return;
68             }
69              
70             sub add_coa
71             {
72 0     0 0   my ($name,$coa)=@_;
73              
74 0           my @d;
75 0           while(my ($k,$v)=each(%$coa))
76             {
77 0 0         Net::DRI::Exception::usererr_invalid_parameters('Key parameter must be XML token of 50 characters or less, not: '.$k) unless Net::DRI::Util::xml_is_token($k,1,50);
78 0 0         if ($name eq 'rem')
79             {
80 0           push @d,['coa:key',$k];
81 0           next;
82             }
83 0 0         Net::DRI::Exception::usererr_invalid_parameters('Value parameter must be XML token of 1000 characters or less, not: '.$v) unless Net::DRI::Util::xml_is_token($v,1,1000);
84 0           push @d,['coa:attr',['coa:key',$k],['coa:value',$v]];
85             }
86              
87 0           return @d;
88             }
89              
90             sub create
91             {
92 0     0 0   my ($epp,$domain,$rd)=@_;
93              
94 0 0         return unless Net::DRI::Util::has_key($rd,'client_attributes');
95              
96 0           my $rcoa=$rd->{client_attributes};
97 0 0         Net::DRI::Exception::usererr_invalid_parameters('client_attributes must be a hash ref') unless ref $rcoa eq 'HASH';
98              
99 0           my $mes=$epp->message();
100 0           my $eid=$mes->command_extension_register('coa:create',sprintf('xmlns:coa="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('coa')));
101 0           $mes->command_extension($eid,add_coa('create',$rcoa));
102 0           return;
103             }
104              
105             sub update
106             {
107 0     0 0   my ($epp,$domain,$todo)=@_;
108              
109 0           my $rem=$todo->del('client_attributes');
110 0           my $put=$todo->add('client_attributes');
111 0 0 0       return unless defined $rem || defined $put;
112              
113 0           my @d;
114 0 0         if (defined $rem)
115             {
116 0 0         $rem={ $rem => undef } if ! ref $rem;
117 0 0         $rem={ map { $_ => undef } @$rem } if ref $rem eq 'ARRAY';
  0            
118 0 0         Net::DRI::Exception::usererr_invalid_parameters('client_attributes to delete must be a hash ref') unless ref $rem eq 'HASH';
119 0           push @d,['coa:rem',add_coa('rem',$rem)];
120             }
121 0 0         if (defined $put)
122             {
123 0 0         Net::DRI::Exception::usererr_invalid_parameters('client_attributes to add must be a hash ref') unless ref $put eq 'HASH';
124 0           push @d,['coa:put',add_coa('put',$put)];
125             }
126              
127 0           my $mes=$epp->message();
128 0           my $eid=$mes->command_extension_register('coa:update',sprintf('xmlns:coa="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('coa')));
129 0           $mes->command_extension($eid,@d);
130 0           return;
131             }
132              
133             #########################################################################################################
134             1;
135              
136             __END__