line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Scalar::Accessors::LikeHash; |
2
|
|
|
|
|
|
|
|
3
|
3
|
|
|
3
|
|
9089
|
use 5.008; |
|
3
|
|
|
|
|
14
|
|
|
3
|
|
|
|
|
128
|
|
4
|
3
|
|
|
3
|
|
19
|
use strict; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
160
|
|
5
|
3
|
|
|
3
|
|
17
|
use warnings; |
|
3
|
|
|
|
|
16
|
|
|
3
|
|
|
|
|
128
|
|
6
|
|
|
|
|
|
|
|
7
|
3
|
|
|
3
|
|
16
|
use Carp qw(croak); |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
175
|
|
8
|
3
|
|
|
3
|
|
17
|
use Role::Tiny; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
31
|
|
9
|
3
|
|
|
3
|
|
514
|
use Scalar::Util qw(blessed); |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
3046
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:TOBYINK'; |
12
|
|
|
|
|
|
|
our $VERSION = '0.002'; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
requires qw( _to_hash _from_hash ); |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub new |
17
|
|
|
|
|
|
|
{ |
18
|
4
|
50
|
|
4
|
1
|
3288
|
my $class = blessed($_[0]) ? ref(shift) : shift; |
19
|
|
|
|
|
|
|
|
20
|
4
|
50
|
|
|
|
20
|
croak "Class $class does not implement a constructor" |
21
|
|
|
|
|
|
|
unless $class->does(__PACKAGE__); |
22
|
|
|
|
|
|
|
|
23
|
0
|
|
|
|
|
0
|
return bless(ref $_ ? \${$_} : \$_, $class) |
24
|
4
|
50
|
|
|
|
6694
|
for (@_, $class->_empty_structure); |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub _empty_structure |
28
|
|
|
|
|
|
|
{ |
29
|
3
|
|
|
3
|
|
7
|
my $class = shift; |
30
|
3
|
|
|
|
|
22
|
$class->can('_from_hash')->(\(my $r), {}); |
31
|
3
|
|
|
|
|
23
|
return $r; |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub fetch |
35
|
|
|
|
|
|
|
{ |
36
|
6
|
|
|
6
|
1
|
18
|
my $invocant = shift; |
37
|
6
|
100
|
|
|
|
19
|
my $ref = (not ref $invocant) ? shift : $invocant; |
38
|
6
|
50
|
66
|
|
|
39
|
$invocant = __PACKAGE__ if ref $invocant && ! blessed $invocant; |
39
|
|
|
|
|
|
|
|
40
|
6
|
|
|
|
|
36
|
$invocant->can('_to_hash')->($ref)->{ $_[0] }; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub store |
44
|
|
|
|
|
|
|
{ |
45
|
10
|
|
|
10
|
1
|
2329
|
my $invocant = shift; |
46
|
10
|
100
|
|
|
|
29
|
my $ref = (not ref $invocant) ? shift : $invocant; |
47
|
10
|
50
|
66
|
|
|
682
|
$invocant = __PACKAGE__ if ref $invocant && ! blessed $invocant; |
48
|
|
|
|
|
|
|
|
49
|
10
|
|
|
|
|
59
|
my $hash = $invocant->can('_to_hash')->($ref); |
50
|
10
|
|
|
|
|
30
|
$hash->{ $_[0] } = $_[1]; |
51
|
10
|
|
|
|
|
52
|
$invocant->can('_from_hash')->($ref, $hash); |
52
|
10
|
|
|
|
|
53
|
return; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub exists |
56
|
|
|
|
|
|
|
{ |
57
|
10
|
|
|
10
|
1
|
49
|
my $invocant = shift; |
58
|
10
|
50
|
|
|
|
38
|
my $ref = (not ref $invocant) ? shift : $invocant; |
59
|
10
|
50
|
33
|
|
|
68
|
$invocant = __PACKAGE__ if ref $invocant && ! blessed $invocant; |
60
|
|
|
|
|
|
|
|
61
|
10
|
|
|
|
|
49
|
exists $invocant->can('_to_hash')->($ref)->{ $_[0] }; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub values |
65
|
|
|
|
|
|
|
{ |
66
|
2
|
|
|
2
|
1
|
5
|
my $invocant = shift; |
67
|
2
|
50
|
|
|
|
24
|
my $ref = (not ref $invocant) ? shift : $invocant; |
68
|
2
|
50
|
33
|
|
|
22
|
$invocant = __PACKAGE__ if ref $invocant && ! blessed $invocant; |
69
|
|
|
|
|
|
|
|
70
|
2
|
|
|
|
|
12
|
my $hash = $invocant->can('_to_hash')->($ref); |
71
|
2
|
|
|
|
|
11
|
map { $hash->{$_} } sort keys %$hash; |
|
4
|
|
|
|
|
21
|
|
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub keys |
75
|
|
|
|
|
|
|
{ |
76
|
10
|
|
|
10
|
1
|
16
|
my $invocant = shift; |
77
|
10
|
100
|
|
|
|
25
|
my $ref = (not ref $invocant) ? shift : $invocant; |
78
|
10
|
50
|
66
|
|
|
50
|
$invocant = __PACKAGE__ if ref $invocant && ! blessed $invocant; |
79
|
|
|
|
|
|
|
|
80
|
10
|
|
|
|
|
57
|
my $hash = $invocant->can('_to_hash')->($ref); |
81
|
10
|
|
|
|
|
82
|
sort keys %$hash; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub delete |
85
|
|
|
|
|
|
|
{ |
86
|
2
|
|
|
2
|
1
|
5
|
my $invocant = shift; |
87
|
2
|
50
|
|
|
|
11
|
my $ref = (not ref $invocant) ? shift : $invocant; |
88
|
2
|
50
|
33
|
|
|
37
|
$invocant = __PACKAGE__ if ref $invocant && ! blessed $invocant; |
89
|
|
|
|
|
|
|
|
90
|
2
|
|
|
|
|
15
|
my $hash = $invocant->can('_to_hash')->($ref); |
91
|
2
|
|
|
|
|
8
|
my $r = CORE::delete($hash->{ $_[0] }); |
92
|
2
|
|
|
|
|
14
|
$invocant->can('_from_hash')->($ref, $hash); |
93
|
2
|
|
|
|
|
16
|
return $r; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
sub clear |
97
|
|
|
|
|
|
|
{ |
98
|
2
|
|
|
2
|
1
|
4
|
my $invocant = shift; |
99
|
2
|
50
|
|
|
|
10
|
my $ref = (not ref $invocant) ? shift : $invocant; |
100
|
2
|
50
|
33
|
|
|
26
|
$invocant = __PACKAGE__ if ref $invocant && ! blessed $invocant; |
101
|
|
|
|
|
|
|
|
102
|
2
|
|
|
|
|
9
|
$$ref = $invocant->_empty_structure; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
1; |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
__END__ |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=head1 NAME |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
Scalar::Accessors::LikeHash - access a JSON/Sereal/etc scalar string in a hash-like manner |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=head1 SYNOPSIS |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
{ |
116
|
|
|
|
|
|
|
package Acme::Storable::Accessors; |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
use Storable qw/ freeze thaw /; |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
use Role::Tiny::With; |
121
|
|
|
|
|
|
|
with 'Scalar::Accessors::LikeHash'; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
sub _to_hash { |
124
|
|
|
|
|
|
|
my ($ref) = @_; |
125
|
|
|
|
|
|
|
thaw($$ref); |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
sub _from_hash { |
129
|
|
|
|
|
|
|
my ($ref, $hash) = @_; |
130
|
|
|
|
|
|
|
$$ref = freeze($hash); |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
my $string = File::Slurp::slurp("some-data.storable"); |
135
|
|
|
|
|
|
|
my $object = Acme::Storable::Accessors->new(\$string); |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
$object->store(some_key => 42) unless $object->exists('some_key'); |
138
|
|
|
|
|
|
|
$object->fetch('some_key'); |
139
|
|
|
|
|
|
|
$object->delete('some_key'); |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=head1 DESCRIPTION |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
The idea of this is to treat a reference to a string as if it were a hash. |
144
|
|
|
|
|
|
|
You can store key-values pairs; fetch values using keys; delete keys; etc. |
145
|
|
|
|
|
|
|
This is slow and quite silly. |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
This module is a role. Concrete implementations of the role need to provide |
148
|
|
|
|
|
|
|
C<< _from_hash >> and C<< _to_hash >> methods to serialize and deserialize |
149
|
|
|
|
|
|
|
a hashref to/from a scalarref. |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
This role provides the following methods: |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=over |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=item C<< new(\$scalar) >> |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
Yes, this role provides a constructor. Consumers can overide it. |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=item C<< fetch($key) >> |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=item C<< store($key, $value) >> |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=item C<< exists($key) >> |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=item C<< delete($key) >> |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=item C<< clear() >> |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
Delete for each key. |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=item C<< keys() >> |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=item C<< values() >> |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=back |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
These can be called as methods on a blessed scalar reference: |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
my $string = "{}"; |
180
|
|
|
|
|
|
|
bless \$string, "Scalar::Accessors::LikeHash::JSON"; |
181
|
|
|
|
|
|
|
$string->store(foo => 42); |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
Or as class methods passing the scalar reference as an extra first argument: |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
my $string = "{}"; |
186
|
|
|
|
|
|
|
Scalar::Accessors::LikeHash::JSON->store(\$string, foo => 42); |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=head1 BUGS |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
Please report any bugs to |
191
|
|
|
|
|
|
|
L<http://rt.cpan.org/Dist/Display.html?Queue=Scalar-Accessors-LikeHash>. |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=head1 SEE ALSO |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
For a more usable interface, see L<Tie::Hash::SerializedString>. |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
For concrete implementations, see L<Scalar::Accessors::LikeHash::JSON> |
198
|
|
|
|
|
|
|
and L<Scalar::Accessors::LikeHash::Sereal>. |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
For an insane usage of this concept, see L<Acme::MooseX::JSON>. |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=head1 AUTHOR |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
Toby Inkster E<lt>tobyink@cpan.orgE<gt>. |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENCE |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
This software is copyright (c) 2013 by Toby Inkster. |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
211
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=head1 DISCLAIMER OF WARRANTIES |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED |
216
|
|
|
|
|
|
|
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF |
217
|
|
|
|
|
|
|
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. |
218
|
|
|
|
|
|
|
|