| … | |
… | |
| 68 | |
68 | |
| 69 | =cut |
69 | =cut |
| 70 | |
70 | |
| 71 | package Coro::Storable; |
71 | package Coro::Storable; |
| 72 | |
72 | |
| 73 | use strict qw(subs vars); |
73 | use common::sense; |
| 74 | no warnings; |
|
|
| 75 | |
74 | |
| 76 | use Coro (); |
75 | use Coro (); |
| 77 | use Coro::Semaphore (); |
76 | use Coro::Semaphore (); |
| 78 | |
77 | |
| 79 | BEGIN { |
78 | BEGIN { |
| … | |
… | |
| 83 | } |
82 | } |
| 84 | |
83 | |
| 85 | use Storable; |
84 | use Storable; |
| 86 | use base "Exporter"; |
85 | use base "Exporter"; |
| 87 | |
86 | |
| 88 | our $VERSION = 4.804; |
87 | our $VERSION = 5.37; |
| 89 | 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); |
| 90 | |
89 | |
| 91 | our $GRANULARITY = 0.01; |
90 | our $GRANULARITY = 0.01; |
| 92 | |
91 | |
| 93 | my $lock = new Coro::Semaphore; |
92 | my $lock = new Coro::Semaphore; |
| … | |
… | |
| 97 | } |
96 | } |
| 98 | |
97 | |
| 99 | # wrap xs functions |
98 | # wrap xs functions |
| 100 | for (qw(net_pstore pstore net_mstore mstore pretrieve mretrieve dclone)) { |
99 | for (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 | |
| 109 | sub thaw($) { |
108 | sub thaw($) { |
| 110 | open my $fh, "<:cede($GRANULARITY)", \$_[0] |
109 | open my $fh, "<:cede($GRANULARITY)", \$_[0] |
