File Coverage

blib/lib/Net/DRI/Protocol/DAS/Message.pm
Criterion Covered Total %
statement 15 52 28.8
branch 0 14 0.0
condition 0 9 0.0
subroutine 5 10 50.0
pod 1 5 20.0
total 21 90 23.3


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, DAS Message
2             ##
3             ## Copyright (c) 2007-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::DAS::Message;
16              
17 1     1   3 use strict;
  1         1  
  1         22  
18 1     1   3 use warnings;
  1         2  
  1         18  
19              
20 1     1   4 use Net::DRI::Protocol::ResultStatus;
  1         1  
  1         7  
21 1     1   19 use Net::DRI::Exception;
  1         1  
  1         17  
22              
23 1     1   3 use base qw(Class::Accessor::Chained::Fast Net::DRI::Protocol::Message);
  1         1  
  1         493  
24             __PACKAGE__->mk_accessors(qw(version errcode errmsg errlang command command_param cltrid response));
25              
26             =pod
27              
28             =head1 NAME
29              
30             Net::DRI::Protocol::DAS::Message - DAS 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) 2007-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 0     0 1   my ($class,$trid)=@_;
71 0           my $self={
72             errcode => -1000,
73             response => {},
74             };
75              
76 0           bless($self,$class);
77 0 0 0       $self->cltrid($trid) if (defined($trid) && $trid);
78 0           return $self;
79             }
80              
81 0 0   0 0   sub is_success { return (shift->errcode()==0)? 1 : 0; }
82              
83             sub result_status
84             {
85 0     0 0   my $self=shift;
86             ## From http://www.dns.be/en/home.php?n=317
87             ## See also http://www.dns.be/en/home.php?n=44
88 0           my %C=( 0 => 1500, ## Command successful + connection closed
89             -9 => 2201, ## IP address blocked => Authorization error
90             -8 => 2400, ## Timeout => Command failed
91             -7 => 2005, ## Invalid pattern => Parameter value syntax error
92             -6 => 2005, ## Invalid version => Parameter value syntax error
93             );
94 0           my $c=$self->errcode();
95 0 0         my $rs=Net::DRI::Protocol::ResultStatus->new('das',$c,exists $C{$c} ? $C{$c} : 'COMMAND_FAILED',$self->is_success(),$self->errmsg(),$self->errlang(),undef);
96 0           $rs->_set_trid([ $self->cltrid(),undef ]);
97 0           return $rs;
98             }
99              
100             sub as_string
101             {
102 0     0 0   my ($self)=@_;
103 0           my $s=sprintf("%s %s %s\x0d\x0a",$self->command(),$self->version(),$self->command_param());
104 0           return $s;
105             }
106              
107             sub parse
108             {
109 0     0 0   my ($self,$dc,$rinfo)=@_;
110 0           my @d=$dc->as_array();
111 0           my $rc;
112 0           my @tmp=grep { /^%% RC\s*=\s*\S+/ } @d;
  0            
113 0 0         if (@tmp)
114             {
115 0           ($rc)=($tmp[0]=~m/^%% RC\s*=\s*(\S+)\s*$/);
116 0           $self->errcode($rc);
117             }
118              
119 0 0 0       if ((defined $rc && $rc==0) || grep { /^Status: /} @d) ## success
  0   0        
120             {
121 0           $self->errcode(0);
122 0           my %info=map { m/^(\S+):\s+(.*\S)\s*$/; $1 => $2 } grep { /^\S+: / } @d;
  0            
  0            
  0            
123 0 0         Net::DRI::Exception->die(0,'protocol/DAS',1,'Unsuccessfull parse, missing key Domain') unless exists $info{Domain};
124 0 0         Net::DRI::Exception->die(0,'protocol/DAS',1,'Unsuccessfull parse, missing key Status') unless exists $info{Status};
125 0           $self->response(\%info);
126             } else
127             {
128 0           $self->errlang('en'); ## really ?
129 0           my ($msg)=($d[-1]=~m/^%\s*(\S.+\S)\s*$/);
130 0           $self->errmsg($msg);
131             }
132 0           return;
133             }
134              
135             ####################################################################################################
136             1;