X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FPOSIX%2FPOSIX.pm;h=3813e973863c9e9e6442861cdf2fdf109f67e6f1;hb=46471bde41ad0777edf7b89818df6730e8b55c20;hp=8e58c040545a0173e6b646b460ac46f5b02e6fa9;hpb=3609ea0df8ff1318cd5f51cdbcd9bcd6c2a3fce2;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm index 8e58c04..3813e97 100644 --- a/ext/POSIX/POSIX.pm +++ b/ext/POSIX/POSIX.pm @@ -1,13 +1,20 @@ package POSIX; +use strict; +use warnings; -our(@ISA, %EXPORT_TAGS, @EXPORT_OK, $AUTOLOAD, %SIGRT) = (); +our(@ISA, %EXPORT_TAGS, @EXPORT_OK, @EXPORT, $AUTOLOAD, %SIGRT) = (); -our $VERSION = "1.09"; +our $VERSION = "1.12"; use AutoLoader; use XSLoader (); +use Fcntl qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK F_SETFD + F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK O_ACCMODE O_APPEND + O_CREAT O_EXCL O_NOCTTY O_NONBLOCK O_RDONLY O_RDWR O_TRUNC + O_WRONLY); + # Grandfather old foo_h form to new :foo_h form my $loaded; @@ -30,6 +37,8 @@ my %NON_CONSTS = (map {($_,1)} WIFEXITED WIFSIGNALED WIFSTOPPED WSTOPSIG WTERMSIG)); sub AUTOLOAD { + no strict; + no warnings 'uninitialized'; if ($AUTOLOAD =~ /::(_?[a-z])/) { # require AutoLoader; $AutoLoader::AUTOLOAD = $AUTOLOAD; @@ -54,72 +63,22 @@ sub AUTOLOAD { package POSIX::SigAction; use AutoLoader 'AUTOLOAD'; -sub new { bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] || 0, SAFE => 0}, $_[0] } package POSIX::SigRt; -use strict; +use AutoLoader 'AUTOLOAD'; use Tie::Hash; -use base qw(Tie::StdHash); - -use POSIX qw(sigaction SIGRTMIN SIGRTMAX SA_RESTART); -use vars qw($SIGACTION_FLAGS); +use vars qw($SIGACTION_FLAGS $_SIGRTMIN $_SIGRTMAX $_sigrtn @ISA); +@POSIX::SigRt::ISA = qw(Tie::StdHash); $SIGACTION_FLAGS = 0; -my $SIGRTMIN = &SIGRTMIN; -my $SIGRTMAX = &SIGRTMAX; -my $sigrtn = $SIGRTMAX - $SIGRTMIN; - -sub _croak { - die "POSIX::SigRt not available" unless defined $sigrtn && $sigrtn > 0; -} - -sub _getsig { - &_croak; - my $rtsig = $_[0]; - # Allow (SIGRT)?MIN( + n)?, a common idiom when doing these things in C. - $rtsig = $SIGRTMIN + ($1 || 0) - if $rtsig =~ /^(?:(?:SIG)?RT)?MIN(\s*\+\s*(\d+))?$/; - return $rtsig; -} - -sub _exist { - my $rtsig = _getsig($_[1]); - my $ok = $rtsig >= $SIGRTMIN && $rtsig <= $SIGRTMAX; - ($rtsig, $ok); -} - -sub _check { - my ($rtsig, $ok) = &_exist; - die "No POSIX::SigRt signal $_[1] (valid range SIGRTMIN..SIGRTMAX, or $SIGRTMIN..$SIGRTMAX)" - unless $ok; - return $rtsig; -} - -sub new { - my ($rtsig, $handler, $flags) = @_; - my $sigset = POSIX::SigSet->new($rtsig); - my $sigact = POSIX::SigAction->new($handler, - $sigset, - $flags); - sigaction($rtsig, $sigact); -} - -sub EXISTS { &_exist } -sub FETCH { my $rtsig = &_check; - my $oa = POSIX::SigAction->new(); - sigaction($rtsig, undef, $oa); - return $oa->{HANDLER} } -sub STORE { my $rtsig = &_check; new($rtsig, $_[2], $SIGACTION_FLAGS) } -sub DELETE { delete $SIG{ &_check } } -sub CLEAR { &_exist; delete @SIG{ SIGRTMIN .. SIGRTMAX } } -sub SCALAR { &_croak; $sigrtn + 1 } - tie %POSIX::SIGRT, 'POSIX::SigRt'; +sub DESTROY {}; + package POSIX; 1; @@ -413,7 +372,7 @@ sub puts { sub remove { usage "remove(filename)" if @_ != 1; - CORE::unlink($_[0]); + (-d $_[0]) ? CORE::rmdir($_[0]) : CORE::unlink($_[0]); } sub rename { @@ -955,8 +914,13 @@ sub load_imports { ); # Exporter::export_tags(); -for (values %EXPORT_TAGS) { - push @EXPORT, @$_; +{ + # De-duplicate the export list: + my %export; + @export{map {@$_} values %EXPORT_TAGS} = (); + # Doing the de-dup with a temporary hash has the advantage that the SVs in + # @EXPORT are actually shared hash key sacalars, which will save some memory. + push @EXPORT, keys %export; } @EXPORT_OK = qw( @@ -1023,8 +987,63 @@ require Exporter; package POSIX::SigAction; +sub new { bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3] || 0, SAFE => 0}, $_[0] } sub handler { $_[0]->{HANDLER} = $_[1] if @_ > 1; $_[0]->{HANDLER} }; sub mask { $_[0]->{MASK} = $_[1] if @_ > 1; $_[0]->{MASK} }; sub flags { $_[0]->{FLAGS} = $_[1] if @_ > 1; $_[0]->{FLAGS} }; sub safe { $_[0]->{SAFE} = $_[1] if @_ > 1; $_[0]->{SAFE} }; +package POSIX::SigRt; + + +sub _init { + $_SIGRTMIN = &POSIX::SIGRTMIN; + $_SIGRTMAX = &POSIX::SIGRTMAX; + $_sigrtn = $_SIGRTMAX - $_SIGRTMIN; +} + +sub _croak { + &_init unless defined $_sigrtn; + die "POSIX::SigRt not available" unless defined $_sigrtn && $_sigrtn > 0; +} + +sub _getsig { + &_croak; + my $rtsig = $_[0]; + # Allow (SIGRT)?MIN( + n)?, a common idiom when doing these things in C. + $rtsig = $_SIGRTMIN + ($1 || 0) + if $rtsig =~ /^(?:(?:SIG)?RT)?MIN(\s*\+\s*(\d+))?$/; + return $rtsig; +} + +sub _exist { + my $rtsig = _getsig($_[1]); + my $ok = $rtsig >= $_SIGRTMIN && $rtsig <= $_SIGRTMAX; + ($rtsig, $ok); +} + +sub _check { + my ($rtsig, $ok) = &_exist; + die "No POSIX::SigRt signal $_[1] (valid range SIGRTMIN..SIGRTMAX, or $_SIGRTMIN..$_SIGRTMAX)" + unless $ok; + return $rtsig; +} + +sub new { + my ($rtsig, $handler, $flags) = @_; + my $sigset = POSIX::SigSet->new($rtsig); + my $sigact = POSIX::SigAction->new($handler, + $sigset, + $flags); + POSIX::sigaction($rtsig, $sigact); +} + +sub EXISTS { &_exist } +sub FETCH { my $rtsig = &_check; + my $oa = POSIX::SigAction->new(); + POSIX::sigaction($rtsig, undef, $oa); + return $oa->{HANDLER} } +sub STORE { my $rtsig = &_check; new($rtsig, $_[2], $SIGACTION_FLAGS) } +sub DELETE { delete $SIG{ &_check } } +sub CLEAR { &_exist; delete @SIG{ &POSIX::SIGRTMIN .. &POSIX::SIGRTMAX } } +sub SCALAR { &_croak; $_sigrtn + 1 }