local-lib5/lib/perl5/i486-linux-gnu-thread-multi/auto/Storable/_store.al

   1 # NOTE: Derived from blib/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 239 "blib/lib/Storable.pm (autosplit into blib/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;