File Coverage

blib/lib/Net/OpenVAS/OMP/Response.pm
Criterion Covered Total %
statement 48 65 73.8
branch 3 18 16.6
condition n/a
subroutine 15 23 65.2
pod 15 15 100.0
total 81 121 66.9


line stmt bran cond sub pod time code
1             package Net::OpenVAS::OMP::Response;
2              
3 2     2   1094 use strict;
  2         5  
  2         64  
4 2     2   10 use warnings;
  2         4  
  2         50  
5 2     2   10 use utf8;
  2         4  
  2         12  
6 2     2   63 use feature ':5.10';
  2         5  
  2         213  
7              
8 2     2   431 use Net::OpenVAS::Error;
  2         4  
  2         54  
9              
10 2     2   12 use XML::Simple qw( :strict );
  2         4  
  2         10  
11 2     2   174 use Carp;
  2         4  
  2         117  
12              
13 2     2   13 use overload q|""| => 'raw', fallback => 1;
  2         3  
  2         11  
14              
15             our $VERSION = '0.100';
16              
17             sub new {
18              
19 1     1 1 5 my ( $class, %args ) = @_;
20              
21 1         2 my $request = $args{'request'};
22 1         2 my $response = $args{'response'};
23 1         3 my $command = $request->command;
24              
25 1 50       5 croak q/Net::OpenVAS::OMP::Response ( 'request' => ... ) must be "Net::OpenVAS::OMP::Request" instance/
26             if ( !ref $request eq 'Net::OpenVAS::OMP::Request' );
27              
28 1         4 my $result = XMLin( $response, ForceArray => 1, KeyAttr => "${command}_response" );
29 1         85262 my $status = delete( $result->{status} );
30 1         4 my $status_text = delete( $result->{status_text} );
31 1         3 my $error = undef;
32              
33 1 50       6 if ( $status >= 400 ) {
34 0         0 $error = Net::OpenVAS::Error->new( $status_text, $status );
35             }
36              
37 1         7 my $self = {
38             result => $result,
39             status => $status + 0,
40             raw => $response,
41             request => $request,
42             status_text => $status_text,
43             error => $error,
44             };
45              
46 1         13 return bless $self, $class;
47              
48             }
49              
50             sub result {
51 0     0 1 0 my ($self) = @_;
52 0         0 return $self->{result};
53             }
54              
55             sub error {
56 1     1 1 3 my ($self) = @_;
57 1         5 return $self->{error};
58             }
59              
60             sub status {
61 2     2 1 9 my ($self) = @_;
62 2         44 return $self->{status};
63             }
64              
65             sub is_ok {
66 1     1 1 3 my ($self) = @_;
67 1 50       4 return ( $self->status == 200 ) ? 1 : 0;
68             }
69              
70             sub is_created {
71 0     0 1 0 my ($self) = @_;
72 0 0       0 return ( $self->status == 201 ) ? 1 : 0;
73             }
74              
75             sub is_accepted {
76 0     0 1 0 my ($self) = @_;
77 0 0       0 return ( $self->status == 202 ) ? 1 : 0;
78             }
79              
80             sub is_forbidden {
81 0     0 1 0 my ($self) = @_;
82 0 0       0 return ( $self->status == 403 ) ? 1 : 0;
83             }
84              
85             sub is_not_found {
86 0     0 1 0 my ($self) = @_;
87 0 0       0 return ( $self->status == 404 ) ? 1 : 0;
88             }
89              
90             sub is_busy {
91 0     0 1 0 my ($self) = @_;
92 0 0       0 return ( $self->status == 409 ) ? 1 : 0;
93             }
94              
95             sub is_server_error {
96 0     0 1 0 my ($self) = @_;
97 0 0       0 return ( $self->status >= 500 ) ? 1 : 0;
98             }
99              
100             sub status_text {
101 1     1 1 3 my ($self) = @_;
102 1         6 return $self->{status_text};
103             }
104              
105             sub raw {
106 1     1 1 3 my ($self) = @_;
107 1         5 return $self->{raw};
108             }
109              
110             sub command {
111 1     1 1 3 my ($self) = @_;
112 1         6 return $self->{request}->command;
113             }
114              
115             sub request {
116 0     0 1   my ($self) = @_;
117 0           return $self->{request};
118             }
119              
120             1;
121             __END__