home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _8405823c36f688c58a2d1a8d3d819472 < prev    next >
Encoding:
Text File  |  2004-06-01  |  1.3 KB  |  42 lines
  1. # NOTE: Derived from ..\..\lib\Storable.pm.
  2. # Changes made here will be lost when autosplit is run again.
  3. # See AutoSplit.pm.
  4. package Storable;
  5.  
  6. #line 187 "..\..\lib\Storable.pm (autosplit into ..\..\lib\auto\Storable\_store.al)"
  7. # Internal store to file routine
  8. sub _store {
  9.     my $xsptr = shift;
  10.     my $self = shift;
  11.     my ($file, $use_locking) = @_;
  12.     logcroak "not a reference" unless ref($self);
  13.     logcroak "wrong argument number" unless @_ == 2;    # No @foo in arglist
  14.     local *FILE;
  15.     if ($use_locking) {
  16.         open(FILE, ">>$file") || logcroak "can't write into $file: $!";
  17.         unless (&CAN_FLOCK) {
  18.             logcarp "Storable::lock_store: fcntl/flock emulation broken on $^O";
  19.             return undef;
  20.         }
  21.         flock(FILE, LOCK_EX) ||
  22.             logcroak "can't get exclusive lock on $file: $!";
  23.         truncate FILE, 0;
  24.         # Unlocking will happen when FILE is closed
  25.     } else {
  26.         open(FILE, ">$file") || logcroak "can't create $file: $!";
  27.     }
  28.     binmode FILE;                # Archaic systems...
  29.     my $da = $@;                # Don't mess if called from exception handler
  30.     my $ret;
  31.     # Call C routine nstore or pstore, depending on network order
  32.     eval { $ret = &$xsptr(*FILE, $self) };
  33.     close(FILE) or $ret = undef;
  34.     unlink($file) or warn "Can't unlink $file: $!\n" if $@ || !defined $ret;
  35.     logcroak $@ if $@ =~ s/\.?\n$/,/;
  36.     $@ = $da;
  37.     return $ret ? $ret : undef;
  38. }
  39.  
  40. # end of Storable::_store
  41. 1;
  42.