line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package IO::Iron::IronCache::Cache; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
## no critic (Documentation::RequirePodAtEnd) |
4
|
|
|
|
|
|
|
## no critic (Documentation::RequirePodSections) |
5
|
|
|
|
|
|
|
## no critic (ControlStructures::ProhibitPostfixControls) |
6
|
|
|
|
|
|
|
## no critic (Subroutines::RequireArgUnpacking) |
7
|
|
|
|
|
|
|
|
8
|
6
|
|
|
6
|
|
101
|
use 5.010_000; |
|
6
|
|
|
|
|
20
|
|
9
|
6
|
|
|
6
|
|
31
|
use strict; |
|
6
|
|
|
|
|
17
|
|
|
6
|
|
|
|
|
140
|
|
10
|
6
|
|
|
6
|
|
32
|
use warnings; |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
205
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# Global creator |
13
|
0
|
|
|
|
|
0
|
BEGIN { |
14
|
|
|
|
|
|
|
# Export Nothing |
15
|
6
|
|
|
6
|
|
41
|
use parent qw(IO::Iron::IronCache::Policy); # Inheritance |
|
6
|
|
|
0
|
|
20
|
|
|
6
|
|
|
|
|
42
|
|
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# Global destructor |
19
|
|
|
|
6
|
|
|
END { |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# ABSTRACT: IronCache (Online Item-Value Storage) Client (Cache). |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
our $VERSION = '0.13'; # VERSION: generated by DZP::OurPkgVersion |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
|
29
|
6
|
|
|
6
|
|
722
|
use Log::Any qw($log); |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
43
|
|
30
|
6
|
|
|
6
|
|
1171
|
use Hash::Util 0.06 qw{lock_keys unlock_keys}; |
|
6
|
|
|
|
|
92
|
|
|
6
|
|
|
|
|
32
|
|
31
|
6
|
|
|
6
|
|
422
|
use Carp::Assert::More; |
|
6
|
|
|
|
|
17
|
|
|
6
|
|
|
|
|
908
|
|
32
|
6
|
|
|
6
|
|
42
|
use English '-no_match_vars'; |
|
6
|
|
|
|
|
19
|
|
|
6
|
|
|
|
|
31
|
|
33
|
6
|
|
|
6
|
|
2181
|
use Params::Validate qw(:all); |
|
6
|
|
|
|
|
14
|
|
|
6
|
|
|
|
|
770
|
|
34
|
|
|
|
|
|
|
|
35
|
6
|
|
|
6
|
|
38
|
use IO::Iron::Common; |
|
6
|
|
|
|
|
19
|
|
|
6
|
|
|
|
|
199
|
|
36
|
6
|
|
|
6
|
|
38
|
use IO::Iron::IronCache::Api; |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
7779
|
|
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
# CONSTANTS for this module |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# DEFAULTS |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
sub new { |
45
|
1
|
|
|
1
|
1
|
4
|
my ($class, $params) = @_; |
46
|
1
|
|
|
|
|
5
|
$log->tracef('Entering new(%s, %s)', $class, $params); |
47
|
1
|
|
|
|
|
358
|
my $self; |
48
|
1
|
|
|
|
|
4
|
my @self_keys = ( ## no critic (CodeLayout::ProhibitQuotedWordLists) |
49
|
|
|
|
|
|
|
'ironcache_client', # Reference to IronCache client |
50
|
|
|
|
|
|
|
'name', # Cache name |
51
|
|
|
|
|
|
|
'connection', # Reference to REST client |
52
|
|
|
|
|
|
|
'policy', # The policies. (copied from the client.) |
53
|
|
|
|
|
|
|
'last_http_status_code', # After successfull network operation, the return value is here. |
54
|
|
|
|
|
|
|
); |
55
|
1
|
|
|
|
|
2
|
lock_keys(%{$self}, @self_keys); |
|
1
|
|
|
|
|
6
|
|
56
|
1
|
50
|
|
|
|
80
|
$self->{'ironcache_client'} = defined $params->{'ironcache_client'} ? $params->{'ironcache_client'} : undef; |
57
|
1
|
50
|
|
|
|
5
|
$self->{'name'} = defined $params->{'name'} ? $params->{'name'} : undef; |
58
|
1
|
50
|
|
|
|
4
|
$self->{'connection'} = defined $params->{'connection'} ? $params->{'connection'} : undef; |
59
|
1
|
50
|
|
|
|
4
|
$self->{'policy'} = defined $params->{'policy'} ? $params->{'policy'} : undef; |
60
|
1
|
|
|
|
|
28
|
assert_isa( $self->{'ironcache_client'}, 'IO::Iron::IronCache::Client' , 'self->{ironcache_client} is IO::Iron::IronCache::Client.'); |
61
|
1
|
|
|
|
|
24
|
assert_nonblank( $self->{'name'}, 'self->{name} is defined and is not blank.' ); |
62
|
1
|
|
|
|
|
31
|
assert_isa( $self->{'connection'}, 'IO::Iron::Connection' , 'self->{connection} is IO::Iron::Connection.'); |
63
|
1
|
|
|
|
|
18
|
assert_hashref( $self->{'policy'}, 'self->{policy} is a reference to a hash.'); |
64
|
|
|
|
|
|
|
|
65
|
1
|
|
|
|
|
18
|
unlock_keys(%{$self}); |
|
1
|
|
|
|
|
5
|
|
66
|
1
|
|
|
|
|
9
|
my $blessed_ref = bless $self, $class; |
67
|
1
|
|
|
|
|
3
|
lock_keys(%{$self}, @self_keys); |
|
1
|
|
|
|
|
20
|
|
68
|
|
|
|
|
|
|
|
69
|
1
|
|
|
|
|
75
|
$log->tracef('Exiting new: %s', $blessed_ref); |
70
|
1
|
|
|
|
|
409
|
return $blessed_ref; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
|
74
|
0
|
|
|
0
|
1
|
0
|
sub name { return $_[0]->_access_internal('name', $_[1]); } |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# TODO Move _access_internal() to IO::Iron::Common. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub _access_internal { |
79
|
0
|
|
|
0
|
|
0
|
my ($self, $var_name, $var_value) = @_; |
80
|
0
|
|
|
|
|
0
|
$log->tracef('_access_internal(%s, %s)', $var_name, $var_value); |
81
|
0
|
0
|
|
|
|
0
|
if( defined $var_value ) { |
82
|
0
|
|
|
|
|
0
|
$self->{$var_name} = $var_value; |
83
|
0
|
|
|
|
|
0
|
return $self; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
else { |
86
|
0
|
|
|
|
|
0
|
return $self->{$var_name}; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub clear { |
92
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
93
|
0
|
|
|
|
|
0
|
my %params = validate( |
94
|
|
|
|
|
|
|
@_, { |
95
|
|
|
|
|
|
|
# No parameters |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
); |
98
|
0
|
|
|
|
|
0
|
$log->tracef('Entering clear()'); |
99
|
|
|
|
|
|
|
|
100
|
0
|
|
|
|
|
0
|
my $cache_name = $self->name(); |
101
|
0
|
|
|
|
|
0
|
my $connection = $self->{'connection'}; |
102
|
0
|
|
|
|
|
0
|
my ($http_status_code, $response_message) = $connection->perform_iron_action( |
103
|
|
|
|
|
|
|
IO::Iron::IronCache::Api::IRONCACHE_CLEAR_A_CACHE(), |
104
|
|
|
|
|
|
|
{ |
105
|
|
|
|
|
|
|
'{Cache Name}' => $cache_name, |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
); |
108
|
0
|
|
|
|
|
0
|
$self->{'last_http_status_code'} = $http_status_code; |
109
|
|
|
|
|
|
|
|
110
|
0
|
|
|
|
|
0
|
$log->tracef('Exiting clear: %d', 1); |
111
|
0
|
|
|
|
|
0
|
return 1; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub put { |
116
|
1
|
|
|
1
|
1
|
66
|
my $self = shift; |
117
|
|
|
|
|
|
|
my %params = validate( |
118
|
|
|
|
|
|
|
@_, { |
119
|
|
|
|
|
|
|
'key' => { type => SCALAR, callbacks => { |
120
|
1
|
|
|
1
|
|
6
|
'RFC 3986 reserved character check' => sub { return ! IO::Iron::Common::contains_rfc_3986_res_chars(shift) }, |
121
|
|
|
|
|
|
|
}}, # cache item key. |
122
|
1
|
|
|
|
|
30
|
'item' => { isa => 'IO::Iron::IronCache::Item', }, # cache item. |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
); |
125
|
1
|
|
|
|
|
15
|
$log->tracef('Entering put(%s)', \%params); |
126
|
|
|
|
|
|
|
|
127
|
1
|
|
|
|
|
270
|
$self->validate_item_key('key' => $params{'key'}); |
128
|
0
|
|
|
|
|
|
my $cache_name = $self->name(); |
129
|
0
|
|
|
|
|
|
my $connection = $self->{'connection'}; |
130
|
0
|
|
|
|
|
|
my %item_body; |
131
|
0
|
|
|
|
|
|
foreach my $field_name (keys %{ IO::Iron::IronCache::Api::IRONCACHE_PUT_AN_ITEM_INTO_A_CACHE()->{'request_fields'}}) { |
|
0
|
|
|
|
|
|
|
132
|
0
|
0
|
|
|
|
|
if (defined $params{'item'}->{$field_name}) { |
133
|
0
|
|
|
|
|
|
$item_body{$field_name} = $params{'item'}->{$field_name}; |
134
|
|
|
|
|
|
|
}; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
my ($http_status_code, $response_message) = $connection->perform_iron_action( |
137
|
|
|
|
|
|
|
IO::Iron::IronCache::Api::IRONCACHE_PUT_AN_ITEM_INTO_A_CACHE(), |
138
|
|
|
|
|
|
|
{ |
139
|
|
|
|
|
|
|
'{Cache Name}' => $cache_name, |
140
|
0
|
|
|
|
|
|
'{Key}' => $params{'key'}, |
141
|
|
|
|
|
|
|
'body' => \%item_body, |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
); |
144
|
0
|
|
|
|
|
|
$self->{'last_http_status_code'} = $http_status_code; |
145
|
|
|
|
|
|
|
|
146
|
0
|
|
|
|
|
|
$log->tracef('Exiting put: %d', 1); |
147
|
0
|
|
|
|
|
|
return 1; |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
# TODO Correct documentation: if item does not exist, it is created. |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
sub increment { |
154
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
155
|
|
|
|
|
|
|
my %params = validate( |
156
|
|
|
|
|
|
|
@_, { |
157
|
|
|
|
|
|
|
'key' => { type => SCALAR, callbacks => { |
158
|
0
|
|
|
0
|
|
|
'RFC 3986 reserved character check' => sub { return ! IO::Iron::Common::contains_rfc_3986_res_chars(shift) }, |
159
|
|
|
|
|
|
|
}}, # cache item key. |
160
|
0
|
|
|
|
|
|
'increment' => { type => SCALAR, }, # cache item increment. |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
); |
163
|
0
|
|
|
|
|
|
assert_nonblank( $params{'key'}, 'key is defined and is not blank.' ); |
164
|
0
|
|
|
|
|
|
assert_integer( $params{'increment'}, 'increment amount is integer.'); |
165
|
0
|
|
|
|
|
|
$log->tracef('Entering increment(%s)', \%params); |
166
|
|
|
|
|
|
|
|
167
|
0
|
|
|
|
|
|
$self->validate_item_key('key' => $params{'key'}); |
168
|
0
|
|
|
|
|
|
my $cache_name = $self->name(); |
169
|
0
|
|
|
|
|
|
my $connection = $self->{'connection'}; |
170
|
0
|
|
|
|
|
|
my %item_body; |
171
|
0
|
|
|
|
|
|
$item_body{'amount'} = $params{'increment'}; |
172
|
|
|
|
|
|
|
my ($http_status_code, $response_message) = $connection->perform_iron_action( |
173
|
|
|
|
|
|
|
IO::Iron::IronCache::Api::IRONCACHE_INCREMENT_AN_ITEMS_VALUE(), |
174
|
|
|
|
|
|
|
{ |
175
|
|
|
|
|
|
|
'{Cache Name}' => $cache_name, |
176
|
0
|
|
|
|
|
|
'{Key}' => $params{'key'}, |
177
|
|
|
|
|
|
|
'body' => \%item_body, |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
); |
180
|
0
|
|
|
|
|
|
$self->{'last_http_status_code'} = $http_status_code; |
181
|
0
|
|
|
|
|
|
my $new_value = $response_message->{'value'}; |
182
|
|
|
|
|
|
|
|
183
|
0
|
|
|
|
|
|
$log->tracef('Exiting increment: %d', $new_value); |
184
|
0
|
|
|
|
|
|
return $new_value; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
sub get { |
189
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
190
|
0
|
|
|
|
|
|
my %params = validate( |
191
|
|
|
|
|
|
|
@_, { |
192
|
|
|
|
|
|
|
'key' => { type => SCALAR, }, # cache item key. |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
); |
195
|
0
|
|
|
|
|
|
assert_nonblank( $params{'key'}, 'key is defined and is not blank.' ); |
196
|
0
|
|
|
|
|
|
$log->tracef('Entering get(%s)', \%params); |
197
|
|
|
|
|
|
|
|
198
|
0
|
|
|
|
|
|
my $cache_name = $self->name(); |
199
|
0
|
|
|
|
|
|
my $connection = $self->{'connection'}; |
200
|
|
|
|
|
|
|
my ($http_status_code, $response_message) = $connection->perform_iron_action( |
201
|
|
|
|
|
|
|
IO::Iron::IronCache::Api::IRONCACHE_GET_AN_ITEM_FROM_A_CACHE(), |
202
|
|
|
|
|
|
|
{ |
203
|
|
|
|
|
|
|
'{Cache Name}' => $cache_name, |
204
|
0
|
|
|
|
|
|
'{Key}' => $params{'key'}, |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
); |
207
|
0
|
|
|
|
|
|
$self->{'last_http_status_code'} = $http_status_code; |
208
|
|
|
|
|
|
|
my $new_item = IO::Iron::IronCache::Item->new( |
209
|
|
|
|
|
|
|
'value' => $response_message->{'value'}, |
210
|
0
|
|
|
|
|
|
'cas' => $response_message->{'cas'}, |
211
|
|
|
|
|
|
|
); |
212
|
0
|
0
|
|
|
|
|
$new_item->expires($response_message->{'expires'}) if defined $response_message->{'expires'}; |
213
|
0
|
0
|
|
|
|
|
$new_item->replace($response_message->{'replace'}) if defined $response_message->{'replace'}; |
214
|
0
|
0
|
|
|
|
|
$new_item->add($response_message->{'add'}) if defined $response_message->{'add'}; |
215
|
|
|
|
|
|
|
|
216
|
0
|
|
|
|
|
|
$log->tracef('Exiting get: %s', $new_item); |
217
|
0
|
|
|
|
|
|
return $new_item; |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
sub delete { ## no critic (Subroutines::ProhibitBuiltinHomonyms) |
222
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
223
|
0
|
|
|
|
|
|
my %params = validate( |
224
|
|
|
|
|
|
|
@_, { |
225
|
|
|
|
|
|
|
'key' => { type => SCALAR, }, # cache item key. |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
); |
228
|
0
|
|
|
|
|
|
assert_nonblank( $params{'key'}, 'key is defined and is not blank.' ); |
229
|
0
|
|
|
|
|
|
$log->tracef('Entering delete(%s)', \%params); |
230
|
|
|
|
|
|
|
|
231
|
0
|
|
|
|
|
|
my $cache_name = $self->name(); |
232
|
0
|
|
|
|
|
|
my $connection = $self->{'connection'}; |
233
|
|
|
|
|
|
|
my ($http_status_code, $response_message) = $connection->perform_iron_action( |
234
|
|
|
|
|
|
|
IO::Iron::IronCache::Api::IRONCACHE_DELETE_AN_ITEM_FROM_A_CACHE(), |
235
|
|
|
|
|
|
|
{ |
236
|
|
|
|
|
|
|
'{Cache Name}' => $cache_name, |
237
|
0
|
|
|
|
|
|
'{Key}' => $params{'key'}, |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
); |
240
|
0
|
|
|
|
|
|
$self->{'last_http_status_code'} = $http_status_code; |
241
|
|
|
|
|
|
|
|
242
|
0
|
|
|
|
|
|
$log->tracef('Exiting delete: %d', 1); |
243
|
0
|
|
|
|
|
|
return 1; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
1; |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
__END__ |