File Coverage

blib/lib/Storable/AMF3.pm
Criterion Covered Total %
statement 49 50 98.0
branch 12 18 66.6
condition n/a
subroutine 13 13 100.0
pod 4 4 100.0
total 78 85 91.7


line stmt bran cond sub pod time code
1             package Storable::AMF3;
2             # vim: ts=8 sw=4 sts=4 et
3 17     17   45174 use strict;
  17         23  
  17         426  
4 17     17   56 use warnings;
  17         17  
  17         377  
5 17     17   51 use Fcntl qw(:flock);
  17         21  
  17         1695  
6 17     17   4717 use subs qw(freeze thaw);
  17         254  
  17         70  
7 17     17   633 use Exporter 'import';
  17         20  
  17         448  
8 17     17   57 use Carp qw(croak);
  17         26  
  17         1040  
9             BEGIN {
10 17     17   20 our $VERSION;
11 17 100       305 $VERSION = '1.22' unless $INC{'Storable/AMF0.pm'};
12             }
13 17     17   3582 use Storable::AMF0 ();
  17         21  
  17         5872  
14              
15             # Items to export into callers namespace by default. Note: do not export
16             # names by default without a very good reason. Use EXPORT_OK instead.
17             # Do not simply export all your public functions/methods/constants.
18              
19             our %EXPORT_TAGS = (
20             'all' => [
21             qw(
22             freeze thaw dclone retrieve lock_retrieve lock_store lock_nstore store nstore
23             ref_clear ref_lost_memory
24             deparse_amf new_amfdate perl_date
25             new_date
26             parse_option
27             parse_serializator_option
28             )
29             ]
30             );
31              
32             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
33              
34             our @EXPORT = qw();
35              
36             sub retrieve($) {
37 11     11 1 33 my $file = shift;
38 11         18 my $lock = shift;
39              
40 11 50       406 open my $fh, "<:raw", $file or croak "Can't open file \"$file\" for read.";
41 11 100       40 flock $fh, LOCK_SH if $lock;
42 11         16 my $buf;
43 11         88 sysread $fh, $buf, (( sysseek $fh, 0, 2 ), sysseek $fh, 0,0)[0] ;
44 11         291 return thaw($buf);
45             }
46              
47             sub lock_retrieve($) {
48 2     2 1 6 $_[1] = 1;
49 2         6 goto &retrieve;
50             }
51              
52             sub store($$) {
53 6     6 1 21850 my ( $object, $file, $lock ) = @_;
54              
55 6         284 my $freeze = \freeze($object);
56 6 50       32 unless (defined $$freeze ){
57 0         0 croak "Bad object";
58             }
59             else {
60 6         20 my $fh;
61 6 100       24 if ($lock){
62 3 50       186 open $fh, ">>:raw", $file or croak "Can't open file \"$file\" for write.";
63 3 50       251019 flock $fh, LOCK_EX if $lock;
64 3         105965 truncate $fh, 0;
65 3         35 seek $fh,0,0;
66             }
67             else {
68 3 50       273 open $fh, ">:raw", $file or croak "Can't open file \"$file\" for write.";
69             }
70 6 50       74 print $fh $$freeze if defined $$freeze;
71 6         272 close $fh;
72             };
73             }
74              
75             sub lock_store($$) {
76 3     3 1 9 $_[2] = 1;
77 3         26 goto &store;
78             }
79             {{
80 17     17   83 no warnings 'once';
  17         22  
  17         988  
81             *nstore = \&store;
82             *lock_nstore = \&lock_store;
83             }};
84             1;
85             __END__