File Coverage

blib/lib/Net/DRI/Protocol/AdamsNames/WS/Message.pm
Criterion Covered Total %
statement 12 53 22.6
branch 0 18 0.0
condition 0 8 0.0
subroutine 4 9 44.4
pod 1 5 20.0
total 17 93 18.2


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, AdamsNames Web Services Message
2             ##
3             ## Copyright (c) 2009-2010,2013 Patrick Mevzek . All rights reserved.
4             ##
5             ## This file is part of Net::DRI
6             ##
7             ## Net::DRI is free software; you can redistribute it and/or modify
8             ## it under the terms of the GNU General Public License as published by
9             ## the Free Software Foundation; either version 2 of the License, or
10             ## (at your option) any later version.
11             ##
12             ## See the LICENSE file that comes with this distribution for more details.
13             ####################################################################################################
14              
15             package Net::DRI::Protocol::AdamsNames::WS::Message;
16              
17 1     1   6 use strict;
  1         2  
  1         38  
18 1     1   5 use warnings;
  1         2  
  1         19  
19              
20 1     1   4 use Net::DRI::Protocol::ResultStatus;
  1         2  
  1         7  
21              
22 1     1   26 use base qw(Class::Accessor::Chained::Fast Net::DRI::Protocol::Message);
  1         1  
  1         569  
23             __PACKAGE__->mk_accessors(qw(version method params result errcode errmsg));
24              
25             =pod
26              
27             =head1 NAME
28              
29             Net::DRI::Protocol::AdamsNames::WS::Message - AdamsNames Web Services Message for Net::DRI
30              
31             =head1 DESCRIPTION
32              
33             Please see the README file for details.
34              
35             =head1 SUPPORT
36              
37             For now, support questions should be sent to:
38              
39             Enetdri@dotandco.comE
40              
41             Please also see the SUPPORT file in the distribution.
42              
43             =head1 SEE ALSO
44              
45             Ehttp://www.dotandco.com/services/software/Net-DRI/E
46              
47             =head1 AUTHOR
48              
49             Patrick Mevzek, Enetdri@dotandco.comE
50              
51             =head1 COPYRIGHT
52              
53             Copyright (c) 2009-2010,2013 Patrick Mevzek .
54             All rights reserved.
55              
56             This program is free software; you can redistribute it and/or modify
57             it under the terms of the GNU General Public License as published by
58             the Free Software Foundation; either version 2 of the License, or
59             (at your option) any later version.
60              
61             See the LICENSE file that comes with this distribution for more details.
62              
63             =cut
64              
65             ####################################################################################################
66              
67             sub new
68             {
69 0     0 1   my ($class,$trid,$otype,$oaction)=@_;
70 0           my $self={errcode => undef, errmsg => undef};
71 0           bless($self,$class);
72              
73 0           $self->params([]); ## empty default
74 0           return $self;
75             }
76              
77             sub as_string
78             {
79 0     0 0   my ($self)=@_;
80 0           my @p=@{$self->params()};
  0            
81 0           my @pr;
82 0           foreach my $i (0..$#p)
83             {
84 0           push @pr,sprintf 'PARAM%d=%s',$i+1,$p[$i];
85             }
86 0           return sprintf "METHOD=%s\n%s\n",$self->method(),join("\n",@pr);
87             }
88              
89             sub parse
90             {
91 0     0 0   my ($self,$dr,$rinfo,$otype,$oaction,$sent)=@_; ## $sent is the original message, we could copy its method/params value into this new message
92 0           my ($res)=@{$dr->data()}; ## $dr is a Data::Raw object, type=1
  0            
93 0 0 0       if (! defined($res->result()) || $res->fault())
94             {
95 0           $self->result(undef);
96 0           $self->errcode($res->faultcode());
97 0           $self->errmsg($res->faultstring());
98             } else
99             {
100 0           $self->result($res->result());
101             ## TODO: properly parse all error messages
102 0           my $err=$res->result()->{error};
103 0 0 0       if (defined $err && @$err)
104             {
105 0           $self->errcode($err->[0]->[0]);
106 0           $self->errmsg($err->[0]->[1]);
107             } else
108             {
109 0           $self->errcode(0); ## probably success
110 0           $self->errmsg('No error');
111             }
112             }
113 0           return;
114             }
115              
116 0 0   0 0   sub is_success { return (shift->errcode()==0)? 1 : 0; }
117              
118             ## See http://www.adamsnames.tc/api/xmlrpc-doc/common.html
119             ## Some values depend on the command issued
120             sub result_status
121             {
122 0     0 0   my $self=shift;
123 0           my $code=$self->errcode();
124 0   0       my $msg=$self->errmsg() || '';
125 0           my $ok=$self->is_success();
126              
127 0 0         return Net::DRI::Protocol::ResultStatus->new('adamsnames_ws',$code,'COMMAND_SUCCESSFUL',1,$msg,'en') if $ok;
128              
129 0           my $eppcode='COMMAND_FAILED';
130 0 0         if ($code=~m/^30/)
    0          
    0          
    0          
    0          
131             {
132 0           $eppcode='AUTHORIZATION_ERROR';
133             } elsif ($code=~m/^31/)
134             {
135 0           $eppcode='COMMAND_SYNTAX_ERROR';
136             } elsif ($code=~m/^32/)
137             {
138 0           $eppcode='PARAMETER_VALUE_SYNTAX_ERROR';
139             } elsif ($code=~m/^4/)
140             {
141 0           $eppcode='COMMAND_SUCCESSFUL'; ## ?
142             } elsif ($code=~m/^5/)
143             {
144 0           $eppcode='COMMAND_FAILED';
145             }
146              
147 0           return Net::DRI::Protocol::ResultStatus->new('adamsnames_ws',$code,$eppcode,0,$msg,'en');
148             }
149              
150             ####################################################################################################
151             1;