[Summary view] [Print] [Text view]

   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 239 "../../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;