| 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; |