File Coverage

blib/lib/Net/SolarWinds/Result.pm
Criterion Covered Total %
statement 40 49 81.6
branch 3 8 37.5
condition 2 9 22.2
subroutine 13 17 76.4
pod 7 13 53.8
total 65 96 67.7


line stmt bran cond sub pod time code
1             package Net::SolarWinds::Result;
2              
3             =head1 NAME
4              
5             Net::SolarWinds::Result - Result class
6              
7             =head1 SYNOPSIS
8              
9             use Net::SolarWinds::Result;
10              
11              
12             my $res=new_true Net::SolarWinds::Result('some data');
13              
14             print $res->get_data if($res);
15              
16             $res->set_false('some error');
17              
18             die $res unless $res;
19              
20             =head1 DESCRIPTION
21              
22             This package acts as a general result class, it allows for returing of state and objects within a single context using encapsulation.
23              
24             =cut
25              
26 3     3   418 use strict;
  3         6  
  3         71  
27 3     3   13 use warnings;
  3         6  
  3         116  
28              
29             =head1 OVERLOADED METHODS
30              
31             The following methods have been overloaded
32              
33             bool
34             # an instance when set to false will test as false
35             '""'
36             # an instance when called in a string context will return
37             # the error message given if any
38              
39             =cut
40              
41             use overload
42 3         30 bool => \&is_ok,
43             '""'=>\&get_msg,
44 3     3   16 fallback => 1;
  3         6  
45              
46             =head1 OO Methods
47              
48             =over 4
49              
50             =item * Objec Construcotr(s)
51              
52             Multiple objec constructors have been provided.
53              
54             new Net::SolarWinds::Result(
55             bool=>0|1,
56             # true false state
57             data=>'string'|ref,
58             # data for the $self->get_data command
59             msg=>'human readable string',
60             # message for the '""' op or $self->get_msg
61             extra=>'string'|ref
62             # extra paylod ( helpful in debugging )
63             );
64              
65             =cut
66              
67             sub new {
68 3     3 0 426 my ( $class, %args ) = @_;
69              
70 3         13 my $self = bless {%args}, $class;
71              
72 3         13 return $self;
73             }
74              
75             =pod
76              
77             new_true Net::SolarWinds::Result($data,$extra)
78              
79             Returns a new true object
80              
81             =cut
82              
83             sub new_true {
84 1     1 0 7 my ( $self, $data, $extra ) = @_;
85 1         5 return $self->new( bool => 1, data => $data, extra => $extra );
86             }
87              
88             =pod
89              
90             new_false Net::SolarWinds::Result($msg,$extra)
91              
92             Returns a new false instance
93              
94             =cut
95              
96             sub new_false {
97 1     1 0 5 my ( $self, $msg, $extra ) = @_;
98 1         3 return $self->new( bool => 0, msg => $msg, extra => $extra );
99             }
100              
101             =pod
102            
103             new_error Net::SolarWinds::Result($msg,$extra);
104              
105             Returns a new false instance
106              
107             =cut
108              
109             sub new_error {
110 0     0 0 0 my ( $self, $data, $extra ) = @_;
111 0         0 return $self->new( bool => 1, data => $data, extra => $extra );
112             }
113              
114             =pod
115              
116             new_ok Net::SolarWinds::Result($data,$extra);
117              
118             Returns a new true instance
119              
120             =cut
121              
122             sub new_ok {
123 0     0 0 0 my ( $self, $data, $extra ) = @_;
124 0         0 return $self->new( bool => 1, data => $data, extra => $extra );
125             }
126              
127             =item * if($self->is_ok) {...}
128              
129             Returns true if the instance is true.
130              
131             =cut
132              
133             sub is_ok {
134 14     14 0 928 my ($self) = @_;
135 14 0 33     41 return $self->{bool_cb}->() if exists $self->{bool_cb} and defined($self->{bool_cb}) and ref($self->{bool_cb}) and ref($self->{bool_cb}) eq 'CODE';
      33        
      0        
136 14         42 return $self->{bool};
137             }
138              
139             =item * my $data=$self->get_data
140              
141             Returns the object from the data field
142              
143             =cut
144              
145             sub get_data {
146 2     2 1 6 my ($self) = @_;
147              
148             # calls is_ok in a void context;
149 2         5 $self->is_ok;
150 2         9 return $self->{data};
151             }
152              
153             =item * my $extra=$self->get_extra
154              
155             Returns the object from the extra field
156              
157             =cut
158              
159             sub get_extra {
160 4     4 1 10 my ($self) = @_;
161 4         16 return $self->{extra};
162             }
163              
164             =item * $self->set_true($data,$extra)
165              
166             Sets the current argument to true, overloading the current $data and $extra objects
167              
168             =cut
169              
170             sub set_true {
171 1     1 1 3 my ( $self, $data, $extra ) = @_;
172              
173 1         3 $self->{bool} = 1;
174 1         2 $self->{data} = $data;
175 1         2 $self->{msg} = undef;
176 1         2 $self->{extra} = $extra;
177             }
178              
179             =item * my $error=$self->get_error
180              
181             Returns the current msg value
182              
183             =cut
184              
185             sub get_error {
186 0     0 1 0 my ($self) = @_;
187 0         0 return $self->{msg};
188             }
189              
190             =item * my $msg=$self->get_msg
191              
192             Returns the current msg value, if undef it returns ''
193              
194             =cut
195              
196             sub get_msg {
197 2     2 1 5 my ($self) = @_;
198              
199 2 50       12 return defined($self->{msg}) ? $self->{msg} : '';
200             }
201              
202             =item * $self->set_false($msg,$extra)
203              
204             Sets the object to a false state, this will destroy an objects in the $data field.
205              
206             =cut
207              
208             sub set_false {
209 1     1 1 4 my ( $self, $msg, $extra ) = @_;
210              
211 1         2 $self->{bool} = 0;
212 1         2 $self->{data} = undef;
213 1         4 $self->{msg} = $msg;
214 1         2 $self->{extra} = $extra;
215             }
216              
217             =item * $self->set_boolean_cb(sub { 0 } );
218              
219             Special case: allows for setting call backs for the boolean state.
220              
221             =cut
222              
223             sub set_boolean_cb {
224 0     0 1 0 my ($self,$cb)=@_;
225 0 0       0 delete $self->{bool_cb} unless defined($cb);
226 0         0 $self->{bool_cb}=$cb;
227             }
228              
229             =item * $self->DESTROY()
230              
231             Used for cleaning up the object internals
232              
233             =cut
234              
235             sub DESTROY {
236 3     3   921 my ($self)=@_;
237 3 100       25 return unless $self;
238 1         3 delete @{$self}{qw(bool data bool_cb extra)};
  1         5  
239             }
240              
241             =back
242              
243             =head1 AUTHOR
244              
245             Michael Shipper
246              
247             =cut
248              
249             1;