Commit | Line | Data |
---|---|---|
596596d5 | 1 | ;# $Id: Storable.pm,v 1.0.1.13 2001/12/01 13:34:49 ram Exp $ |
7a6a85bf RG |
2 | ;# |
3 | ;# Copyright (c) 1995-2000, Raphael Manfredi | |
4 | ;# | |
9e21b3d0 JH |
5 | ;# You may redistribute only under the same terms as Perl 5, as specified |
6 | ;# in the README file that comes with the distribution. | |
7a6a85bf RG |
7 | ;# |
8 | ;# $Log: Storable.pm,v $ | |
596596d5 JH |
9 | ;# Revision 1.0.1.13 2001/12/01 13:34:49 ram |
10 | ;# patch14: avoid requiring Fcntl upfront, useful to embedded runtimes | |
11 | ;# patch14: store_fd() will now correctly autoflush file if needed | |
12 | ;# | |
6e0ac6f5 JH |
13 | ;# Revision 1.0.1.12 2001/08/28 21:51:51 ram |
14 | ;# patch13: fixed truncation race with lock_retrieve() in lock_store() | |
15 | ;# | |
e993d95c JH |
16 | ;# Revision 1.0.1.11 2001/07/01 11:22:14 ram |
17 | ;# patch12: systematically use "=over 4" for POD linters | |
18 | ;# patch12: updated version number | |
19 | ;# | |
8be2b38b JH |
20 | ;# Revision 1.0.1.10 2001/03/15 00:20:25 ram |
21 | ;# patch11: updated version number | |
22 | ;# | |
23 | ;# Revision 1.0.1.9 2001/02/17 12:37:32 ram | |
24 | ;# patch10: forgot to increase version number at previous patch | |
25 | ;# | |
b12202d0 JH |
26 | ;# Revision 1.0.1.8 2001/02/17 12:24:37 ram |
27 | ;# patch8: fixed incorrect error message | |
28 | ;# | |
862382c7 JH |
29 | ;# Revision 1.0.1.7 2001/01/03 09:39:02 ram |
30 | ;# patch7: added CAN_FLOCK to determine whether we can flock() or not | |
31 | ;# | |
90826881 JH |
32 | ;# Revision 1.0.1.6 2000/11/05 17:20:25 ram |
33 | ;# patch6: increased version number | |
34 | ;# | |
212e9bde JH |
35 | ;# Revision 1.0.1.5 2000/10/26 17:10:18 ram |
36 | ;# patch5: documented that store() and retrieve() can return undef | |
37 | ;# patch5: added paragraph explaining the auto require for thaw hooks | |
38 | ;# | |
39 | ;# Revision 1.0.1.4 2000/10/23 18:02:57 ram | |
40 | ;# patch4: protected calls to flock() for dos platform | |
41 | ;# patch4: added logcarp emulation if they don't have Log::Agent | |
42 | ;# | |
8be2b38b JH |
43 | ;# Revision 1.0.1.3 2000/09/29 19:49:01 ram |
44 | ;# patch3: updated version number | |
45 | ;# | |
46 | ;# Revision 1.0.1.2 2000/09/28 21:42:51 ram | |
47 | ;# patch2: added lock_store lock_nstore lock_retrieve | |
48 | ;# | |
49 | ;# Revision 1.0.1.1 2000/09/17 16:46:21 ram | |
50 | ;# patch1: documented that doubles are stringified by nstore() | |
51 | ;# patch1: added Salvador Ortiz Garcia in CREDITS section | |
52 | ;# | |
9e21b3d0 JH |
53 | ;# Revision 1.0 2000/09/01 19:40:41 ram |
54 | ;# Baseline for first official release. | |
7a6a85bf RG |
55 | ;# |
56 | ||
57 | require DynaLoader; | |
58 | require Exporter; | |
59 | package Storable; @ISA = qw(Exporter DynaLoader); | |
60 | ||
61 | @EXPORT = qw(store retrieve); | |
62 | @EXPORT_OK = qw( | |
9e21b3d0 | 63 | nstore store_fd nstore_fd fd_retrieve |
7a6a85bf RG |
64 | freeze nfreeze thaw |
65 | dclone | |
9e21b3d0 | 66 | retrieve_fd |
dd19458b | 67 | lock_store lock_nstore lock_retrieve |
7a6a85bf RG |
68 | ); |
69 | ||
70 | use AutoLoader; | |
71 | use vars qw($forgive_me $VERSION); | |
72 | ||
0a0da639 | 73 | $VERSION = '1.015'; |
7a6a85bf RG |
74 | *AUTOLOAD = \&AutoLoader::AUTOLOAD; # Grrr... |
75 | ||
76 | # | |
77 | # Use of Log::Agent is optional | |
78 | # | |
79 | ||
80 | eval "use Log::Agent"; | |
81 | ||
530b72ba | 82 | require Carp; |
7a6a85bf | 83 | |
dd19458b JH |
84 | # |
85 | # They might miss :flock in Fcntl | |
86 | # | |
87 | ||
88 | BEGIN { | |
596596d5 | 89 | if (eval { require Fcntl; 1 } && exists $Fcntl::EXPORT_TAGS{'flock'}) { |
dd19458b JH |
90 | Fcntl->import(':flock'); |
91 | } else { | |
92 | eval q{ | |
93 | sub LOCK_SH () {1} | |
94 | sub LOCK_EX () {2} | |
95 | }; | |
96 | } | |
97 | } | |
98 | ||
b8778c7c | 99 | # Can't Autoload cleanly as this clashes 8.3 with &retrieve |
9e21b3d0 | 100 | sub retrieve_fd { &fd_retrieve } # Backward compatibility |
cb3d9de5 | 101 | |
530b72ba NC |
102 | # By default restricted hashes are downgraded on earlier perls. |
103 | ||
104 | $Storable::downgrade_restricted = 1; | |
b8778c7c NC |
105 | bootstrap Storable; |
106 | 1; | |
107 | __END__ | |
530b72ba NC |
108 | # |
109 | # Use of Log::Agent is optional. If it hasn't imported these subs then | |
110 | # Autoloader will kindly supply our fallback implementation. | |
111 | # | |
112 | ||
113 | sub logcroak { | |
114 | Carp::croak(@_); | |
115 | } | |
116 | ||
117 | sub logcarp { | |
118 | Carp::carp(@_); | |
119 | } | |
b8778c7c | 120 | |
862382c7 JH |
121 | # |
122 | # Determine whether locking is possible, but only when needed. | |
123 | # | |
124 | ||
530b72ba | 125 | sub CAN_FLOCK; my $CAN_FLOCK; sub CAN_FLOCK { |
862382c7 JH |
126 | return $CAN_FLOCK if defined $CAN_FLOCK; |
127 | require Config; import Config; | |
128 | return $CAN_FLOCK = | |
129 | $Config{'d_flock'} || | |
130 | $Config{'d_fcntl_can_lock'} || | |
131 | $Config{'d_lockf'}; | |
132 | } | |
133 | ||
0a0da639 JH |
134 | sub show_file_magic { |
135 | print <<EOM; | |
136 | # | |
137 | # To recognize the data files of the Perl module Storable, | |
138 | # the following lines need to be added to the local magic(5) file, | |
139 | # usually either /usr/share/misc/magic or /etc/magic. | |
0a0da639 JH |
140 | # |
141 | 0 string perl-store perl Storable(v0.6) data | |
8b793558 JH |
142 | >4 byte >0 (net-order %d) |
143 | >>4 byte &01 (network-ordered) | |
144 | >>4 byte =3 (major 1) | |
145 | >>4 byte =2 (major 1) | |
146 | ||
0a0da639 | 147 | 0 string pst0 perl Storable(v0.7) data |
8b793558 JH |
148 | >4 byte >0 |
149 | >>4 byte &01 (network-ordered) | |
150 | >>4 byte =5 (major 2) | |
151 | >>4 byte =4 (major 2) | |
152 | >>5 byte >0 (minor %d) | |
0a0da639 JH |
153 | EOM |
154 | } | |
155 | ||
b8778c7c NC |
156 | sub read_magic { |
157 | my $header = shift; | |
158 | return unless defined $header and length $header > 11; | |
159 | my $result; | |
160 | if ($header =~ s/^perl-store//) { | |
161 | die "Can't deal with version 0 headers"; | |
162 | } elsif ($header =~ s/^pst0//) { | |
163 | $result->{file} = 1; | |
164 | } | |
165 | # Assume it's a string. | |
166 | my ($major, $minor, $bytelen) = unpack "C3", $header; | |
167 | ||
168 | my $net_order = $major & 1; | |
169 | $major >>= 1; | |
170 | @$result{qw(major minor netorder)} = ($major, $minor, $net_order); | |
171 | ||
172 | return $result if $net_order; | |
173 | ||
174 | # I assume that it is rare to find v1 files, so this is an intentionally | |
175 | # inefficient way of doing it, to make the rest of the code constant. | |
176 | if ($major < 2) { | |
177 | delete $result->{minor}; | |
178 | $header = '.' . $header; | |
179 | $bytelen = $minor; | |
180 | } | |
181 | ||
182 | @$result{qw(byteorder intsize longsize ptrsize)} = | |
183 | unpack "x3 A$bytelen C3", $header; | |
184 | ||
185 | if ($major >= 2 and $minor >= 2) { | |
186 | $result->{nvsize} = unpack "x6 x$bytelen C", $header; | |
187 | } | |
188 | $result; | |
189 | } | |
7a6a85bf RG |
190 | |
191 | # | |
192 | # store | |
193 | # | |
194 | # Store target object hierarchy, identified by a reference to its root. | |
195 | # The stored object tree may later be retrieved to memory via retrieve. | |
196 | # Returns undef if an I/O error occurred, in which case the file is | |
197 | # removed. | |
198 | # | |
199 | sub store { | |
dd19458b | 200 | return _store(\&pstore, @_, 0); |
7a6a85bf RG |
201 | } |
202 | ||
203 | # | |
204 | # nstore | |
205 | # | |
206 | # Same as store, but in network order. | |
207 | # | |
208 | sub nstore { | |
dd19458b JH |
209 | return _store(\&net_pstore, @_, 0); |
210 | } | |
211 | ||
212 | # | |
213 | # lock_store | |
214 | # | |
215 | # Same as store, but flock the file first (advisory locking). | |
216 | # | |
217 | sub lock_store { | |
218 | return _store(\&pstore, @_, 1); | |
219 | } | |
220 | ||
221 | # | |
222 | # lock_nstore | |
223 | # | |
224 | # Same as nstore, but flock the file first (advisory locking). | |
225 | # | |
226 | sub lock_nstore { | |
227 | return _store(\&net_pstore, @_, 1); | |
7a6a85bf RG |
228 | } |
229 | ||
230 | # Internal store to file routine | |
231 | sub _store { | |
232 | my $xsptr = shift; | |
233 | my $self = shift; | |
dd19458b | 234 | my ($file, $use_locking) = @_; |
7a6a85bf | 235 | logcroak "not a reference" unless ref($self); |
b12202d0 | 236 | logcroak "wrong argument number" unless @_ == 2; # No @foo in arglist |
7a6a85bf | 237 | local *FILE; |
dd19458b | 238 | if ($use_locking) { |
6e0ac6f5 | 239 | open(FILE, ">>$file") || logcroak "can't write into $file: $!"; |
862382c7 | 240 | unless (&CAN_FLOCK) { |
b29b780f RM |
241 | logcarp "Storable::lock_store: fcntl/flock emulation broken on $^O"; |
242 | return undef; | |
f567092b | 243 | } |
dd19458b JH |
244 | flock(FILE, LOCK_EX) || |
245 | logcroak "can't get exclusive lock on $file: $!"; | |
246 | truncate FILE, 0; | |
247 | # Unlocking will happen when FILE is closed | |
6e0ac6f5 JH |
248 | } else { |
249 | open(FILE, ">$file") || logcroak "can't create $file: $!"; | |
dd19458b | 250 | } |
6e0ac6f5 | 251 | binmode FILE; # Archaic systems... |
7a6a85bf RG |
252 | my $da = $@; # Don't mess if called from exception handler |
253 | my $ret; | |
254 | # Call C routine nstore or pstore, depending on network order | |
255 | eval { $ret = &$xsptr(*FILE, $self) }; | |
256 | close(FILE) or $ret = undef; | |
257 | unlink($file) or warn "Can't unlink $file: $!\n" if $@ || !defined $ret; | |
258 | logcroak $@ if $@ =~ s/\.?\n$/,/; | |
259 | $@ = $da; | |
260 | return $ret ? $ret : undef; | |
261 | } | |
262 | ||
263 | # | |
264 | # store_fd | |
265 | # | |
266 | # Same as store, but perform on an already opened file descriptor instead. | |
267 | # Returns undef if an I/O error occurred. | |
268 | # | |
269 | sub store_fd { | |
270 | return _store_fd(\&pstore, @_); | |
271 | } | |
272 | ||
273 | # | |
274 | # nstore_fd | |
275 | # | |
276 | # Same as store_fd, but in network order. | |
277 | # | |
278 | sub nstore_fd { | |
279 | my ($self, $file) = @_; | |
280 | return _store_fd(\&net_pstore, @_); | |
281 | } | |
282 | ||
283 | # Internal store routine on opened file descriptor | |
284 | sub _store_fd { | |
285 | my $xsptr = shift; | |
286 | my $self = shift; | |
287 | my ($file) = @_; | |
288 | logcroak "not a reference" unless ref($self); | |
289 | logcroak "too many arguments" unless @_ == 1; # No @foo in arglist | |
290 | my $fd = fileno($file); | |
291 | logcroak "not a valid file descriptor" unless defined $fd; | |
292 | my $da = $@; # Don't mess if called from exception handler | |
293 | my $ret; | |
294 | # Call C routine nstore or pstore, depending on network order | |
295 | eval { $ret = &$xsptr($file, $self) }; | |
296 | logcroak $@ if $@ =~ s/\.?\n$/,/; | |
596596d5 | 297 | local $\; print $file ''; # Autoflush the file if wanted |
7a6a85bf RG |
298 | $@ = $da; |
299 | return $ret ? $ret : undef; | |
300 | } | |
301 | ||
302 | # | |
303 | # freeze | |
304 | # | |
305 | # Store oject and its hierarchy in memory and return a scalar | |
306 | # containing the result. | |
307 | # | |
308 | sub freeze { | |
309 | _freeze(\&mstore, @_); | |
310 | } | |
311 | ||
312 | # | |
313 | # nfreeze | |
314 | # | |
315 | # Same as freeze but in network order. | |
316 | # | |
317 | sub nfreeze { | |
318 | _freeze(\&net_mstore, @_); | |
319 | } | |
320 | ||
321 | # Internal freeze routine | |
322 | sub _freeze { | |
323 | my $xsptr = shift; | |
324 | my $self = shift; | |
325 | logcroak "not a reference" unless ref($self); | |
326 | logcroak "too many arguments" unless @_ == 0; # No @foo in arglist | |
327 | my $da = $@; # Don't mess if called from exception handler | |
328 | my $ret; | |
329 | # Call C routine mstore or net_mstore, depending on network order | |
330 | eval { $ret = &$xsptr($self) }; | |
331 | logcroak $@ if $@ =~ s/\.?\n$/,/; | |
332 | $@ = $da; | |
333 | return $ret ? $ret : undef; | |
334 | } | |
335 | ||
336 | # | |
337 | # retrieve | |
338 | # | |
339 | # Retrieve object hierarchy from disk, returning a reference to the root | |
340 | # object of that tree. | |
341 | # | |
342 | sub retrieve { | |
dd19458b JH |
343 | _retrieve($_[0], 0); |
344 | } | |
345 | ||
346 | # | |
347 | # lock_retrieve | |
348 | # | |
349 | # Same as retrieve, but with advisory locking. | |
350 | # | |
351 | sub lock_retrieve { | |
352 | _retrieve($_[0], 1); | |
353 | } | |
354 | ||
355 | # Internal retrieve routine | |
356 | sub _retrieve { | |
357 | my ($file, $use_locking) = @_; | |
7a6a85bf | 358 | local *FILE; |
dd19458b | 359 | open(FILE, $file) || logcroak "can't open $file: $!"; |
7a6a85bf RG |
360 | binmode FILE; # Archaic systems... |
361 | my $self; | |
362 | my $da = $@; # Could be from exception handler | |
dd19458b | 363 | if ($use_locking) { |
862382c7 | 364 | unless (&CAN_FLOCK) { |
8be2b38b | 365 | logcarp "Storable::lock_store: fcntl/flock emulation broken on $^O"; |
b29b780f RM |
366 | return undef; |
367 | } | |
8be2b38b | 368 | flock(FILE, LOCK_SH) || logcroak "can't get shared lock on $file: $!"; |
dd19458b JH |
369 | # Unlocking will happen when FILE is closed |
370 | } | |
7a6a85bf RG |
371 | eval { $self = pretrieve(*FILE) }; # Call C routine |
372 | close(FILE); | |
373 | logcroak $@ if $@ =~ s/\.?\n$/,/; | |
374 | $@ = $da; | |
375 | return $self; | |
376 | } | |
377 | ||
378 | # | |
9e21b3d0 | 379 | # fd_retrieve |
7a6a85bf RG |
380 | # |
381 | # Same as retrieve, but perform from an already opened file descriptor instead. | |
382 | # | |
9e21b3d0 | 383 | sub fd_retrieve { |
7a6a85bf RG |
384 | my ($file) = @_; |
385 | my $fd = fileno($file); | |
386 | logcroak "not a valid file descriptor" unless defined $fd; | |
387 | my $self; | |
388 | my $da = $@; # Could be from exception handler | |
389 | eval { $self = pretrieve($file) }; # Call C routine | |
390 | logcroak $@ if $@ =~ s/\.?\n$/,/; | |
391 | $@ = $da; | |
392 | return $self; | |
393 | } | |
394 | ||
395 | # | |
396 | # thaw | |
397 | # | |
398 | # Recreate objects in memory from an existing frozen image created | |
399 | # by freeze. If the frozen image passed is undef, return undef. | |
400 | # | |
401 | sub thaw { | |
402 | my ($frozen) = @_; | |
403 | return undef unless defined $frozen; | |
404 | my $self; | |
405 | my $da = $@; # Could be from exception handler | |
406 | eval { $self = mretrieve($frozen) }; # Call C routine | |
407 | logcroak $@ if $@ =~ s/\.?\n$/,/; | |
408 | $@ = $da; | |
409 | return $self; | |
410 | } | |
411 | ||
412 | =head1 NAME | |
413 | ||
414 | Storable - persistency for perl data structures | |
415 | ||
416 | =head1 SYNOPSIS | |
417 | ||
418 | use Storable; | |
419 | store \%table, 'file'; | |
420 | $hashref = retrieve('file'); | |
421 | ||
422 | use Storable qw(nstore store_fd nstore_fd freeze thaw dclone); | |
423 | ||
424 | # Network order | |
425 | nstore \%table, 'file'; | |
426 | $hashref = retrieve('file'); # There is NO nretrieve() | |
427 | ||
428 | # Storing to and retrieving from an already opened file | |
429 | store_fd \@array, \*STDOUT; | |
430 | nstore_fd \%table, \*STDOUT; | |
9e21b3d0 JH |
431 | $aryref = fd_retrieve(\*SOCKET); |
432 | $hashref = fd_retrieve(\*SOCKET); | |
7a6a85bf RG |
433 | |
434 | # Serializing to memory | |
435 | $serialized = freeze \%table; | |
436 | %table_clone = %{ thaw($serialized) }; | |
437 | ||
438 | # Deep (recursive) cloning | |
439 | $cloneref = dclone($ref); | |
440 | ||
dd19458b JH |
441 | # Advisory locking |
442 | use Storable qw(lock_store lock_nstore lock_retrieve) | |
443 | lock_store \%table, 'file'; | |
444 | lock_nstore \%table, 'file'; | |
445 | $hashref = lock_retrieve('file'); | |
446 | ||
7a6a85bf RG |
447 | =head1 DESCRIPTION |
448 | ||
449 | The Storable package brings persistency to your perl data structures | |
450 | containing SCALAR, ARRAY, HASH or REF objects, i.e. anything that can be | |
451 | convenientely stored to disk and retrieved at a later time. | |
452 | ||
453 | It can be used in the regular procedural way by calling C<store> with | |
454 | a reference to the object to be stored, along with the file name where | |
455 | the image should be written. | |
456 | The routine returns C<undef> for I/O problems or other internal error, | |
457 | a true value otherwise. Serious errors are propagated as a C<die> exception. | |
458 | ||
459 | To retrieve data stored to disk, use C<retrieve> with a file name, | |
460 | and the objects stored into that file are recreated into memory for you, | |
461 | a I<reference> to the root object being returned. In case an I/O error | |
462 | occurs while reading, C<undef> is returned instead. Other serious | |
463 | errors are propagated via C<die>. | |
464 | ||
465 | Since storage is performed recursively, you might want to stuff references | |
466 | to objects that share a lot of common data into a single array or hash | |
467 | table, and then store that object. That way, when you retrieve back the | |
468 | whole thing, the objects will continue to share what they originally shared. | |
469 | ||
470 | At the cost of a slight header overhead, you may store to an already | |
471 | opened file descriptor using the C<store_fd> routine, and retrieve | |
9e21b3d0 | 472 | from a file via C<fd_retrieve>. Those names aren't imported by default, |
7a6a85bf RG |
473 | so you will have to do that explicitely if you need those routines. |
474 | The file descriptor you supply must be already opened, for read | |
475 | if you're going to retrieve and for write if you wish to store. | |
476 | ||
477 | store_fd(\%table, *STDOUT) || die "can't store to stdout\n"; | |
9e21b3d0 | 478 | $hashref = fd_retrieve(*STDIN); |
7a6a85bf RG |
479 | |
480 | You can also store data in network order to allow easy sharing across | |
481 | multiple platforms, or when storing on a socket known to be remotely | |
482 | connected. The routines to call have an initial C<n> prefix for I<network>, | |
483 | as in C<nstore> and C<nstore_fd>. At retrieval time, your data will be | |
484 | correctly restored so you don't have to know whether you're restoring | |
dd19458b JH |
485 | from native or network ordered data. Double values are stored stringified |
486 | to ensure portability as well, at the slight risk of loosing some precision | |
487 | in the last decimals. | |
7a6a85bf | 488 | |
9e21b3d0 | 489 | When using C<fd_retrieve>, objects are retrieved in sequence, one |
7a6a85bf RG |
490 | object (i.e. one recursive tree) per associated C<store_fd>. |
491 | ||
492 | If you're more from the object-oriented camp, you can inherit from | |
493 | Storable and directly store your objects by invoking C<store> as | |
494 | a method. The fact that the root of the to-be-stored tree is a | |
495 | blessed reference (i.e. an object) is special-cased so that the | |
496 | retrieve does not provide a reference to that object but rather the | |
497 | blessed object reference itself. (Otherwise, you'd get a reference | |
498 | to that blessed object). | |
499 | ||
500 | =head1 MEMORY STORE | |
501 | ||
502 | The Storable engine can also store data into a Perl scalar instead, to | |
503 | later retrieve them. This is mainly used to freeze a complex structure in | |
504 | some safe compact memory place (where it can possibly be sent to another | |
505 | process via some IPC, since freezing the structure also serializes it in | |
506 | effect). Later on, and maybe somewhere else, you can thaw the Perl scalar | |
507 | out and recreate the original complex structure in memory. | |
508 | ||
509 | Surprisingly, the routines to be called are named C<freeze> and C<thaw>. | |
510 | If you wish to send out the frozen scalar to another machine, use | |
511 | C<nfreeze> instead to get a portable image. | |
512 | ||
513 | Note that freezing an object structure and immediately thawing it | |
514 | actually achieves a deep cloning of that structure: | |
515 | ||
516 | dclone(.) = thaw(freeze(.)) | |
517 | ||
518 | Storable provides you with a C<dclone> interface which does not create | |
519 | that intermediary scalar but instead freezes the structure in some | |
520 | internal memory space and then immediatly thaws it out. | |
521 | ||
dd19458b JH |
522 | =head1 ADVISORY LOCKING |
523 | ||
524 | The C<lock_store> and C<lock_nstore> routine are equivalent to C<store> | |
525 | and C<nstore>, only they get an exclusive lock on the file before | |
526 | writing. Likewise, C<lock_retrieve> performs as C<retrieve>, but also | |
527 | gets a shared lock on the file before reading. | |
528 | ||
529 | Like with any advisory locking scheme, the protection only works if | |
530 | you systematically use C<lock_store> and C<lock_retrieve>. If one | |
531 | side of your application uses C<store> whilst the other uses C<lock_retrieve>, | |
532 | you will get no protection at all. | |
533 | ||
534 | The internal advisory locking is implemented using Perl's flock() routine. | |
535 | If your system does not support any form of flock(), or if you share | |
536 | your files across NFS, you might wish to use other forms of locking by | |
537 | using modules like LockFile::Simple which lock a file using a filesystem | |
538 | entry, instead of locking the file descriptor. | |
539 | ||
7a6a85bf RG |
540 | =head1 SPEED |
541 | ||
542 | The heart of Storable is written in C for decent speed. Extra low-level | |
543 | optimization have been made when manipulating perl internals, to | |
544 | sacrifice encapsulation for the benefit of a greater speed. | |
545 | ||
546 | =head1 CANONICAL REPRESENTATION | |
547 | ||
548 | Normally Storable stores elements of hashes in the order they are | |
549 | stored internally by Perl, i.e. pseudo-randomly. If you set | |
550 | C<$Storable::canonical> to some C<TRUE> value, Storable will store | |
551 | hashes with the elements sorted by their key. This allows you to | |
552 | compare data structures by comparing their frozen representations (or | |
553 | even the compressed frozen representations), which can be useful for | |
554 | creating lookup tables for complicated queries. | |
555 | ||
556 | Canonical order does not imply network order, those are two orthogonal | |
557 | settings. | |
558 | ||
559 | =head1 ERROR REPORTING | |
560 | ||
561 | Storable uses the "exception" paradigm, in that it does not try to workaround | |
562 | failures: if something bad happens, an exception is generated from the | |
563 | caller's perspective (see L<Carp> and C<croak()>). Use eval {} to trap | |
564 | those exceptions. | |
565 | ||
566 | When Storable croaks, it tries to report the error via the C<logcroak()> | |
567 | routine from the C<Log::Agent> package, if it is available. | |
568 | ||
212e9bde JH |
569 | Normal errors are reported by having store() or retrieve() return C<undef>. |
570 | Such errors are usually I/O errors (or truncated stream errors at retrieval). | |
571 | ||
7a6a85bf RG |
572 | =head1 WIZARDS ONLY |
573 | ||
574 | =head2 Hooks | |
575 | ||
576 | Any class may define hooks that will be called during the serialization | |
577 | and deserialization process on objects that are instances of that class. | |
578 | Those hooks can redefine the way serialization is performed (and therefore, | |
579 | how the symetrical deserialization should be conducted). | |
580 | ||
581 | Since we said earlier: | |
582 | ||
583 | dclone(.) = thaw(freeze(.)) | |
584 | ||
585 | everything we say about hooks should also hold for deep cloning. However, | |
586 | hooks get to know whether the operation is a mere serialization, or a cloning. | |
587 | ||
588 | Therefore, when serializing hooks are involved, | |
589 | ||
590 | dclone(.) <> thaw(freeze(.)) | |
591 | ||
592 | Well, you could keep them in sync, but there's no guarantee it will always | |
593 | hold on classes somebody else wrote. Besides, there is little to gain in | |
594 | doing so: a serializing hook could only keep one attribute of an object, | |
595 | which is probably not what should happen during a deep cloning of that | |
596 | same object. | |
597 | ||
598 | Here is the hooking interface: | |
599 | ||
bbc7dcd2 | 600 | =over 4 |
7a6a85bf RG |
601 | |
602 | =item C<STORABLE_freeze> I<obj>, I<cloning> | |
603 | ||
604 | The serializing hook, called on the object during serialization. It can be | |
605 | inherited, or defined in the class itself, like any other method. | |
606 | ||
607 | Arguments: I<obj> is the object to serialize, I<cloning> is a flag indicating | |
608 | whether we're in a dclone() or a regular serialization via store() or freeze(). | |
609 | ||
610 | Returned value: A LIST C<($serialized, $ref1, $ref2, ...)> where $serialized | |
611 | is the serialized form to be used, and the optional $ref1, $ref2, etc... are | |
612 | extra references that you wish to let the Storable engine serialize. | |
613 | ||
614 | At deserialization time, you will be given back the same LIST, but all the | |
615 | extra references will be pointing into the deserialized structure. | |
616 | ||
617 | The B<first time> the hook is hit in a serialization flow, you may have it | |
618 | return an empty list. That will signal the Storable engine to further | |
619 | discard that hook for this class and to therefore revert to the default | |
620 | serialization of the underlying Perl data. The hook will again be normally | |
621 | processed in the next serialization. | |
622 | ||
623 | Unless you know better, serializing hook should always say: | |
624 | ||
625 | sub STORABLE_freeze { | |
626 | my ($self, $cloning) = @_; | |
627 | return if $cloning; # Regular default serialization | |
628 | .... | |
629 | } | |
630 | ||
631 | in order to keep reasonable dclone() semantics. | |
632 | ||
633 | =item C<STORABLE_thaw> I<obj>, I<cloning>, I<serialized>, ... | |
634 | ||
635 | The deserializing hook called on the object during deserialization. | |
636 | But wait. If we're deserializing, there's no object yet... right? | |
637 | ||
638 | Wrong: the Storable engine creates an empty one for you. If you know Eiffel, | |
639 | you can view C<STORABLE_thaw> as an alternate creation routine. | |
640 | ||
641 | This means the hook can be inherited like any other method, and that | |
642 | I<obj> is your blessed reference for this particular instance. | |
643 | ||
644 | The other arguments should look familiar if you know C<STORABLE_freeze>: | |
645 | I<cloning> is true when we're part of a deep clone operation, I<serialized> | |
646 | is the serialized string you returned to the engine in C<STORABLE_freeze>, | |
647 | and there may be an optional list of references, in the same order you gave | |
648 | them at serialization time, pointing to the deserialized objects (which | |
649 | have been processed courtesy of the Storable engine). | |
650 | ||
212e9bde JH |
651 | When the Storable engine does not find any C<STORABLE_thaw> hook routine, |
652 | it tries to load the class by requiring the package dynamically (using | |
653 | the blessed package name), and then re-attempts the lookup. If at that | |
654 | time the hook cannot be located, the engine croaks. Note that this mechanism | |
655 | will fail if you define several classes in the same file, but perlmod(1) | |
656 | warned you. | |
657 | ||
7a6a85bf RG |
658 | It is up to you to use these information to populate I<obj> the way you want. |
659 | ||
660 | Returned value: none. | |
661 | ||
662 | =back | |
663 | ||
664 | =head2 Predicates | |
665 | ||
666 | Predicates are not exportable. They must be called by explicitely prefixing | |
667 | them with the Storable package name. | |
668 | ||
bbc7dcd2 | 669 | =over 4 |
7a6a85bf RG |
670 | |
671 | =item C<Storable::last_op_in_netorder> | |
672 | ||
673 | The C<Storable::last_op_in_netorder()> predicate will tell you whether | |
674 | network order was used in the last store or retrieve operation. If you | |
675 | don't know how to use this, just forget about it. | |
676 | ||
677 | =item C<Storable::is_storing> | |
678 | ||
679 | Returns true if within a store operation (via STORABLE_freeze hook). | |
680 | ||
681 | =item C<Storable::is_retrieving> | |
682 | ||
683 | Returns true if within a retrieve operation, (via STORABLE_thaw hook). | |
684 | ||
685 | =back | |
686 | ||
687 | =head2 Recursion | |
688 | ||
689 | With hooks comes the ability to recurse back to the Storable engine. Indeed, | |
690 | hooks are regular Perl code, and Storable is convenient when it comes to | |
691 | serialize and deserialize things, so why not use it to handle the | |
692 | serialization string? | |
693 | ||
694 | There are a few things you need to know however: | |
695 | ||
bbc7dcd2 | 696 | =over 4 |
7a6a85bf RG |
697 | |
698 | =item * | |
699 | ||
700 | You can create endless loops if the things you serialize via freeze() | |
701 | (for instance) point back to the object we're trying to serialize in the hook. | |
702 | ||
703 | =item * | |
704 | ||
705 | Shared references among objects will not stay shared: if we're serializing | |
706 | the list of object [A, C] where both object A and C refer to the SAME object | |
707 | B, and if there is a serializing hook in A that says freeze(B), then when | |
708 | deserializing, we'll get [A', C'] where A' refers to B', but C' refers to D, | |
709 | a deep clone of B'. The topology was not preserved. | |
710 | ||
711 | =back | |
712 | ||
713 | That's why C<STORABLE_freeze> lets you provide a list of references | |
714 | to serialize. The engine guarantees that those will be serialized in the | |
715 | same context as the other objects, and therefore that shared objects will | |
716 | stay shared. | |
717 | ||
718 | In the above [A, C] example, the C<STORABLE_freeze> hook could return: | |
719 | ||
720 | ("something", $self->{B}) | |
721 | ||
722 | and the B part would be serialized by the engine. In C<STORABLE_thaw>, you | |
723 | would get back the reference to the B' object, deserialized for you. | |
724 | ||
725 | Therefore, recursion should normally be avoided, but is nonetheless supported. | |
726 | ||
727 | =head2 Deep Cloning | |
728 | ||
729 | There is a new Clone module available on CPAN which implements deep cloning | |
730 | natively, i.e. without freezing to memory and thawing the result. It is | |
731 | aimed to replace Storable's dclone() some day. However, it does not currently | |
732 | support Storable hooks to redefine the way deep cloning is performed. | |
733 | ||
0a0da639 JH |
734 | =head1 Storable magic |
735 | ||
736 | Yes, there's a lot of that :-) But more precisely, in UNIX systems | |
737 | there's a utility called C<file>, which recognizes data files based on | |
738 | their contents (usually their first few bytes). For this to work, | |
8b793558 | 739 | a certain file called F<magic> needs to taught about the I<signature> |
0a0da639 JH |
740 | of the data. Where that configuration file lives depends on the UNIX |
741 | flavour, often it's something like F</usr/share/misc/magic> or | |
8b793558 JH |
742 | F</etc/magic>. Your system administrator needs to do the updating of |
743 | the F<magic> file. The necessary signature information is output to | |
744 | stdout by invoking Storable::show_file_magic(). Note that the open | |
745 | source implementation of the C<file> utility 3.38 (or later) | |
746 | is expected to contain the support for recognising Storable files, | |
747 | in addition to other kinds of Perl files. | |
0a0da639 | 748 | |
7a6a85bf RG |
749 | =head1 EXAMPLES |
750 | ||
751 | Here are some code samples showing a possible usage of Storable: | |
752 | ||
753 | use Storable qw(store retrieve freeze thaw dclone); | |
754 | ||
755 | %color = ('Blue' => 0.1, 'Red' => 0.8, 'Black' => 0, 'White' => 1); | |
756 | ||
757 | store(\%color, '/tmp/colors') or die "Can't store %a in /tmp/colors!\n"; | |
758 | ||
759 | $colref = retrieve('/tmp/colors'); | |
760 | die "Unable to retrieve from /tmp/colors!\n" unless defined $colref; | |
761 | printf "Blue is still %lf\n", $colref->{'Blue'}; | |
762 | ||
763 | $colref2 = dclone(\%color); | |
764 | ||
765 | $str = freeze(\%color); | |
766 | printf "Serialization of %%color is %d bytes long.\n", length($str); | |
767 | $colref3 = thaw($str); | |
768 | ||
769 | which prints (on my machine): | |
770 | ||
771 | Blue is still 0.100000 | |
772 | Serialization of %color is 102 bytes long. | |
773 | ||
774 | =head1 WARNING | |
775 | ||
776 | If you're using references as keys within your hash tables, you're bound | |
777 | to disapointment when retrieving your data. Indeed, Perl stringifies | |
778 | references used as hash table keys. If you later wish to access the | |
779 | items via another reference stringification (i.e. using the same | |
780 | reference that was used for the key originally to record the value into | |
781 | the hash table), it will work because both references stringify to the | |
782 | same string. | |
783 | ||
784 | It won't work across a C<store> and C<retrieve> operations however, because | |
785 | the addresses in the retrieved objects, which are part of the stringified | |
786 | references, will probably differ from the original addresses. The | |
787 | topology of your structure is preserved, but not hidden semantics | |
788 | like those. | |
789 | ||
790 | On platforms where it matters, be sure to call C<binmode()> on the | |
791 | descriptors that you pass to Storable functions. | |
792 | ||
793 | Storing data canonically that contains large hashes can be | |
794 | significantly slower than storing the same data normally, as | |
795 | temprorary arrays to hold the keys for each hash have to be allocated, | |
796 | populated, sorted and freed. Some tests have shown a halving of the | |
797 | speed of storing -- the exact penalty will depend on the complexity of | |
798 | your data. There is no slowdown on retrieval. | |
799 | ||
800 | =head1 BUGS | |
801 | ||
802 | You can't store GLOB, CODE, FORMLINE, etc... If you can define | |
803 | semantics for those operations, feel free to enhance Storable so that | |
804 | it can deal with them. | |
805 | ||
806 | The store functions will C<croak> if they run into such references | |
807 | unless you set C<$Storable::forgive_me> to some C<TRUE> value. In that | |
808 | case, the fatal message is turned in a warning and some | |
809 | meaningless string is stored instead. | |
810 | ||
811 | Setting C<$Storable::canonical> may not yield frozen strings that | |
812 | compare equal due to possible stringification of numbers. When the | |
813 | string version of a scalar exists, it is the form stored, therefore | |
814 | if you happen to use your numbers as strings between two freezing | |
815 | operations on the same data structures, you will get different | |
816 | results. | |
817 | ||
dd19458b JH |
818 | When storing doubles in network order, their value is stored as text. |
819 | However, you should also not expect non-numeric floating-point values | |
820 | such as infinity and "not a number" to pass successfully through a | |
821 | nstore()/retrieve() pair. | |
822 | ||
823 | As Storable neither knows nor cares about character sets (although it | |
824 | does know that characters may be more than eight bits wide), any difference | |
825 | in the interpretation of character codes between a host and a target | |
826 | system is your problem. In particular, if host and target use different | |
827 | code points to represent the characters used in the text representation | |
828 | of floating-point numbers, you will not be able be able to exchange | |
829 | floating-point data, even with nstore(). | |
830 | ||
7a6a85bf RG |
831 | =head1 CREDITS |
832 | ||
833 | Thank you to (in chronological order): | |
834 | ||
835 | Jarkko Hietaniemi <jhi@iki.fi> | |
836 | Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de> | |
837 | Benjamin A. Holzman <bah@ecnvantage.com> | |
838 | Andrew Ford <A.Ford@ford-mason.co.uk> | |
839 | Gisle Aas <gisle@aas.no> | |
840 | Jeff Gresham <gresham_jeffrey@jpmorgan.com> | |
841 | Murray Nesbitt <murray@activestate.com> | |
842 | Marc Lehmann <pcg@opengroup.org> | |
9e21b3d0 JH |
843 | Justin Banks <justinb@wamnet.com> |
844 | Jarkko Hietaniemi <jhi@iki.fi> (AGAIN, as perl 5.7.0 Pumpkin!) | |
dd19458b JH |
845 | Salvador Ortiz Garcia <sog@msg.com.mx> |
846 | Dominic Dunlop <domo@computer.org> | |
847 | Erik Haugan <erik@solbors.no> | |
7a6a85bf RG |
848 | |
849 | for their bug reports, suggestions and contributions. | |
850 | ||
851 | Benjamin Holzman contributed the tied variable support, Andrew Ford | |
852 | contributed the canonical order for hashes, and Gisle Aas fixed | |
853 | a few misunderstandings of mine regarding the Perl internals, | |
854 | and optimized the emission of "tags" in the output streams by | |
855 | simply counting the objects instead of tagging them (leading to | |
856 | a binary incompatibility for the Storable image starting at version | |
857 | 0.6--older images are of course still properly understood). | |
858 | Murray Nesbitt made Storable thread-safe. Marc Lehmann added overloading | |
859 | and reference to tied items support. | |
860 | ||
861 | =head1 TRANSLATIONS | |
862 | ||
863 | There is a Japanese translation of this man page available at | |
864 | http://member.nifty.ne.jp/hippo2000/perltips/storable.htm , | |
865 | courtesy of Kawai, Takanori <kawai@nippon-rad.co.jp>. | |
866 | ||
867 | =head1 AUTHOR | |
868 | ||
869 | Raphael Manfredi F<E<lt>Raphael_Manfredi@pobox.comE<gt>> | |
870 | ||
871 | =head1 SEE ALSO | |
872 | ||
873 | Clone(3). | |
874 | ||
875 | =cut | |
876 |