File Coverage

blib/lib/WWW/Domain/Registry/Joker/Response.pm
Criterion Covered Total %
statement 12 56 21.4
branch 0 16 0.0
condition 0 3 0.0
subroutine 4 6 66.6
pod 2 2 100.0
total 18 83 21.6


line stmt bran cond sub pod time code
1             package WWW::Domain::Registry::Joker::Response;
2              
3             # $CNsys: lib/WWW/Domain/Registry/Joker/Response.pm 2375 2008-10-17 10:25:08Z roam $
4              
5 1     1   21 use 5.006;
  1         4  
  1         46  
6 1     1   6 use strict;
  1         2  
  1         32  
7 1     1   5 use warnings;
  1         2  
  1         35  
8              
9 1     1   6 use WWW::Domain::Registry::Joker::Loggish;
  1         2  
  1         1807  
10              
11             our @ISA = qw(WWW::Domain::Registry::Joker::Loggish);
12              
13             our $VERSION = '0.04';
14              
15             =head1 NAME
16              
17             WWW::Domain::Registry::Joker::Response - parse a DMAPI response
18              
19             =head1 SYNOPSIS
20              
21             use WWW::Domain::Registry::Joker::Response;
22              
23             $r = new WWW::Domain::Registry::Joker::Response();
24             $r->parse($resp);
25             print "$r->{Proc-Id}: $r->{'Status-Code'} $r->{Status-Text}\n";
26              
27             =head1 DESCRIPTION
28              
29             The C class is a helper parser
30             for the HTTP responses returned by the Joker.com DMAPI. It examines
31             a response object, extracts the status and error flags, codes, and
32             descriptive messages, and makes them available as Perl object members.
33              
34             =head1 METHODS
35              
36             The C class defines the
37             following methods:
38              
39             =over 4
40              
41             =item new ()
42              
43             Initialize a C object.
44             No user-serviceable parameters inside.
45              
46             =cut
47              
48             sub new($ %)
49             {
50 0     0 1   my ($proto, %param) = @_;
51 0           my $self;
52              
53 0           $self = WWW::Domain::Registry::Joker::Loggish::new($proto,
54             'code' => 1337,
55             'msg' => '(no status text)',
56             'status' => '(no status line)',
57             'success' => 0,
58             %param,
59             );
60 0           return $self;
61             }
62              
63             =item parse ( RESPONSE )
64              
65             Parse a C from the DMAPI and store the result code,
66             message, error, etc. into the respective fields of the object.
67             In addition to the C, C, C, and C members
68             described above, the C method may also set the C,
69             C, C, C, C, and any other
70             result description members as listed in the DMAPI specification.
71              
72             =cut
73              
74             sub parse($ $)
75             {
76 0     0 1   my ($self, $resp) = @_;
77 0           my ($in_data, $var, $val);
78 0           my (@r, @data);
79              
80 0 0         die("No response object passed to ".ref($self)."->parse()\n")
81             unless defined($resp);
82 0           $self->debug("parsing a response - '".ref($resp)."'");
83 0 0 0       if (index(ref($resp), '::') == -1 || !$resp->isa('HTTP::Response')) {
84 0           die("Not a HTTP response object in ".ref($self)."->parse()\n");
85             }
86              
87 0           $self->{'success'} = $resp->is_success();
88 0           $self->{'status'} = $resp->status_line();
89 0           undef $self->{'Status-Code'};
90 0           undef $self->{'Status-Text'};
91 0           @r = split("\n", $resp->content());
92 0           $self->debug(scalar(@r)." content lines");
93 0           foreach (@r) {
94 0           s/[\r\n]+$//;
95 0 0         if ($in_data) {
96 0           $self->debug("- data line $_");
97 0           push @data, $_;
98 0           next;
99             }
100 0           $self->debug("- line $_");
101 0 0         if ($_ eq '') {
    0          
102 0           $self->debug("- - end of header");
103 0           $in_data = 1;
104 0           next;
105             } elsif (!/^([\w-]+):\s+(.*)$/) {
106 0           $self->debug("- - bad format!");
107 0           next;
108             }
109 0           ($var, $val) = ($1, $2);
110 0 0         if (defined($self->{$var})) {
111 0           $self->{$var} .= " / $val";
112             } else {
113 0           $self->{$var} = $val;
114             }
115             }
116 0           $self->{'data'} = [ @data ];
117 0 0         if (defined($self->{'Status-Code'})) {
118 0           $self->{'code'} = $self->{'Status-Code'};
119             } else {
120 0           $self->{'code'} = 1337;
121             }
122 0 0         if (defined($self->{'Status-Text'})) {
123 0           $self->{'msg'} = $self->{'Status-Text'};
124             } else {
125 0           $self->{'msg'} = '(no status text)';
126             }
127 0           $self->debug("=== DMAPI response: is_success $self->{success} ".
128             "status line '$self->{status}', status code: $self->{code}, ".
129             "status text: '$self->{msg}', ".
130 0           "data lines ".scalar(@{$self->{'data'}})."\n");
131 0           return 1;
132             }
133              
134             =back
135              
136             =head1 EXAMPLES
137              
138             Create an object and parse an HTTP response:
139              
140             $r = new WWW::Domain::Registry::Joker::Response();
141             eval {
142             $r->parse($resp);
143             };
144             if ($@) {
145             print STDERR "Could not parse the DMAPI response: $@\n";
146             } elsif (!$r->{'success'}) {
147             print STDERR "DMAPI error: code $r->{code}, text $r->{msg}\n";
148             print STDERR "DMAPI error message: $r->{Error}\n"
149             if $r->{'Error'};
150             } else {
151             print "Successful DMAPI request: $r->{code} $r->{msg}\n";
152             print "Tracking process ID: $r->{Proc-ID}\n" if $r->{'Proc-ID'};
153             }
154              
155             =head1 ERRORS
156              
157             The C method will die on invalid input:
158              
159             =over 4
160              
161             =item *
162              
163             no response parameter passed in;
164              
165             =item *
166              
167             the response parameter was not an C or compatible object.
168              
169             =back
170              
171             If the response object is a valid DMAPI response, its C, C,
172             C, C, and other attributes are exposed as members of
173             the C object as shown above.
174              
175             =head1 SEE ALSO
176              
177             L, L
178              
179             I - the Joker.com DMAPI
180             documentation
181              
182             =head1 BUGS
183              
184             None known so far ;)
185              
186             =head1 HISTORY
187              
188             The C class was written by
189             Peter Pentchev in 2007.
190              
191             =head1 AUTHOR
192              
193             Peter Pentchev, Eroam@ringlet.netE
194              
195             =head1 COPYRIGHT AND LICENSE
196              
197             Copyright (C) 2007 by Peter Pentchev
198              
199             This library is free software; you can redistribute it and/or modify
200             it under the same terms as Perl itself, either Perl version 5.8.8 or,
201             at your option, any later version of Perl 5 you may have available.
202              
203             =cut
204              
205             1;