Coro/Coro/Storable.pm

=head1 NAME

Coro::Storable - offer a more fine-grained Storable interface

=head1 SYNOPSIS

 use Coro::Storable;

=head1 DESCRIPTION

This module implements a few functions from the Storable module in a way
so that it cede's more often. Some applications (such as the Crossfire
game server) sometimes need to load large Storable objects without
blocking the server for a long time.

This is being implemented by using a perlio layer that feeds only small
amounts of data (512 bytes per call) into Storable, and C<Coro::cede>'ing
regularly (at most 1000 times per second by default, though).

As it seems that Storable is not reentrant, this module also serialises
calls to freeze and thaw between coroutines as necessary (for this to work
reliably you always have to use this module, however).

=head1 FUNCTIONS

=over 4

=item $ref = thaw $pst

Retrieve an object from the given $pst, which must have been created with
C<Coro::Storable::freeze> or C<Storable::store_fd>/C<Storable::store>
(sorry, but Storable uses incompatible formats for disk/mem objects).

This works by calling C<Coro::cede> for every 4096 bytes read in.

=item $pst = freeze $ref

Freeze the given scalar into a Storable object. It uses the same format as
C<Storable::store_fd>.

This works by calling C<Coro::cede> for every write that Storable
issues. Unfortunately, Storable often makes many very small writes, so it
is rather inefficient. But it does keep the latency low.

=item $pst = nfreeze $ref

Same as C<freeze> but is compatible to C<Storable::nstore_fd> (note the
C<n>).

=item $pst = blocking_freeze $ref

Same as C<freeze> but is guaranteed to block. This is useful e.g. in
C<Coro::Util::fork_eval> when you want to serialise a data structure
for use with the C<thaw> function for this module. You cannot use
C<Storable::freeze> for this as Storable uses incompatible formats for
memory and file images.

=item $pst = blocking_nfreeze $ref

Same as C<blocking_freeze> but uses C<nfreeze> internally.

=item $guard = guard;

Acquire the Storable lock, for when you want to call Storable yourself.

=back

=cut

package Coro::Storable;

use strict;

use Coro ();
use Coro::Semaphore ();

use Storable;
use base "Exporter";

our $VERSION = '0.2';
our @EXPORT = qw(thaw freeze nfreeze blocking_thaw blocking_freeze blocking_nfreeze);

my $lock = new Coro::Semaphore;

sub guard {
   $lock->guard
}

sub thaw($) {
   my $guard = $lock->guard;

   open my $fh, "<:via(CoroCede)", \$_[0]
      or die "cannot open pst via CoroCede: $!";
   Storable::fd_retrieve $fh
}

sub freeze($) {
   my $guard = $lock->guard;

   open my $fh, ">:via(CoroCede)", \my $buf
      or die "cannot open pst via CoroCede: $!";
   Storable::store_fd $_[0], $fh;
   $buf
}

sub nfreeze($) {
   my $guard = $lock->guard;

   open my $fh, ">:via(CoroCede)", \my $buf
      or die "cannot open pst via CoroCede: $!";
   Storable::nstore_fd $_[0], $fh;
   $buf
}

sub blocking_thaw($) {
   my $guard = $lock->guard;

   open my $fh, "<", \$_[0]
      or die "cannot open pst: $!";
   Storable::fd_retrieve $fh
}

sub blocking_freeze($) {
   my $guard = $lock->guard;

   open my $fh, ">", \my $buf
         or die "cannot open pst: $!";
   Storable::store_fd $_[0], $fh;
   close $fh;

   $buf
}

sub blocking_nfreeze($) {
   my $guard = $lock->guard;

   open my $fh, ">", \my $buf
         or die "cannot open pst: $!";
   Storable::nstore_fd $_[0], $fh;
   close $fh;

   $buf
}

package PerlIO::via::CoroCede;

# generic cede-on-read/write filtering layer

use Time::HiRes ("time");

our $GRANULARITY = 0.001;

my $next_cede;

sub PUSHED {
   __PACKAGE__
}

sub FILL {
   if ($next_cede <= time) {
      $next_cede = time + $GRANULARITY; # calling time() twice usually is a net win
      Coro::cede;
   }

   read $_[1], my $buf, 512
      or return undef;

   $buf
}

sub WRITE {
   if ($next_cede <= (my $now = time)) {
      Coro::cede;
      $next_cede = $now + $GRANULARITY;
   }

   (print {$_[2]} $_[1]) ? length $_[1] : -1
}

1;

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut


Revision:	1.10
Committed:	Sun Dec 2 22:24:30 2007 UTC (16 years, 6 months ago) by root
Branch:	MAIN
CVS Tags:	rel-4_3, rel-4_50, rel-4_51, rel-4_4, rel-4_45, rel-4_49, rel-4_48, rel-4_47, rel-4_46, rel-4_31, rel-4_32, rel-4_33, rel-4_34, rel-4_35, rel-4_36, rel-4_37
Changes since 1.9:	+3 -3 lines
Log Message:	* empty log message *
#	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<Storable::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 Storable 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	=item $guard = guard;
63
64	Acquire the Storable lock, for when you want to call Storable yourself.
65
66	=back
67
68	=cut
69
70	package Coro::Storable;
71
72	use strict;
73
74	use Coro ();
75	use Coro::Semaphore ();
76
77	use Storable;
78	use base "Exporter";
79
80	our $VERSION = '0.2';
81	our @EXPORT = qw(thaw freeze nfreeze blocking_thaw blocking_freeze blocking_nfreeze);
82
83	my $lock = new Coro::Semaphore;
84
85	sub guard {
86	$lock->guard
87	}
88
89	sub thaw($) {
90	my $guard = $lock->guard;
91
92	open my $fh, "<:via(CoroCede)", \$_[0]
93	or die "cannot open pst via CoroCede: $!";
94	Storable::fd_retrieve $fh
95	}
96
97	sub freeze($) {
98	my $guard = $lock->guard;
99
100	open my $fh, ">:via(CoroCede)", \my $buf
101	or die "cannot open pst via CoroCede: $!";
102	Storable::store_fd $_[0], $fh;
103	$buf
104	}
105
106	sub nfreeze($) {
107	my $guard = $lock->guard;
108
109	open my $fh, ">:via(CoroCede)", \my $buf
110	or die "cannot open pst via CoroCede: $!";
111	Storable::nstore_fd $_[0], $fh;
112	$buf
113	}
114
115	sub blocking_thaw($) {
116	my $guard = $lock->guard;
117
118	open my $fh, "<", \$_[0]
119	or die "cannot open pst: $!";
120	Storable::fd_retrieve $fh
121	}
122
123	sub blocking_freeze($) {
124	my $guard = $lock->guard;
125
126	open my $fh, ">", \my $buf
127	or die "cannot open pst: $!";
128	Storable::store_fd $_[0], $fh;
129	close $fh;
130
131	$buf
132	}
133
134	sub blocking_nfreeze($) {
135	my $guard = $lock->guard;
136
137	open my $fh, ">", \my $buf
138	or die "cannot open pst: $!";
139	Storable::nstore_fd $_[0], $fh;
140	close $fh;
141
142	$buf
143	}
144
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;
181
182	=head1 AUTHOR
183
184	Marc Lehmann <schmorp@schmorp.de>
185	http://home.schmorp.de/
186
187	=cut
188
189