Initial commit of OpenSPARC T2 architecture model.
[OpenSPARC-T2-SAM] / sam-t2 / devtools / v8plus / lib / perl5 / 5.8.8 / sun4-solaris / auto / Storable / _store.al
CommitLineData
920dae64
AT
1# NOTE: Derived from ../../lib/Storable.pm.
2# Changes made here will be lost when autosplit is run again.
3# See AutoSplit.pm.
4package Storable;
5
6#line 190 "../../lib/Storable.pm (autosplit into ../../lib/auto/Storable/_store.al)"
7# Internal store to file routine
8sub _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
411;