ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/Coro/Storable.pm
Revision: 1.20
Committed: Sun Aug 31 08:00:16 2008 UTC (15 years, 9 months ago) by root
Branch: MAIN
Changes since 1.19: +1 -1 lines
Log Message:
*** empty log message ***

File Contents

# Content
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 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 As it seems that Storable is not reentrant, this module also serialises
21 calls to freeze and thaw between coroutines as necessary (for this to work
22 reliably you always have to use this module, however).
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<Coro::Storable::freeze> or C<Storable::store_fd>/C<Storable::store>
32 (sorry, but Storable uses incompatible formats for disk/mem objects).
33
34 This works by calling C<Coro::cede> for every 4096 bytes read in.
35
36 =item $pst = freeze $ref
37
38 Freeze the given scalar into a Storable object. It uses the same format as
39 C<Storable::store_fd>.
40
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 =item $pst = nfreeze $ref
46
47 Same as C<freeze> but is compatible to C<Storable::nstore_fd> (note the
48 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 C<Storable::freeze> for this as Storable uses incompatible formats for
56 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 =item $guard = guard;
63
64 Acquire the Storable lock, for when you want to call Storable yourself.
65
66 =back
67
68 =cut
69
70 package Coro::Storable;
71
72 use strict;
73 no warnings;
74
75 use Coro ();
76 use Coro::Semaphore ();
77
78 BEGIN {
79 # suppress warnings
80 local $^W = 0;
81 require Storable;
82 }
83
84 use Storable;
85 use base "Exporter";
86
87 our $VERSION = 4.745;
88 our @EXPORT = qw(thaw freeze nfreeze blocking_thaw blocking_freeze blocking_nfreeze);
89
90 my $lock = new Coro::Semaphore;
91
92 sub guard {
93 $lock->guard
94 }
95
96 sub thaw($) {
97 my $guard = $lock->guard;
98
99 open my $fh, "<:via(CoroCede)", \$_[0]
100 or die "cannot open pst via CoroCede: $!";
101 Storable::fd_retrieve $fh
102 }
103
104 sub freeze($) {
105 my $guard = $lock->guard;
106
107 open my $fh, ">:via(CoroCede)", \my $buf
108 or die "cannot open pst via CoroCede: $!";
109 Storable::store_fd $_[0], $fh;
110 $buf
111 }
112
113 sub nfreeze($) {
114 my $guard = $lock->guard;
115
116 open my $fh, ">:via(CoroCede)", \my $buf
117 or die "cannot open pst via CoroCede: $!";
118 Storable::nstore_fd $_[0], $fh;
119 $buf
120 }
121
122 sub blocking_thaw($) {
123 my $guard = $lock->guard;
124
125 open my $fh, "<", \$_[0]
126 or die "cannot open pst: $!";
127 Storable::fd_retrieve $fh
128 }
129
130 sub blocking_freeze($) {
131 my $guard = $lock->guard;
132
133 open my $fh, ">", \my $buf
134 or die "cannot open pst: $!";
135 Storable::store_fd $_[0], $fh;
136 close $fh;
137
138 $buf
139 }
140
141 sub blocking_nfreeze($) {
142 my $guard = $lock->guard;
143
144 open my $fh, ">", \my $buf
145 or die "cannot open pst: $!";
146 Storable::nstore_fd $_[0], $fh;
147 close $fh;
148
149 $buf
150 }
151
152 package PerlIO::via::CoroCede;
153
154 # generic cede-on-read/write filtering layer
155
156 use Time::HiRes ("time");
157
158 our $GRANULARITY = 0.001;
159
160 my $next_cede;
161
162 sub PUSHED {
163 __PACKAGE__
164 }
165
166 sub FILL {
167 if ($next_cede <= time) {
168 $next_cede = time + $GRANULARITY; # calling time() twice usually is a net win
169 Coro::cede ();
170 }
171
172 read $_[1], my $buf, 512
173 or return undef;
174
175 $buf
176 }
177
178 sub WRITE {
179 if ($next_cede <= (my $now = time)) {
180 Coro::cede ();
181 $next_cede = $now + $GRANULARITY;
182 }
183
184 (print {$_[2]} $_[1]) ? length $_[1] : -1
185 }
186
187 1;
188
189 =head1 AUTHOR
190
191 Marc Lehmann <schmorp@schmorp.de>
192 http://home.schmorp.de/
193
194 =cut
195
196