… | |
… | |
7 | use Coro::Storable; |
7 | use Coro::Storable; |
8 | |
8 | |
9 | =head1 DESCRIPTION |
9 | =head1 DESCRIPTION |
10 | |
10 | |
11 | This module implements a few functions from the Storable module in a way |
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 |
12 | so that it cede's more often. Some applications (such as the Deliantra |
13 | game server) sometimes need to load large Storable objects without |
13 | game server) sometimes need to load large Storable objects without |
14 | blocking the server for a long time. |
14 | blocking the server for a long time. |
15 | |
15 | |
16 | This is being implemented by using a perlio layer that feeds only small |
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 |
17 | amounts of data (4096 bytes per call) into Storable, and C<Coro::cede>'ing |
18 | regularly (at most 1000 times per second by default, though). |
18 | regularly (at most 100 times per second by default, though). |
19 | |
19 | |
20 | As it seems that Storable is not reentrant, this module also serialises |
20 | As Storable is not reentrant, this module also wraps most functions of the |
21 | calls to freeze and thaw between coroutines as necessary (for this to work |
21 | Storable module so that only one freeze or thaw is done at any one moment |
22 | reliably 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 | |
30 | Retrieve an object from the given $pst, which must have been created with |
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> |
31 | C<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 | |
34 | This works by calling C<Coro::cede> for every 4096 bytes read in. |
34 | This function will cede regularly. |
35 | |
35 | |
36 | =item $pst = freeze $ref |
36 | =item $pst = freeze $ref |
37 | |
37 | |
38 | Freeze the given scalar into a Storable object. It uses the same format as |
38 | Freeze the given scalar into a Storable object. It uses the same format as |
39 | C<Storable::store_fd>. |
39 | C<Storable::store_fd>. |
40 | |
40 | |
41 | This works by calling C<Coro::cede> for every write that Storable |
41 | This functino will cede regularly. |
42 | issues. Unfortunately, Storable often makes many very small writes, so it |
|
|
43 | is rather inefficient. But it does keep the latency low. |
|
|
44 | |
42 | |
45 | =item $pst = nfreeze $ref |
43 | =item $pst = nfreeze $ref |
46 | |
44 | |
47 | Same as C<freeze> but is compatible to C<Storable::nstore_fd> (note the |
45 | Same as C<freeze> but is compatible to C<Storable::nstore_fd> (note the |
48 | C<n>). |
46 | C<n>). |
… | |
… | |
51 | |
49 | |
52 | Same as C<freeze> but is guaranteed to block. This is useful e.g. in |
50 | 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 |
51 | 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 |
52 | 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 |
53 | C<Storable::freeze> for this as Storable uses incompatible formats for |
56 | memory and file images. |
54 | memory 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 | |
60 | Same as C<blocking_freeze> but uses C<nfreeze> internally. |
58 | Same as C<blocking_freeze> but uses C<nfreeze> internally. |
61 | |
59 | |
62 | =item $guard = guard; |
60 | =item $guard = guard |
63 | |
61 | |
64 | Acquire the Storable lock, for when you want to call Storable yourself. |
62 | Acquire the Storable lock, for when you want to call Storable yourself. |
|
|
63 | |
|
|
64 | Note that this module already wraps all Storable functions, so there is |
|
|
65 | rarely the need to do this yourself. |
65 | |
66 | |
66 | =back |
67 | =back |
67 | |
68 | |
68 | =cut |
69 | =cut |
69 | |
70 | |
70 | package Coro::Storable; |
71 | package Coro::Storable; |
71 | |
72 | |
72 | use strict; |
73 | use common::sense; |
73 | |
74 | |
74 | use Coro (); |
75 | use Coro (); |
75 | use Coro::Semaphore (); |
76 | use Coro::Semaphore (); |
76 | |
77 | |
|
|
78 | BEGIN { |
|
|
79 | # suppress warnings |
|
|
80 | local $^W = 0; |
|
|
81 | require Storable; |
|
|
82 | } |
|
|
83 | |
77 | use Storable; |
84 | use Storable; |
78 | use base "Exporter"; |
85 | use base "Exporter"; |
79 | |
86 | |
80 | our $VERSION = '0.2'; |
87 | our $VERSION = 6.47; |
81 | our @EXPORT = qw(thaw freeze nfreeze blocking_thaw blocking_freeze blocking_nfreeze); |
88 | our @EXPORT = qw(thaw freeze nfreeze blocking_thaw blocking_freeze blocking_nfreeze); |
|
|
89 | |
|
|
90 | our $GRANULARITY = 0.01; |
82 | |
91 | |
83 | my $lock = new Coro::Semaphore; |
92 | my $lock = new Coro::Semaphore; |
84 | |
93 | |
85 | sub guard { |
94 | sub guard { |
86 | $lock->guard |
95 | $lock->guard |
87 | } |
96 | } |
88 | |
97 | |
|
|
98 | # wrap xs functions |
|
|
99 | for (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 | |
89 | sub thaw($) { |
108 | sub 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 | |
97 | sub freeze($) { |
114 | sub 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 | |
106 | sub nfreeze($) { |
123 | sub 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 | |
115 | sub blocking_thaw { |
132 | sub 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 | |
123 | sub blocking_freeze { |
138 | sub 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 | |
134 | sub blocking_nfreeze { |
147 | sub 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 | } |
154 | } |
144 | |
155 | |
145 | package PerlIO::via::CoroCede; |
|
|
146 | |
|
|
147 | # generic cede-on-read/write filtering layer |
|
|
148 | |
|
|
149 | use Time::HiRes ("time"); |
|
|
150 | |
|
|
151 | our $GRANULARITY = 0.001; |
|
|
152 | |
|
|
153 | my $next_cede; |
|
|
154 | |
|
|
155 | sub PUSHED { |
|
|
156 | __PACKAGE__ |
|
|
157 | } |
|
|
158 | |
|
|
159 | sub 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 | |
|
|
171 | sub 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 | } |
|
|
179 | |
|
|
180 | 1; |
156 | 1; |
181 | |
157 | |
182 | =head1 AUTHOR |
158 | =head1 AUTHOR/SUPPORT/CONTACT |
183 | |
159 | |
184 | Marc Lehmann <schmorp@schmorp.de> |
160 | Marc A. Lehmann <schmorp@schmorp.de> |
185 | http://home.schmorp.de/ |
161 | http://software.schmorp.de/pkg/Coro.html |
186 | |
162 | |
187 | =cut |
163 | =cut |
188 | |
164 | |
189 | |
165 | |