File Coverage

blib/lib/ReturnValue.pm
Criterion Covered Total %
statement 23 44 52.2
branch 0 2 0.0
condition n/a
subroutine 8 20 40.0
pod 7 7 100.0
total 38 73 52.0


line stmt bran cond sub pod time code
1             package ReturnValue;
2 1     1   823 use strict;
  1         2  
  1         32  
3 1     1   13 use v5.14;
  1         4  
4              
5 1     1   6 use warnings;
  1         2  
  1         34  
6 1     1   5 no warnings;
  1         1  
  1         57  
7              
8 1     1   511 use parent qw(Hash::AsObject);
  1         385  
  1         6  
9              
10 1     1   1462 use Carp;
  1         3  
  1         371  
11              
12             our $VERSION = '0.902';
13              
14             =encoding utf8
15              
16             =head1 NAME
17              
18             ReturnValue - A structured return value for failure or success
19              
20             =head1 SYNOPSIS
21              
22             use ReturnValue;
23              
24             sub do_something {
25             ...;
26              
27             return ReturnValue->error(
28             value => $your_usual_error_value,
29             description => 'Some longer description',
30             tag => 'short_value'
31             ) if $failed;
32              
33             return ReturnValue->success(
34             value => $your_usual_return_value,
35             description => 'Some longer description',
36             tag => 'short_value'
37             ) unless $failed;
38             }
39              
40              
41             my $result = do_something();
42             if( $result->is_error ) {
43             ...; # do error stuff
44             }
45              
46             my $result = do_something_else();
47             for( $result->tag ) {
48             when( 'tag1' ) { ... }
49             when( 'tag2' ) { ... }
50              
51             }
52              
53             =head1 DESCRIPTION
54              
55             The C class provides a very simple wrapper around a value
56             so you can tell if it's a success or failure without taking pains to
57             examine the particular value. Instead of using exceptions, you inspect
58             the class of the object you get back. Errors and successes flow through
59             the same path.
60              
61             This isn't particularly interesting for success values, but can be
62             helpful with multiple ways to describe an error.
63              
64             =over 4
65              
66             =cut
67              
68             sub _new {
69 0     0     my $allowed = {
70             value => 'required',
71             description => 0,
72             tag => 0,
73             };
74              
75 0           my( $class, %hash ) = @_;
76              
77 0           delete $allowed->{$_} for keys %hash;
78              
79             # these are the keys that are left over after the
80             # last foreach. These are a problem if they are
81             # requires
82 0           foreach my $key ( keys %$allowed ) {
83 0 0         next unless $allowed->{$key};
84 0           carp "required key [$key] is missing";
85 0           return;
86             }
87              
88 0           bless \%hash, $class;
89             }
90              
91             =item success
92              
93             Create a success object
94              
95             =item error
96              
97             Create an error object
98              
99             =cut
100              
101             sub success {
102 0     0 1   my( $self ) = shift;
103 0           $self->success_type->_new( @_ );
104             }
105              
106             sub error {
107 0     0 1   my( $self ) = shift;
108 0           $self->error_type->_new( @_ );
109             }
110              
111             =item value
112              
113             The value that you'd normally return. This class doesn't care what it
114             is. It can be a number, string, or reference. It's up to your application
115             to figure out how you want to do that.
116              
117             =item description
118              
119             A long description of the return values,
120              
121             =item tag
122              
123             A short tag suitable for switching on in a C, or something
124             similar.
125              
126             =cut
127              
128 0     0 1   sub value { $_[0]->{value} }
129 0     0 1   sub description { $_[0]->{description} }
130 0     0 1   sub tag { $_[0]->{tag} }
131              
132             =item success_type
133              
134             Returns the class for success objects
135              
136             =item error_type
137              
138             Returns the class for error objects
139              
140             =cut
141              
142 0     0 1   sub error_type { 'ReturnValue::Error' }
143 0     0 1   sub success_type { 'ReturnValue::Success' }
144              
145             =item is_success
146              
147             Returns true is the result represents a success
148              
149             =item is_error
150              
151             Returns true is the result represents an error
152              
153             =cut
154              
155             package ReturnValue::Success {
156 1     1   8 use parent qw(ReturnValue);
  1         2  
  1         6  
157              
158 0     0     sub is_error { 0 }
159 0     0     sub is_success { 1 }
160             }
161              
162             package ReturnValue::Error {
163 1     1   115 use parent qw(ReturnValue);
  1         2  
  1         4  
164              
165 0     0     sub is_error { 1 }
166 0     0     sub is_success { 0 }
167             }
168              
169             =back
170              
171             =head1 TO DO
172              
173              
174             =head1 SEE ALSO
175              
176              
177             =head1 SOURCE AVAILABILITY
178              
179             This source is in Github:
180              
181             http://github.com/perlreview/returnvalue/
182              
183             =head1 AUTHOR
184              
185             brian d foy,
186              
187             =head1 COPYRIGHT AND LICENSE
188              
189             Copyright © 2013-2022, brian d foy . All rights reserved.
190              
191             You may redistribute this under the terms of the Artistic License 2.0.
192              
193             =cut
194              
195             1;