File Coverage

blib/lib/Net/DRI/Protocol/DAS/AdamsNames/Message.pm
Criterion Covered Total %
statement 15 40 37.5
branch 0 8 0.0
condition 0 6 0.0
subroutine 5 10 50.0
pod 1 5 20.0
total 21 69 30.4


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, AdamsNames DAS Message
2             ##
3             ## Copyright (c) 2009,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::AdamsNames::Message;
16              
17 1     1   3 use strict;
  1         1  
  1         26  
18 1     1   4 use warnings;
  1         2  
  1         17  
19              
20 1     1   4 use Net::DRI::Protocol::ResultStatus;
  1         1  
  1         8  
21 1     1   23 use Net::DRI::Exception;
  1         1  
  1         19  
22              
23 1     1   4 use base qw(Class::Accessor::Chained::Fast Net::DRI::Protocol::Message);
  1         2  
  1         504  
24             __PACKAGE__->mk_accessors(qw(version errcode errmsg command_param cltrid response));
25              
26             =pod
27              
28             =head1 NAME
29              
30             Net::DRI::Protocol::DAS::AdamsNames::Message - AdamsNames 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) 2009,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 $proto=shift;
71 0   0       my $class=ref($proto) || $proto;
72 0           my $trid=shift;
73              
74 0           my $self={
75             errcode => -1000,
76             response => {},
77             };
78              
79 0           bless($self,$class);
80 0 0 0       $self->cltrid($trid) if (defined($trid) && $trid);
81 0           return $self;
82             }
83              
84 0 0   0 0   sub is_success { return (shift->errcode()==0)? 1 : 0; }
85              
86             sub result_status
87             {
88 0     0 0   my $self=shift;
89 0           my $c=$self->errcode();
90 0           my $rs=Net::DRI::Protocol::ResultStatus->new('das',$c,'COMMAND_SUCCESSFUL_END',$self->is_success());
91 0           $rs->_set_trid([ $self->cltrid(),undef ]);
92 0           return $rs;
93             }
94              
95             sub as_string
96             {
97 0     0 0   my ($self)=@_;
98 0           my $s=sprintf("testdomain %s\x0d\x0a",$self->command_param());
99 0           return $s;
100             }
101              
102             sub parse
103             {
104 0     0 0   my ($self,$dc,$rinfo)=@_;
105 0           my @d=$dc->as_array();
106 0 0         Net::DRI::Exception->die(0,'protocol/DAS',1,'Unsuccessfull parse, not exactly 2 lines in server reply') unless (@d==2);
107 0 0         my $e=($d[0]=~m/Yes/)? 1 : 0;
108 0           my ($dom)=($d[1]=~m/^(\S+) is /);
109 0           $self->errcode(0);
110 0           $self->errmsg($d[0].', '.$d[1]);
111 0           $self->response([$dom,$e]);
112 0           return;
113             }
114              
115             ####################################################################################################
116             1;