ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/Coro/Storable.pm
Revision: 1.6
Committed: Sat Aug 18 17:32:07 2007 UTC (16 years, 9 months ago) by root
Branch: MAIN
Changes since 1.5: +74 -10 lines
Log Message:
added some generically useful code from crossfire

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<Storabel:.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 Storabel 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 =back
63
64 =cut
65
66 package Coro::Storable;
67
68 use strict;
69
70 use Coro ();
71 use Coro::Semaphore ();
72
73 use Storable;
74 use base "Exporter";
75
76 our $VERSION = '0.2';
77 our @EXPORT = qw(thaw freeze nfreeze blocking_freeze blocking_nfreeze);
78
79 my $lock = new Coro::Semaphore;
80
81 sub thaw($) {
82 my $guard = $lock->guard;
83
84 open my $fh, "<:via(CoroCede)", \$_[0]
85 or die "cannot open pst via CoroCede: $!";
86 Storable::fd_retrieve $fh
87 }
88
89 sub freeze($) {
90 my $guard = $lock->guard;
91
92 open my $fh, ">:via(CoroCede)", \my $buf
93 or die "cannot open pst via CoroCede: $!";
94 Storable::store_fd $_[0], $fh;
95 $buf
96 }
97
98 sub nfreeze($) {
99 my $guard = $lock->guard;
100
101 open my $fh, ">:via(CoroCede)", \my $buf
102 or die "cannot open pst via CoroCede: $!";
103 Storable::nstore_fd $_[0], $fh;
104 $buf
105 }
106
107 sub blocking_freeze {
108 open my $fh, ">", \my $buf
109 or die "cannot open pst: $!";
110 Storable::store_fd $_[0], $fh;
111 close $fh;
112
113 $buf
114 }
115
116 sub blocking_nfreeze {
117 open my $fh, ">", \my $buf
118 or die "cannot open pst: $!";
119 Storable::nstore_fd $_[0], $fh;
120 close $fh;
121
122 $buf
123 }
124
125 package PerlIO::via::CoroCede;
126
127 # generic cede-on-read/write filtering layer
128
129 use Time::HiRes ("time");
130
131 our $GRANULARITY = 0.001;
132
133 my $next_cede;
134
135 sub PUSHED {
136 __PACKAGE__
137 }
138
139 sub FILL {
140 if ($next_cede <= time) {
141 $next_cede = time + $GRANULARITY; # calling time() twice usually is a net win
142 Coro::cede;
143 }
144
145 read $_[1], my $buf, 512
146 or return undef;
147
148 $buf
149 }
150
151 sub WRITE {
152 if ($next_cede <= (my $now = time)) {
153 Coro::cede;
154 $next_cede = $now + $GRANULARITY;
155 }
156
157 (print {$_[2]} $_[1]) ? length $_[1] : -1
158 }
159
160 1;
161
162 =head1 AUTHOR
163
164 Marc Lehmann <schmorp@schmorp.de>
165 http://home.schmorp.de/
166
167 =cut
168
169