File Coverage

blib/lib/Net/DRI/Protocol/AFNIC/WS/Message.pm
Criterion Covered Total %
statement 40 50 80.0
branch 8 16 50.0
condition 4 12 33.3
subroutine 9 10 90.0
pod 1 5 20.0
total 62 93 66.6


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, AFNIC WS Message
2             ##
3             ## Copyright (c) 2005,2008-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::AFNIC::WS::Message;
16              
17 2     2   2233 use utf8;
  2         9  
  2         9  
18 2     2   46 use strict;
  2         2  
  2         27  
19 2     2   4 use warnings;
  2         2  
  2         37  
20              
21 2     2   380 use Net::DRI::Protocol::ResultStatus;
  2         3  
  2         10  
22              
23 2     2   59 use base qw(Class::Accessor::Chained::Fast Net::DRI::Protocol::Message);
  2         2  
  2         866  
24             __PACKAGE__->mk_accessors(qw(version service method params result errcode));
25              
26             =pod
27              
28             =head1 NAME
29              
30             Net::DRI::Protocol::AFNIC::WS::Message - AFNIC Web Services Message for Net::DRI
31              
32             =head1 DESCRIPTION
33              
34             Please see the README file for details.
35              
36             =head1 SUPPORT
37              
38             For now, support questions should be sent to:
39              
40             Enetdri@dotandco.comE
41              
42             Please also see the SUPPORT file in the distribution.
43              
44             =head1 SEE ALSO
45              
46             Ehttp://www.dotandco.com/services/software/Net-DRI/E
47              
48             =head1 AUTHOR
49              
50             Patrick Mevzek, Enetdri@dotandco.comE
51              
52             =head1 COPYRIGHT
53              
54             Copyright (c) 2005,2008-2010,2013 Patrick Mevzek .
55             All rights reserved.
56              
57             This program is free software; you can redistribute it and/or modify
58             it under the terms of the GNU General Public License as published by
59             the Free Software Foundation; either version 2 of the License, or
60             (at your option) any later version.
61              
62             See the LICENSE file that comes with this distribution for more details.
63              
64             =cut
65              
66             ####################################################################################################
67              
68             sub new
69             {
70 3     3 1 1723 my $class=shift;
71 3         7 my $self={errcode => undef};
72 3         5 bless($self,$class);
73              
74 3         11 $self->params([]); ## default
75 3         37 my $rh=shift;
76 3 50 33     13 if (defined($rh) && (ref($rh) eq 'HASH'))
77             {
78 0 0       0 $self->service($rh->{service}) if exists($rh->{service});
79 0 0       0 $self->method($rh->{method}) if exists($rh->{method});
80 0 0       0 $self->params($rh->{params}) if exists($rh->{params});
81             }
82 3         5 return $self;
83             }
84              
85             sub as_string
86             {
87 0     0 0 0 my ($self)=@_;
88 0         0 my @p=@{$self->params()};
  0         0  
89 0         0 my @pr;
90 0         0 foreach my $i (0..$#p)
91             {
92 0         0 push @pr,sprintf 'PARAM%d=%s',$i+1,$p[$i];
93             }
94              
95 0         0 return sprintf "SERVICE=%s\nMETHOD=%s\n%s\n",$self->service(),$self->method(),join("\n",@pr);
96             }
97              
98             sub parse
99             {
100 2     2 0 20 my ($self,$r)=@_;
101              
102 2         6 $self->result($r);
103 2         7 my $c;
104 2 100 33     16 $c=$r->{reason} if (defined($r) && ref($r) && exists($r->{reason}));
      33        
105 2         5 $self->errcode($c);
106              
107             ## Warning: when we handle multiple web services, we will need a way to retrieve the method name called,
108             ## to find the correct errcode, as it will obviously not be done the same way accross all services.
109 2         8 return;
110             }
111              
112             ## We handle all non free cases as errors, even if we should not
113             sub is_success
114             {
115 3     3 0 1033 my $self=shift;
116 3         6 my $r=$self->result();
117 3         14 my $code=$self->errcode();
118              
119 3 100       14 return 1 if ($r->{free});
120 2         6 return 0;
121             }
122              
123             sub result_status
124             {
125 2     2 0 4 my $self=shift;
126 2         5 my $r=$self->result();
127              
128 2 100       21 return Net::DRI::Protocol::ResultStatus->new_success($r->{message}) if $r->{free};
129              
130 1         9 my %codes=( 0 => 2400, # problème de connexion à la base de données => Command failed
131             1 => 2302, # le nom de domaine est déjà enregistré => Object exists
132             2 => 2308, # un nom de domaine est déjà enregistré à l'identique dans l'une des extensions du domaine public => Data management policy violation
133             4 => 2304, # une opération est en cours pour ce nom de domaine => Object status prohibits operation
134             5 => 2308, # nom de domaine interdit (termes fondamentaux) => Data management policy violation
135             51 => 2308, # nom de domaine réservé pour les communes => Data management policy violation
136             100 => 2005, # mauvaise syntaxe du nom de domaine => Parameter value syntax error
137             );
138              
139 1         3 my $code=$self->errcode();
140 1 50 33     9 my $eppcode=(defined $code && exists $codes{$code})? $codes{$code} : 'COMMAND_FAILED';
141 1         3 return Net::DRI::Protocol::ResultStatus->new('afnic_ws_check_domain',$code,$eppcode,$self->is_success(),$r->{message});
142             ## Warning: when we handle multiple web services, we will need a way to retrieve the method name called,
143             ## to find the correct key of the hash (and special case of free <=> 2303)
144             }
145              
146             ####################################################################################################
147             1;