+
# IO::Poll.pm
#
# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
our(@ISA, @EXPORT_OK, @EXPORT, $VERSION);
@ISA = qw(Exporter);
-$VERSION = "0.01";
+$VERSION = "0.05";
-@EXPORT = qw(poll);
+@EXPORT = qw( POLLIN
+ POLLOUT
+ POLLERR
+ POLLHUP
+ POLLNVAL
+ );
@EXPORT_OK = qw(
- POLLIN
POLLPRI
- POLLOUT
POLLRDNORM
POLLWRNORM
POLLRDBAND
POLLWRBAND
POLLNORM
- POLLERR
- POLLHUP
- POLLNVAL
-);
+ );
+# [0] maps fd's to requested masks
+# [1] maps fd's to returned masks
+# [2] maps fd's to handles
sub new {
my $class = shift;
- my $self = bless [{},{}], $class;
+ my $self = bless [{},{},{}], $class;
$self;
}
my $self = shift;
my $io = shift;
my $fd = fileno($io);
- if(@_) {
+ if (@_) {
my $mask = shift;
- $self->[0]{$fd} ||= {};
if($mask) {
- $self->[0]{$fd}{$io} = $mask;
- }
- else {
+ $self->[0]{$fd}{$io} = $mask; # the error events are always returned
+ $self->[1]{$fd} = 0; # output mask
+ $self->[2]{$io} = $io; # remember handle
+ } else {
delete $self->[0]{$fd}{$io};
+ delete $self->[1]{$fd} unless %{$self->[0]{$fd}};
+ delete $self->[2]{$io};
}
}
- elsif(exists $self->[0]{$fd}{$io}) {
+
+ return unless exists $self->[0]{$fd} and exists $self->[0]{$fd}{$io};
return $self->[0]{$fd}{$io};
- }
- return;
}
$self->[1] = {};
- my($fd,$ref);
+ my($fd,$mask,$iom);
my @poll = ();
- while(($fd,$ref) = each %{$self->[0]}) {
- my $events = 0;
- map { $events |= $_ } values %{$ref};
- push(@poll,$fd, $events);
+ while(($fd,$iom) = each %{$self->[0]}) {
+ $mask = 0;
+ $mask |= $_ for values(%$iom);
+ push(@poll,$fd => $mask);
}
my $ret = @poll ? _poll(defined($timeout) ? $timeout * 1000 : -1,@poll) : 0;
while(@poll) {
my($fd,$got) = splice(@poll,0,2);
- $self->[1]{$fd} = $got
- if $got;
+ $self->[1]{$fd} = $got if $got;
}
return $ret;
my $self = shift;
my $io = shift;
my $fd = fileno($io);
-
- exists $self->[1]{$fd} && exists $self->[0]{$fd}{$io}
- ? $self->[1]{$fd} & $self->[0]{$fd}{$io}
+ exists $self->[1]{$fd} and exists $self->[0]{$fd}{$io}
+ ? $self->[1]{$fd} & ($self->[0]{$fd}{$io}|POLLHUP|POLLERR|POLLNVAL)
: 0;
}
sub handles {
my $self = shift;
-
- return map { keys %$_ } values %{$self->[0]}
- unless(@_);
+ return values %{$self->[2]} unless @_;
my $events = shift || 0;
my($fd,$ev,$io,$mask);
my @handles = ();
while(($fd,$ev) = each %{$self->[1]}) {
- if($ev & $events) {
- while(($io,$mask) = each %{$self->[0][$fd]}) {
- push(@handles, $io)
- if $events & $mask;
- }
+ while (($io,$mask) = each %{$self->[0]{$fd}}) {
+ $mask |= POLLHUP|POLLERR|POLLNVAL; # must allow these
+ push @handles,$self->[2]{$io} if ($ev & $mask) & $events;
}
}
return @handles;
$poll = new IO::Poll;
- $poll->mask($input_handle => POLLRDNORM | POLLIN | POLLHUP);
- $poll->mask($output_handle => POLLWRNORM);
+ $poll->mask($input_handle => POLLIN);
+ $poll->mask($output_handle => POLLOUT);
$poll->poll($timeout);
mkpath("$installarchlib/CORE", 1, 0777);
my @corefiles;
if ($Is_VMS) { # We did core file selection during build
- my $coredir = "lib/$Config{'arch'}/$ver";
+ my $coredir = "lib/$Config{archname}/$ver/CORE";
$coredir =~ tr/./_/;
- @corefiles = map { s|^$coredir/||i; } <$coredir/*.*>;
+ map { s|^$coredir/||i; } @corefiles = <$coredir/*.*>;
}
else {
# [als] hard-coded 'libperl' name... not good!
Prior versions used to run BEGIN B<and> END blocks when Perl was
run in compile-only mode. Since this is typically not the expected
behavior, END blocks are not executed anymore when the C<-c> switch
-is used.
+is used, or if compilation fails.
See L<CHECK blocks> for how to run things when the compile phase ends.
C<d_pwchange>, C<d_pwcomment>, and C<d_pwexpire>. Shadow password
files are only supported if your vendor has implemented them in the
intuitive fashion that calling the regular C library routines gets the
-shadow versions if you're running under privilege. Those that
-incorrectly implement a separate library call are not supported.
+shadow versions if you're running under privilege or if there exists
+the shadow(3) functions as found in System V ( this includes Solaris
+and Linux.) Those systems which implement a proprietary shadow password
+facility are unlikely to be supported.
The $members value returned by I<getgr*()> is a space separated list of
the login names of the members of the group.
(if you can).) You may have multiple C<END> blocks within a file--they
will execute in reverse order of definition; that is: last in, first
out (LIFO). C<END> blocks are not executed when you run perl with the
-C<-c> switch.
+C<-c> switch, or if compilation fails.
Inside an C<END> subroutine, C<$?> contains the value that the program is
going to pass to C<exit()>. You can modify C<$?> to change the exit
select(STDERR); $| = 1;
select(STDOUT); $| = 1;
-print "1..8\n";
+print "1..9\n";
use IO::Handle;
use IO::Poll qw(/POLL/);
print "not "
if $poll->events($stdout);
print "ok 8\n";
+
+$poll->remove($dupout);
+print "not "
+ if $poll->handles;
+print "ok 9\n";
# don't add if superuser
if ($< && $>) { # don't be looking too hard now!
- eval q{ use blib; 1 } or die;
+ eval q{ use blib; 1 };
+ warn $@ if $@ && $opt_v;
}
}
=head1 VERSION
-This is perldoc v2.01.
+This is perldoc v2.03.
=head1 AUTHOR
=cut
#
+# Version 2.03: Sun Apr 23 16:56:34 BST 2000
+# Hugo van der Sanden <hv@crypt0.demon.co.uk>
+# don't die when 'use blib' fails
# Version 2.02: Mon Mar 13 18:03:04 MST 2000
# Tom Christiansen <tchrist@perl.com>
# Added -U insecurity option
$ WC "libc='" + perl_libc + "'"
$ WC "xs_apiversion='" + version + "'"
$ WC "pm_apiversion='" + version + "'"
+$ WC "version='" + version + "'"
+$ WC "revision='" + revision + "'"
+$ WC "patchlevel='" + patchlevel + "'"
+$ WC "subversion='" + subversion + "'"
$ WC "PERL_VERSION='" + patchlevel + "'"
$ WC "PERL_SUBVERSION='" + subversion + "'"
$ WC "pager='" + perl_pager + "'"
projects / p5sagit/p5-mst-13.2.git / commitdiff