ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/Coro/Storable.pm
(Generate patch)

Comparing Coro/Coro/Storable.pm (file contents):
Revision 1.20 by root, Sun Aug 31 08:00:16 2008 UTC vs.
Revision 1.71 by root, Fri Nov 11 20:22:09 2011 UTC

… …
7 use Coro::Storable; 7 use Coro::Storable;
8 8
9=head1 DESCRIPTION 9=head1 DESCRIPTION
10 10
11This module implements a few functions from the Storable module in a way 11This module implements a few functions from the Storable module in a way
12so that it cede's more often. Some applications (such as the Crossfire 12so that it cede's more often. Some applications (such as the Deliantra
13game server) sometimes need to load large Storable objects without 13game server) sometimes need to load large Storable objects without
14blocking the server for a long time. 14blocking the server for a long time.
15 15
16This is being implemented by using a perlio layer that feeds only small 16This is being implemented by using a perlio layer that feeds only small
17amounts of data (512 bytes per call) into Storable, and C<Coro::cede>'ing 17amounts of data (4096 bytes per call) into Storable, and C<Coro::cede>'ing
18regularly (at most 1000 times per second by default, though). 18regularly (at most 100 times per second by default, though).
19 19
20As it seems that Storable is not reentrant, this module also serialises 20As Storable is not reentrant, this module also wraps most functions of the
21calls to freeze and thaw between coroutines as necessary (for this to work 21Storable module so that only one freeze or thaw is done at any one moment
22reliably you always have to use this module, however). 22(and recursive invocations are not currently supported).
23 23
24=head1 FUNCTIONS 24=head1 FUNCTIONS
25 25
26=over 4 26=over 4
27 27
… …
29 29
30Retrieve an object from the given $pst, which must have been created with 30Retrieve an object from the given $pst, which must have been created with
31C<Coro::Storable::freeze> or C<Storable::store_fd>/C<Storable::store> 31C<Coro::Storable::freeze> or C<Storable::store_fd>/C<Storable::store>
32(sorry, but Storable uses incompatible formats for disk/mem objects). 32(sorry, but Storable uses incompatible formats for disk/mem objects).
33 33
34This works by calling C<Coro::cede> for every 4096 bytes read in. 34This function will cede regularly.
35 35
36=item $pst = freeze $ref 36=item $pst = freeze $ref
37 37
38Freeze the given scalar into a Storable object. It uses the same format as 38Freeze the given scalar into a Storable object. It uses the same format as
39C<Storable::store_fd>. 39C<Storable::store_fd>.
40 40
41This works by calling C<Coro::cede> for every write that Storable 41This functino will cede regularly.
42issues. Unfortunately, Storable often makes many very small writes, so it
43is rather inefficient. But it does keep the latency low.
44 42
45=item $pst = nfreeze $ref 43=item $pst = nfreeze $ref
46 44
47Same as C<freeze> but is compatible to C<Storable::nstore_fd> (note the 45Same as C<freeze> but is compatible to C<Storable::nstore_fd> (note the
48C<n>). 46C<n>).
… …
51 49
52Same as C<freeze> but is guaranteed to block. This is useful e.g. in 50Same as C<freeze> but is guaranteed to block. This is useful e.g. in
53C<Coro::Util::fork_eval> when you want to serialise a data structure 51C<Coro::Util::fork_eval> when you want to serialise a data structure
54for use with the C<thaw> function for this module. You cannot use 52for use with the C<thaw> function for this module. You cannot use
55C<Storable::freeze> for this as Storable uses incompatible formats for 53C<Storable::freeze> for this as Storable uses incompatible formats for
56memory and file images. 54memory and file images, and this module uses file images.
57 55
58=item $pst = blocking_nfreeze $ref 56=item $pst = blocking_nfreeze $ref
59 57
60Same as C<blocking_freeze> but uses C<nfreeze> internally. 58Same as C<blocking_freeze> but uses C<nfreeze> internally.
61 59
62=item $guard = guard; 60=item $guard = guard
63 61
64Acquire the Storable lock, for when you want to call Storable yourself. 62Acquire the Storable lock, for when you want to call Storable yourself.
63
64Note that this module already wraps all Storable functions, so there is
65rarely the need to do this yourself.
65 66
66=back 67=back
67 68
68=cut 69=cut
69 70
70package Coro::Storable; 71package Coro::Storable;
71 72
72use strict; 73use common::sense;
73no warnings;
74 74
75use Coro (); 75use Coro ();
76use Coro::Semaphore (); 76use Coro::Semaphore ();
77 77
78BEGIN { 78BEGIN {
… …
82} 82}
83 83
84use Storable; 84use Storable;
85use base "Exporter"; 85use base "Exporter";
86 86
87our $VERSION = 4.745; 87our $VERSION = 6.07;
88our @EXPORT = qw(thaw freeze nfreeze blocking_thaw blocking_freeze blocking_nfreeze); 88our @EXPORT = qw(thaw freeze nfreeze blocking_thaw blocking_freeze blocking_nfreeze);
89
90our $GRANULARITY = 0.01;
89 91
90my $lock = new Coro::Semaphore; 92my $lock = new Coro::Semaphore;
91 93
92sub guard { 94sub guard {
93 $lock->guard 95 $lock->guard
94} 96}
95 97
98# wrap xs functions
99for (qw(net_pstore pstore net_mstore mstore pretrieve mretrieve dclone)) {
100 my $orig = \&{"Storable::$_"};
101 *{"Storable::$_"} = eval 'sub (' . (prototype $orig) . ') {
102 my $guard = $lock->guard;
103 &$orig
104 }';
105 die if $@;
106}
107
96sub thaw($) { 108sub thaw($) {
97 my $guard = $lock->guard; 109 open my $fh, "<:cede($GRANULARITY)", \$_[0]
98
99 open my $fh, "<:via(CoroCede)", \$_[0]
100 or die "cannot open pst via CoroCede: $!"; 110 or die "cannot open pst via PerlIO::cede: $!";
101 Storable::fd_retrieve $fh 111 Storable::fd_retrieve $fh
102} 112}
103 113
104sub freeze($) { 114sub freeze($) {
105 my $guard = $lock->guard; 115 open my $fh, ">:cede($GRANULARITY)", \my $buf
116 or die "cannot open pst via PerlIO::cede: $!";
117 Storable::store_fd $_[0], $fh;
118 close $fh;
106 119
107 open my $fh, ">:via(CoroCede)", \my $buf
108 or die "cannot open pst via CoroCede: $!";
109 Storable::store_fd $_[0], $fh;
110 $buf 120 $buf
111} 121}
112 122
113sub nfreeze($) { 123sub nfreeze($) {
114 my $guard = $lock->guard; 124 open my $fh, ">:cede($GRANULARITY)", \my $buf
125 or die "cannot open pst via PerlIO::cede: $!";
126 Storable::nstore_fd $_[0], $fh;
127 close $fh;
115 128
116 open my $fh, ">:via(CoroCede)", \my $buf
117 or die "cannot open pst via CoroCede: $!";
118 Storable::nstore_fd $_[0], $fh;
119 $buf 129 $buf
120} 130}
121 131
122sub blocking_thaw($) { 132sub blocking_thaw($) {
123 my $guard = $lock->guard;
124
125 open my $fh, "<", \$_[0] 133 open my $fh, "<", \$_[0]
126 or die "cannot open pst: $!"; 134 or die "cannot open pst: $!";
127 Storable::fd_retrieve $fh 135 Storable::fd_retrieve $fh
128} 136}
129 137
130sub blocking_freeze($) { 138sub blocking_freeze($) {
131 my $guard = $lock->guard;
132
133 open my $fh, ">", \my $buf 139 open my $fh, ">", \my $buf
134 or die "cannot open pst: $!"; 140 or die "cannot open pst: $!";
135 Storable::store_fd $_[0], $fh; 141 Storable::store_fd $_[0], $fh;
136 close $fh; 142 close $fh;
137 143
138 $buf 144 $buf
139} 145}
140 146
141sub blocking_nfreeze($) { 147sub blocking_nfreeze($) {
142 my $guard = $lock->guard;
143
144 open my $fh, ">", \my $buf 148 open my $fh, ">", \my $buf
145 or die "cannot open pst: $!"; 149 or die "cannot open pst: $!";
146 Storable::nstore_fd $_[0], $fh; 150 Storable::nstore_fd $_[0], $fh;
147 close $fh; 151 close $fh;
148 152
149 $buf 153 $buf
150}
151
152package PerlIO::via::CoroCede;
153
154# generic cede-on-read/write filtering layer
155
156use Time::HiRes ("time");
157
158our $GRANULARITY = 0.001;
159
160my $next_cede;
161
162sub PUSHED {
163 __PACKAGE__
164}
165
166sub 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
178sub 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} 154}
186 155
1871; 1561;
188 157
189=head1 AUTHOR 158=head1 AUTHOR

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines