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.12 by root, Sun May 25 03:05:42 2008 UTC vs.
Revision 1.80 by root, Tue Mar 4 06:13:25 2014 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;
73 74
74use Coro (); 75use Coro ();
75use Coro::Semaphore (); 76use Coro::Semaphore ();
76 77
78BEGIN {
79 # suppress warnings
80 local $^W = 0;
81 require Storable;
82}
83
77use Storable; 84use Storable;
78use base "Exporter"; 85use base "Exporter";
79 86
80our $VERSION = 4.72; 87our $VERSION = 6.36;
81our @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;
82 91
83my $lock = new Coro::Semaphore; 92my $lock = new Coro::Semaphore;
84 93
85sub guard { 94sub guard {
86 $lock->guard 95 $lock->guard
87} 96}
88 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
89sub thaw($) { 108sub thaw($) {
90 my $guard = $lock->guard; 109 open my $fh, "<:cede($GRANULARITY)", \$_[0]
91
92 open my $fh, "<:via(CoroCede)", \$_[0]
93 or die "cannot open pst via CoroCede: $!"; 110 or die "cannot open pst via PerlIO::cede: $!";
94 Storable::fd_retrieve $fh 111 Storable::fd_retrieve $fh
95} 112}
96 113
97sub freeze($) { 114sub freeze($) {
98 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;
99 119
100 open my $fh, ">:via(CoroCede)", \my $buf
101 or die "cannot open pst via CoroCede: $!";
102 Storable::store_fd $_[0], $fh;
103 $buf 120 $buf
104} 121}
105 122
106sub nfreeze($) { 123sub nfreeze($) {
107 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;
108 128
109 open my $fh, ">:via(CoroCede)", \my $buf
110 or die "cannot open pst via CoroCede: $!";
111 Storable::nstore_fd $_[0], $fh;
112 $buf 129 $buf
113} 130}
114 131
115sub blocking_thaw($) { 132sub blocking_thaw($) {
116 my $guard = $lock->guard;
117
118 open my $fh, "<", \$_[0] 133 open my $fh, "<", \$_[0]
119 or die "cannot open pst: $!"; 134 or die "cannot open pst: $!";
120 Storable::fd_retrieve $fh 135 Storable::fd_retrieve $fh
121} 136}
122 137
123sub blocking_freeze($) { 138sub blocking_freeze($) {
124 my $guard = $lock->guard;
125
126 open my $fh, ">", \my $buf 139 open my $fh, ">", \my $buf
127 or die "cannot open pst: $!"; 140 or die "cannot open pst: $!";
128 Storable::store_fd $_[0], $fh; 141 Storable::store_fd $_[0], $fh;
129 close $fh; 142 close $fh;
130 143
131 $buf 144 $buf
132} 145}
133 146
134sub blocking_nfreeze($) { 147sub blocking_nfreeze($) {
135 my $guard = $lock->guard;
136
137 open my $fh, ">", \my $buf 148 open my $fh, ">", \my $buf
138 or die "cannot open pst: $!"; 149 or die "cannot open pst: $!";
139 Storable::nstore_fd $_[0], $fh; 150 Storable::nstore_fd $_[0], $fh;
140 close $fh; 151 close $fh;
141 152
142 $buf 153 $buf
143}
144
145package PerlIO::via::CoroCede;
146
147# generic cede-on-read/write filtering layer
148
149use Time::HiRes ("time");
150
151our $GRANULARITY = 0.001;
152
153my $next_cede;
154
155sub PUSHED {
156 __PACKAGE__
157}
158
159sub FILL {
160 if ($next_cede <= time) {
161 $next_cede = time + $GRANULARITY; # calling time() twice usually is a net win
162 Coro::cede;
163 }
164
165 read $_[1], my $buf, 512
166 or return undef;
167
168 $buf
169}
170
171sub WRITE {
172 if ($next_cede <= (my $now = time)) {
173 Coro::cede;
174 $next_cede = $now + $GRANULARITY;
175 }
176
177 (print {$_[2]} $_[1]) ? length $_[1] : -1
178} 154}
179 155
1801; 1561;
181 157
182=head1 AUTHOR 158=head1 AUTHOR

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines