ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/Coro/Storable.pm
Revision: 1.11
Committed: Fri Apr 25 04:28:50 2008 UTC (16 years, 2 months ago) by root
Branch: MAIN
CVS Tags: rel-4_71, rel-4_7
Changes since 1.10: +1 -1 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.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 Crossfire
13     game server) sometimes need to load large Storable objects without
14     blocking the server for a long time.
15    
16 root 1.6 This is being implemented by using a perlio layer that feeds only small
17     amounts of data (512 bytes per call) into Storable, and C<Coro::cede>'ing
18     regularly (at most 1000 times per second by default, though).
19    
20 root 1.2 As it seems that Storable is not reentrant, this module also serialises
21 root 1.6 calls to freeze and thaw between coroutines as necessary (for this to work
22     reliably you always have to use this module, however).
23 root 1.2
24 root 1.1 =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<Coro::Storable::freeze> or C<Storable::store_fd>/C<Storable::store>
32     (sorry, but Storable uses incompatible formats for disk/mem objects).
33    
34 root 1.4 This works by calling C<Coro::cede> for every 4096 bytes read in.
35 root 1.1
36     =item $pst = freeze $ref
37    
38     Freeze the given scalar into a Storable object. It uses the same format as
39 root 1.6 C<Storable::store_fd>.
40 root 1.1
41     This works by calling C<Coro::cede> for every write that Storable
42     issues. Unfortunately, Storable often makes many very small writes, so it
43     is rather inefficient. But it does keep the latency low.
44    
45 root 1.6 =item $pst = nfreeze $ref
46    
47 root 1.7 Same as C<freeze> but is compatible to C<Storable::nstore_fd> (note the
48 root 1.6 C<n>).
49    
50     =item $pst = blocking_freeze $ref
51    
52     Same as C<freeze> but is guaranteed to block. This is useful e.g. in
53     C<Coro::Util::fork_eval> when you want to serialise a data structure
54     for use with the C<thaw> function for this module. You cannot use
55 root 1.7 C<Storable::freeze> for this as Storable uses incompatible formats for
56 root 1.6 memory and file images.
57    
58     =item $pst = blocking_nfreeze $ref
59    
60     Same as C<blocking_freeze> but uses C<nfreeze> internally.
61    
62 root 1.8 =item $guard = guard;
63    
64     Acquire the Storable lock, for when you want to call Storable yourself.
65    
66 root 1.1 =back
67    
68     =cut
69    
70     package Coro::Storable;
71    
72     use strict;
73    
74     use Coro ();
75 root 1.2 use Coro::Semaphore ();
76 root 1.1
77     use Storable;
78     use base "Exporter";
79    
80 root 1.11 our $VERSION = 4.6;
81 root 1.9 our @EXPORT = qw(thaw freeze nfreeze blocking_thaw blocking_freeze blocking_nfreeze);
82 root 1.1
83 root 1.2 my $lock = new Coro::Semaphore;
84    
85 root 1.8 sub guard {
86     $lock->guard
87     }
88    
89 root 1.6 sub thaw($) {
90     my $guard = $lock->guard;
91    
92     open my $fh, "<:via(CoroCede)", \$_[0]
93     or die "cannot open pst via CoroCede: $!";
94     Storable::fd_retrieve $fh
95     }
96    
97 root 1.1 sub freeze($) {
98 root 1.2 my $guard = $lock->guard;
99    
100 root 1.1 open my $fh, ">:via(CoroCede)", \my $buf
101     or die "cannot open pst via CoroCede: $!";
102 root 1.6 Storable::store_fd $_[0], $fh;
103 root 1.1 $buf
104     }
105    
106 root 1.6 sub nfreeze($) {
107 root 1.2 my $guard = $lock->guard;
108    
109 root 1.6 open my $fh, ">:via(CoroCede)", \my $buf
110 root 1.1 or die "cannot open pst via CoroCede: $!";
111 root 1.6 Storable::nstore_fd $_[0], $fh;
112     $buf
113     }
114    
115 root 1.10 sub blocking_thaw($) {
116 root 1.9 my $guard = $lock->guard;
117    
118     open my $fh, "<", \$_[0]
119     or die "cannot open pst: $!";
120     Storable::fd_retrieve $fh
121     }
122    
123 root 1.10 sub blocking_freeze($) {
124 root 1.8 my $guard = $lock->guard;
125    
126 root 1.6 open my $fh, ">", \my $buf
127     or die "cannot open pst: $!";
128     Storable::store_fd $_[0], $fh;
129     close $fh;
130    
131     $buf
132     }
133    
134 root 1.10 sub blocking_nfreeze($) {
135 root 1.8 my $guard = $lock->guard;
136    
137 root 1.6 open my $fh, ">", \my $buf
138     or die "cannot open pst: $!";
139     Storable::nstore_fd $_[0], $fh;
140     close $fh;
141    
142     $buf
143 root 1.1 }
144    
145     package PerlIO::via::CoroCede;
146    
147     # generic cede-on-read/write filtering layer
148    
149 root 1.6 use Time::HiRes ("time");
150    
151     our $GRANULARITY = 0.001;
152    
153     my $next_cede;
154    
155 root 1.1 sub PUSHED {
156     __PACKAGE__
157     }
158    
159     sub FILL {
160 root 1.6 if ($next_cede <= time) {
161     $next_cede = time + $GRANULARITY; # calling time() twice usually is a net win
162     Coro::cede;
163     }
164    
165 root 1.5 read $_[1], my $buf, 512
166 root 1.3 or return undef;
167 root 1.6
168 root 1.1 $buf
169     }
170    
171     sub WRITE {
172 root 1.6 if ($next_cede <= (my $now = time)) {
173     Coro::cede;
174     $next_cede = $now + $GRANULARITY;
175     }
176    
177 root 1.1 (print {$_[2]} $_[1]) ? length $_[1] : -1
178     }
179    
180     1;
181    
182     =head1 AUTHOR
183    
184     Marc Lehmann <schmorp@schmorp.de>
185     http://home.schmorp.de/
186    
187     =cut
188    
189