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   41077 use strict;
  17         25  
  17         423  
4 17     17   61 use warnings;
  17         21  
  17         399  
5 17     17   54 use Fcntl qw(:flock);
  17         19  
  17         1742  
6 17     17   4929 use subs qw(freeze thaw);
  17         230  
  17         70  
7 17     17   664 use Exporter 'import';
  17         21  
  17         526  
8 17     17   63 use Carp qw(croak);
  17         28  
  17         1094  
9             BEGIN {
10 17     17   23 our $VERSION;
11 17 100       299 $VERSION = '1.23' unless $INC{'Storable/AMF0.pm'};
12             }
13 17     17   3702 use Storable::AMF0 ();
  17         23  
  17         6094  
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 23 my $file = shift;
38 11         13 my $lock = shift;
39              
40 11 50       302 open my $fh, "<:raw", $file or croak "Can't open file \"$file\" for read.";
41 11 100       58 flock $fh, LOCK_SH if $lock;
42 11         11 my $buf;
43 11         62 sysread $fh, $buf, (( sysseek $fh, 0, 2 ), sysseek $fh, 0,0)[0] ;
44 11         256 return thaw($buf);
45             }
46              
47             sub lock_retrieve($) {
48 2     2 1 4 $_[1] = 1;
49 2         5 goto &retrieve;
50             }
51              
52             sub store($$) {
53 6     6 1 13523 my ( $object, $file, $lock ) = @_;
54              
55 6         242 my $freeze = \freeze($object);
56 6 50       22 unless (defined $$freeze ){
57 0         0 croak "Bad object";
58             }
59             else {
60 6         11 my $fh;
61 6 100       25 if ($lock){
62 3 50       157 open $fh, ">>:raw", $file or croak "Can't open file \"$file\" for write.";
63 3 50       251080 flock $fh, LOCK_EX if $lock;
64 3         102 truncate $fh, 0;
65 3         16 seek $fh,0,0;
66             }
67             else {
68 3 50       190 open $fh, ">:raw", $file or croak "Can't open file \"$file\" for write.";
69             }
70 6 50       63 print $fh $$freeze if defined $$freeze;
71 6         195 close $fh;
72             };
73             }
74              
75             sub lock_store($$) {
76 3     3 1 14 $_[2] = 1;
77 3         20 goto &store;
78             }
79             {{
80 17     17   84 no warnings 'once';
  17         20  
  17         989  
81             *nstore = \&store;
82             *lock_nstore = \&lock_store;
83             }};
84             1;
85             __END__