File Coverage

blib/lib/Tie/Hash/SerializedString.pm
Criterion Covered Total %
statement 45 45 100.0
branch 4 6 66.6
condition 3 3 100.0
subroutine 12 12 100.0
pod n/a
total 64 66 96.9


line stmt bran cond sub pod time code
1             package Tie::Hash::SerializedString;
2              
3 1     1   52764 use 5.008;
  1         6  
  1         109  
4 1     1   11 use strict;
  1         3  
  1         60  
5 1     1   10 use warnings;
  1         2  
  1         94  
6              
7             our $AUTHORITY = 'cpan:TOBYINK';
8             our $VERSION = '0.001';
9              
10 1     1   7 use base "Tie::Hash";
  1         2  
  1         1365  
11 1     1   1638 use Carp;
  1         5  
  1         77  
12 1     1   1379 use Module::Runtime;
  1         2772  
  1         7  
13              
14             sub TIEHASH
15             {
16 1     1   14 my $class = shift;
17 1         3 my ($ref, $implementation) = @_;
18 1 50       6 croak "need a scalar ref to tie hash to" unless ref $ref eq 'SCALAR';
19 1 50       4 $implementation = "Scalar::Accessors::LikeHash::JSON" unless defined $implementation;
20 1         7 Module::Runtime::use_package_optimistically($implementation);
21 1         22 bless [$implementation, $ref] => $class;
22             }
23              
24             for my $method (qw( STORE FETCH EXISTS DELETE CLEAR ))
25             {
26             my $lc_method = lc $method;
27             my $coderef = sub {
28 4     4   370 my ($implementation, $ref) = @{+shift};
  4         12  
29 4         22 return $implementation->$lc_method($ref, @_);
30             };
31 1     1   150 no strict 'refs';
  1         1  
  1         181  
32             *$method = $coderef;
33             }
34              
35             sub FIRSTKEY
36             {
37 2     2   11 my ($implementation, $ref) = @{+shift};
  2         5  
38 2         9 my @keys = $implementation->keys($ref);
39 2         10 return $keys[0];
40             }
41              
42             sub NEXTKEY
43             {
44 4     4   4 my ($implementation, $ref) = @{+shift};
  4         8  
45 4         4 my ($lastkey) = @_;
46 4         15 my @keys = $implementation->keys($ref);
47 4         11 while (@keys)
48             {
49 6         7 my $this = shift @keys;
50 6 100 100     35 return $keys[0] if $this eq $lastkey && @keys;
51             }
52 2         15 return;
53             }
54              
55             sub SCALAR
56             {
57 1     1   560 my ($implementation, $ref) = @{+shift};
  1         3  
58 1         4 return $$ref;
59             }
60              
61             1;
62              
63             __END__
64              
65             =head1 NAME
66              
67             Tie::Hash::SerializedString - tied interface for Scalar::Accessors::LikeHash
68              
69             =head1 SYNOPSIS
70              
71             my $string = '{}';
72             tie my %hash, "Tie::Hash::SerializedString", \$string;
73            
74             $hash{foo} = "bar";
75            
76             print $string; # prints '{"foo":"bar"}'
77              
78             =head1 DESCRIPTION
79              
80             This provides a tied hash wrapper around L<Scalar::Accessors::LikeHash>
81             implementations.
82              
83             Usage: C<< tie %hash, "Tie::Hash::SerializedString", \$scalar, $impl >>
84              
85             ... where C<< $impl >> is the class name of a concrete implementation of the
86             L<Scalar::Accessors::LikeHash> role. If the implementation is omitted, then
87             defaults to L<Scalar::Accessors::LikeHash::JSON>.
88              
89             =head1 BUGS
90              
91             Please report any bugs to
92             L<http://rt.cpan.org/Dist/Display.html?Queue=Scalar-Accessors-LikeHash>.
93              
94             =head1 SEE ALSO
95              
96             L<Scalar::Accessors::LikeHash>.
97              
98             =head1 AUTHOR
99              
100             Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
101              
102             =head1 COPYRIGHT AND LICENCE
103              
104             This software is copyright (c) 2013 by Toby Inkster.
105              
106             This is free software; you can redistribute it and/or modify it under
107             the same terms as the Perl 5 programming language system itself.
108              
109             =head1 DISCLAIMER OF WARRANTIES
110              
111             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
112             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
113             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
114