line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package ReturnValue; |
2
|
1
|
|
|
1
|
|
718
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
29
|
|
3
|
1
|
|
|
1
|
|
11
|
use v5.14; |
|
1
|
|
|
|
|
3
|
|
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
24
|
|
6
|
1
|
|
|
1
|
|
4
|
no warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
50
|
|
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
468
|
use parent qw(Hash::AsObject); |
|
1
|
|
|
|
|
300
|
|
|
1
|
|
|
|
|
5
|
|
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
1382
|
use Carp; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
334
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '0.903'; |
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
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
5
|
|
157
|
|
|
|
|
|
|
|
158
|
0
|
|
|
0
|
|
|
sub is_error { 0 } |
159
|
0
|
|
|
0
|
|
|
sub is_success { 1 } |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
package ReturnValue::Error { |
163
|
1
|
|
|
1
|
|
126
|
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; |