File Coverage

lib/Ubic/Persistent.pm
Criterion Covered Total %
statement 44 47 93.6
branch 4 6 66.6
condition n/a
subroutine 12 12 100.0
pod 3 3 100.0
total 63 68 92.6


line stmt bran cond sub pod time code
1             package Ubic::Persistent;
2             $Ubic::Persistent::VERSION = '1.59';
3 23     23   88 use strict;
  23         31  
  23         544  
4 23     23   76 use warnings;
  23         23  
  23         471  
5              
6             # ABSTRACT: simple hash-to-file persistence object
7              
8              
9 23     23   9186 use JSON;
  23         124501  
  23         135  
10 23     23   8429 use Ubic::Lockf;
  23         45  
  23         1003  
11 23     23   5414 use Ubic::AtomicFile;
  23         33  
  23         591  
12              
13             {
14             # support the compatibility with JSON.pm v1 just because we can
15             # see also: Ubic::ServiceLoader::Ext::json
16 23     23   99 no strict;
  23         28  
  23         389  
17 23     23   78 no warnings;
  23         25  
  23         8310  
18             sub jsonToObj; *jsonToObj = (*{JSON::from_json}{CODE}) ? \&JSON::from_json : \&JSON::jsonToObj;
19             sub objToJson; *objToJson = (*{JSON::to_json}{CODE}) ? \&JSON::to_json : \&JSON::objToJson;
20             }
21              
22             my $meta = {};
23              
24             sub _load {
25 25     25   33 my ($fname) = @_;
26              
27 25 50       657 open my $fh, '<', $fname or die "Can't open $fname: $!";
28 25         33 my $data;
29 25         136 local $/;
30 25         414 my $str = <$fh>;
31 25 50       130 if ($str =~ /^\$data/) {
32             # old Data::Dumper format, parsing with regexes
33 0         0 my ($status) = $str =~ m{'status' => '(\w+)'};
34 0         0 my ($enabled) = $str =~ m{'enabled' => (\d+)};
35 0         0 $data = { status => $status, enabled => $enabled };
36             }
37             else {
38 25         158 $data = jsonToObj($str);
39             }
40              
41 25         1097 return $data;
42             }
43              
44             sub load {
45 12     12 1 33 my ($class, $fname) = @_;
46 12         43 return _load($fname);
47             }
48              
49             sub new {
50 24     24 1 36 my ($class, $fname) = @_;
51 24         123 my $lock = lockf("$fname.lock", { blocking => 1 });
52              
53 24         52 my $self = {};
54 24 100       284 $self = _load($fname) if -e $fname;
55              
56 24         184 bless $self => $class;
57 24         224 $meta->{$self} = { lock => $lock, fname => $fname };
58 24         103 return $self;
59             }
60              
61             sub commit {
62 24     24 1 35 my $self = shift;
63 24         45 my $fname = $meta->{$self}{fname};
64              
65 24         200 Ubic::AtomicFile::store(objToJson({ %$self }) => $fname);
66             }
67              
68             sub DESTROY {
69 24     24   67 my $self = shift;
70 24         51 local $@;
71 24         303 delete $meta->{$self};
72             }
73              
74              
75             1;
76              
77             __END__