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.60';
3 23     23   79 use strict;
  23         27  
  23         496  
4 23     23   61 use warnings;
  23         26  
  23         403  
5              
6             # ABSTRACT: simple hash-to-file persistence object
7              
8              
9 23     23   8103 use JSON;
  23         107043  
  23         107  
10 23     23   7474 use Ubic::Lockf;
  23         31  
  23         949  
11 23     23   5246 use Ubic::AtomicFile;
  23         34  
  23         511  
12              
13             {
14             # support the compatibility with JSON.pm v1 just because we can
15             # see also: Ubic::ServiceLoader::Ext::json
16 23     23   92 no strict;
  23         23  
  23         336  
17 23     23   57 no warnings;
  23         28  
  23         7666  
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   37 my ($fname) = @_;
26              
27 25 50       647 open my $fh, '<', $fname or die "Can't open $fname: $!";
28 25         32 my $data;
29 25         118 local $/;
30 25         344 my $str = <$fh>;
31 25 50       94 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         166 $data = jsonToObj($str);
39             }
40              
41 25         926 return $data;
42             }
43              
44             sub load {
45 12     12 1 30 my ($class, $fname) = @_;
46 12         40 return _load($fname);
47             }
48              
49             sub new {
50 24     24 1 45 my ($class, $fname) = @_;
51 24         110 my $lock = lockf("$fname.lock", { blocking => 1 });
52              
53 24         65 my $self = {};
54 24 100       293 $self = _load($fname) if -e $fname;
55              
56 24         175 bless $self => $class;
57 24         210 $meta->{$self} = { lock => $lock, fname => $fname };
58 24         100 return $self;
59             }
60              
61             sub commit {
62 24     24 1 32 my $self = shift;
63 24         46 my $fname = $meta->{$self}{fname};
64              
65 24         148 Ubic::AtomicFile::store(objToJson({ %$self }) => $fname);
66             }
67              
68             sub DESTROY {
69 24     24   69 my $self = shift;
70 24         51 local $@;
71 24         403 delete $meta->{$self};
72             }
73              
74              
75             1;
76              
77             __END__