File Coverage

blib/lib/Net/DRI/Protocol/BookMyName/WS/Message.pm
Criterion Covered Total %
statement 12 43 27.9
branch 0 8 0.0
condition 0 3 0.0
subroutine 4 10 40.0
pod 1 6 16.6
total 17 70 24.2


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, BookMyName Web Services Message
2             ##
3             ## Copyright (c) 2008-2010,2013-2014 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::BookMyName::WS::Message;
16              
17 1     1   4 use strict;
  1         1  
  1         27  
18 1     1   4 use warnings;
  1         1  
  1         21  
19              
20 1     1   6 use Net::DRI::Protocol::ResultStatus;
  1         2  
  1         6  
21              
22 1     1   30 use base qw(Class::Accessor::Chained::Fast Net::DRI::Protocol::Message);
  1         2  
  1         582  
23             __PACKAGE__->mk_accessors(qw(version method params operation result retcode retval));
24              
25             =pod
26              
27             =head1 NAME
28              
29             Net::DRI::Protocol::BookMyName::WS::Message - BookMyName 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) 2008-2010,2013-2014 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([]); ## 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 add_session
90             {
91 0     0 0   my ($self,$sd)=@_;
92 0           my $rp=$self->params();
93 0           unshift(@$rp,$sd->{id},$sd->{pass});
94 0           return;
95             }
96              
97             sub parse
98             {
99 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
100 0           $self->operation($otype.'_'.$oaction);
101 0           my ($res)=@{$dr->data()}; ## $dr is a Data::Raw object, type=1
  0            
102 0 0         $self->result($res->{retfields}) if exists($res->{retfields});
103 0           $self->retcode($res->{retcode}); ## integer
104 0           $self->retval($res->{retval}); ## integer
105 0           return;
106             }
107              
108             ## See http://api.doc.free.org/revendeur-de-nom-de-domaine
109             our %CODES=( domain_info => { '-1,-1' => 2200,
110             '-1,-2' => 2201,
111             '-1,-3' => 2003,
112             '0,0' => 2303,
113             },
114             domain_check => { '-1,-1' => 2200,
115             '-1,-2' => 2303,
116             '-1,-3' => 2103,
117             '-1,-4' => 2303,
118             '-1,-5' => 2003,
119             },
120             account_list_domains => {
121             '-1,-1' => 2200,
122             },
123             );
124              
125 0 0   0 0   sub is_success { return (shift->retcode()==1)? 1 : 0; }
126              
127             sub result_status
128             {
129 0     0 0   my $self=shift;
130 0           my ($op,$rc,$rv)=($self->operation(),$self->retcode(),$self->retval());
131 0           my $ok=$self->is_success();
132 0           my $k=$rc.','.$rv;
133 0 0 0       my $eppcode=(exists $CODES{$op} && ref $CODES{$op} eq 'HASH' && exists $CODES{$op}->{$k})? $CODES{$op}->{$k} : 'COMMAND_FAILED';
134 0 0         return Net::DRI::Protocol::ResultStatus->new('bookmyname_ws',100*$rc+$rv,$ok ? 'COMMAND_SUCCESSFUL' : $eppcode,$ok,'retcode='.$rc.' retval='.$rv,'en');
135             }
136              
137             ####################################################################################################
138             1;