File Coverage

blib/lib/Coro/Storable.pm
Criterion Covered Total %
statement 17 52 32.6
branch 0 12 0.0
condition n/a
subroutine 6 14 42.8
pod 6 7 85.7
total 29 85 34.1


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Coro::Storable - offer a more fine-grained Storable interface
4              
5             =head1 SYNOPSIS
6              
7             use Coro::Storable;
8              
9             =head1 DESCRIPTION
10              
11             This module implements a few functions from the Storable module in a way
12             so that it cede's more often. Some applications (such as the Deliantra
13             game server) sometimes need to load large Storable objects without
14             blocking the server for a long time.
15              
16             This is being implemented by using a perlio layer that feeds only small
17             amounts of data (4096 bytes per call) into Storable, and C'ing
18             regularly (at most 100 times per second by default, though).
19              
20             As Storable is not reentrant, this module also wraps most functions of the
21             Storable module so that only one freeze or thaw is done at any one moment
22             (and recursive invocations are not currently supported).
23              
24             =head1 FUNCTIONS
25              
26             =over 4
27              
28             =item $ref = thaw $pst
29              
30             Retrieve an object from the given $pst, which must have been created with
31             C or C/C
32             (sorry, but Storable uses incompatible formats for disk/mem objects).
33              
34             This function will cede regularly.
35              
36             =item $pst = freeze $ref
37              
38             Freeze the given scalar into a Storable object. It uses the same format as
39             C.
40              
41             This functino will cede regularly.
42              
43             =item $pst = nfreeze $ref
44              
45             Same as C but is compatible to C (note the
46             C).
47              
48             =item $pst = blocking_freeze $ref
49              
50             Same as C but is guaranteed to block. This is useful e.g. in
51             C when you want to serialise a data structure
52             for use with the C function for this module. You cannot use
53             C for this as Storable uses incompatible formats for
54             memory and file images, and this module uses file images.
55              
56             =item $pst = blocking_nfreeze $ref
57              
58             Same as C but uses C internally.
59              
60             =item $guard = guard
61              
62             Acquire the Storable lock, for when you want to call Storable yourself.
63              
64             Note that this module already wraps all Storable functions, so there is
65             rarely the need to do this yourself.
66              
67             =back
68              
69             =cut
70              
71             package Coro::Storable;
72              
73 1     1   8 use common::sense;
  1         3  
  1         15  
74              
75 1     1   54 use Coro ();
  1         3  
  1         17  
76 1     1   7 use Coro::Semaphore ();
  1         2  
  1         44  
77              
78             BEGIN {
79             # suppress warnings
80 1     1   5 local $^W = 0;
81 1         729 require Storable;
82             }
83              
84 1     1   4056 use Storable;
  1         4  
  1         69  
85 1     1   10 use base "Exporter";
  1         3  
  1         1308  
86              
87             our $VERSION = 6.512;
88             our @EXPORT = qw(thaw freeze nfreeze blocking_thaw blocking_freeze blocking_nfreeze);
89              
90             our $GRANULARITY = 0.01;
91              
92             my $lock = new Coro::Semaphore;
93              
94             sub guard {
95 0     0 1   $lock->guard
96             }
97              
98             # wrap xs functions
99             for (qw(net_pstore pstore net_mstore mstore pretrieve mretrieve dclone)) {
100             my $orig = \&{"Storable::$_"};
101 0     0     *{"Storable::$_"} = eval 'sub (' . (prototype $orig) . ') {
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
102             my $guard = $lock->guard;
103             &$orig
104             }';
105             die if $@;
106             }
107              
108             sub thaw($) {
109 0 0   0 1   open my $fh, "<:cede($GRANULARITY)", \$_[0]
110             or die "cannot open pst via PerlIO::cede: $!";
111 0           Storable::fd_retrieve $fh
112             }
113              
114             sub freeze($) {
115 0 0   0 1   open my $fh, ">:cede($GRANULARITY)", \my $buf
116             or die "cannot open pst via PerlIO::cede: $!";
117 0           Storable::store_fd $_[0], $fh;
118 0           close $fh;
119              
120 0           $buf
121             }
122              
123             sub nfreeze($) {
124 0 0   0 1   open my $fh, ">:cede($GRANULARITY)", \my $buf
125             or die "cannot open pst via PerlIO::cede: $!";
126 0           Storable::nstore_fd $_[0], $fh;
127 0           close $fh;
128              
129 0           $buf
130             }
131              
132             sub blocking_thaw($) {
133 0 0   0 0   open my $fh, "<", \$_[0]
134             or die "cannot open pst: $!";
135 0           Storable::fd_retrieve $fh
136             }
137              
138             sub blocking_freeze($) {
139 0 0   0 1   open my $fh, ">", \my $buf
140             or die "cannot open pst: $!";
141 0           Storable::store_fd $_[0], $fh;
142 0           close $fh;
143              
144 0           $buf
145             }
146              
147             sub blocking_nfreeze($) {
148 0 0   0 1   open my $fh, ">", \my $buf
149             or die "cannot open pst: $!";
150 0           Storable::nstore_fd $_[0], $fh;
151 0           close $fh;
152              
153 0           $buf
154             }
155              
156             1;
157              
158             =head1 AUTHOR/SUPPORT/CONTACT
159              
160             Marc A. Lehmann
161             http://software.schmorp.de/pkg/Coro.html
162              
163             =cut
164              
165