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.22 by root, Sat Sep 20 00:06:42 2008 UTC vs.
Revision 1.89 by root, Mon Jun 29 23:49:34 2015 UTC

… …
12so that it cede's more often. Some applications (such as the Deliantra 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 100 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 wraps most 20As Storable is not reentrant, this module also wraps most functions of the
21functions of the Storable module so that only one freeze or thaw is done 21Storable module so that only one freeze or thaw is done at any one moment
22at any one moment (recursive invocations are not currently supported). 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.
65 63
66Note that this module already wraps the Storable functions, so there is 64Note that this module already wraps all Storable functions, so there is
67rarely the need to do this yourself. 65rarely the need to do this yourself.
68 66
69=back 67=back
70 68
71=cut 69=cut
72 70
73package Coro::Storable; 71package Coro::Storable;
74 72
75use strict qw(subs vars); 73use common::sense;
76no warnings;
77 74
78use Coro (); 75use Coro ();
79use Coro::Semaphore (); 76use Coro::Semaphore ();
80 77
81BEGIN { 78BEGIN {
… …
85} 82}
86 83
87use Storable; 84use Storable;
88use base "Exporter"; 85use base "Exporter";
89 86
90our $VERSION = 4.745; 87our $VERSION = 6.45;
91our @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;
92 91
93my $lock = new Coro::Semaphore; 92my $lock = new Coro::Semaphore;
94 93
95sub guard { 94sub guard {
96 $lock->guard 95 $lock->guard
97} 96}
98 97
99# wrap xs functions 98# wrap xs functions
100for (qw(net_pstore mstore net_mstore pretrieve mretrieve dclone)) { 99for (qw(net_pstore pstore net_mstore mstore pretrieve mretrieve dclone)) {
101 my $orig = \&{"Storable::$_"}; 100 my $orig = \&{"Storable::$_"};
102 *{"Storable::$_"} = sub { 101 *{"Storable::$_"} = eval 'sub (' . (prototype $orig) . ') {
103 my $guard = $lock->guard; 102 my $guard = $lock->guard;
104 &$orig 103 &$orig
105 }; 104 }';
106 die if $@; 105 die if $@;
107} 106}
108 107
109sub thaw($) { 108sub thaw($) {
110 open my $fh, "<:via(CoroCede)", \$_[0] 109 open my $fh, "<:cede($GRANULARITY)", \$_[0]
111 or die "cannot open pst via CoroCede: $!"; 110 or die "cannot open pst via PerlIO::cede: $!";
112 Storable::fd_retrieve $fh 111 Storable::fd_retrieve $fh
113} 112}
114 113
115sub freeze($) { 114sub freeze($) {
116 open my $fh, ">:via(CoroCede)", \my $buf 115 open my $fh, ">:cede($GRANULARITY)", \my $buf
117 or die "cannot open pst via CoroCede: $!"; 116 or die "cannot open pst via PerlIO::cede: $!";
118 Storable::store_fd $_[0], $fh; 117 Storable::store_fd $_[0], $fh;
118 close $fh;
119
119 $buf 120 $buf
120} 121}
121 122
122sub nfreeze($) { 123sub nfreeze($) {
123 open my $fh, ">:via(CoroCede)", \my $buf 124 open my $fh, ">:cede($GRANULARITY)", \my $buf
124 or die "cannot open pst via CoroCede: $!"; 125 or die "cannot open pst via PerlIO::cede: $!";
125 Storable::nstore_fd $_[0], $fh; 126 Storable::nstore_fd $_[0], $fh;
127 close $fh;
128
126 $buf 129 $buf
127} 130}
128 131
129sub blocking_thaw($) { 132sub blocking_thaw($) {
130 open my $fh, "<", \$_[0] 133 open my $fh, "<", \$_[0]
… …
148 close $fh; 151 close $fh;
149 152
150 $buf 153 $buf
151} 154}
152 155
153package PerlIO::via::CoroCede;
154
155# generic cede-on-read/write filtering layer
156
157use Time::HiRes ("time");
158
159our $GRANULARITY = 0.01;
160
161my $next_cede;
162
163sub PUSHED {
164 __PACKAGE__
165}
166
167sub FILL {
168 if ($next_cede <= time) {
169 $next_cede = time + $GRANULARITY; # calling time() twice usually is a net win
170 Coro::cede ();
171 }
172
173 read $_[1], my $buf, 512
174 or return undef;
175
176 $buf
177}
178
179sub WRITE {
180 if ($next_cede <= time) {
181 $next_cede = time + $GRANULARITY;
182 Coro::cede ();
183 }
184
185 (print {$_[2]} $_[1]) ? length $_[1] : -1
186}
187
1881; 1561;
189 157
190=head1 AUTHOR 158=head1 AUTHOR/SUPPORT/CONTACT
191 159
192 Marc Lehmann <schmorp@schmorp.de> 160 Marc A. Lehmann <schmorp@schmorp.de>
193 http://home.schmorp.de/ 161 http://software.schmorp.de/pkg/Coro.html
194 162
195=cut 163=cut
196 164
197 165

Diff Legend

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