| Filename | /Users/ether/perl5/perlbrew/perls/36.0/lib/5.36.0/darwin-2level/IO/Poll.pm |
| Statements | Executed 11 statements in 388µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 19µs | 21µs | IO::Poll::BEGIN@10 |
| 1 | 1 | 1 | 3µs | 12µs | IO::Poll::BEGIN@11 |
| 1 | 1 | 1 | 2µs | 2µs | IO::Poll::BEGIN@12 |
| 0 | 0 | 0 | 0s | 0s | IO::Poll::events |
| 0 | 0 | 0 | 0s | 0s | IO::Poll::handles |
| 0 | 0 | 0 | 0s | 0s | IO::Poll::mask |
| 0 | 0 | 0 | 0s | 0s | IO::Poll::new |
| 0 | 0 | 0 | 0s | 0s | IO::Poll::poll |
| 0 | 0 | 0 | 0s | 0s | IO::Poll::remove |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | |||||
| 2 | # IO::Poll.pm | ||||
| 3 | # | ||||
| 4 | # Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved. | ||||
| 5 | # This program is free software; you can redistribute it and/or | ||||
| 6 | # modify it under the same terms as Perl itself. | ||||
| 7 | |||||
| 8 | package IO::Poll; | ||||
| 9 | |||||
| 10 | 2 | 19µs | 2 | 23µs | # spent 21µs (19+2) within IO::Poll::BEGIN@10 which was called:
# once (19µs+2µs) by Mojo::Util::BEGIN@13.4 at line 10 # spent 21µs making 1 call to IO::Poll::BEGIN@10
# spent 2µs making 1 call to strict::import |
| 11 | 2 | 12µs | 2 | 21µs | # spent 12µs (3+9) within IO::Poll::BEGIN@11 which was called:
# once (3µs+9µs) by Mojo::Util::BEGIN@13.4 at line 11 # spent 12µs making 1 call to IO::Poll::BEGIN@11
# spent 9µs making 1 call to Exporter::import |
| 12 | 2 | 347µs | 1 | 2µs | # spent 2µs within IO::Poll::BEGIN@12 which was called:
# once (2µs+0s) by Mojo::Util::BEGIN@13.4 at line 12 # spent 2µs making 1 call to IO::Poll::BEGIN@12 |
| 13 | |||||
| 14 | 1 | 5µs | our @ISA = qw(Exporter); | ||
| 15 | 1 | 0s | our $VERSION = "1.49"; | ||
| 16 | |||||
| 17 | 1 | 1µs | our @EXPORT = qw( POLLIN | ||
| 18 | POLLOUT | ||||
| 19 | POLLERR | ||||
| 20 | POLLHUP | ||||
| 21 | POLLNVAL | ||||
| 22 | ); | ||||
| 23 | |||||
| 24 | 1 | 0s | our @EXPORT_OK = qw( | ||
| 25 | POLLPRI | ||||
| 26 | POLLRDNORM | ||||
| 27 | POLLWRNORM | ||||
| 28 | POLLRDBAND | ||||
| 29 | POLLWRBAND | ||||
| 30 | POLLNORM | ||||
| 31 | ); | ||||
| 32 | |||||
| 33 | # [0] maps fd's to requested masks | ||||
| 34 | # [1] maps fd's to returned masks | ||||
| 35 | # [2] maps fd's to handles | ||||
| 36 | sub new { | ||||
| 37 | my $class = shift; | ||||
| 38 | |||||
| 39 | my $self = bless [{},{},{}], $class; | ||||
| 40 | |||||
| 41 | $self; | ||||
| 42 | } | ||||
| 43 | |||||
| 44 | sub mask { | ||||
| 45 | my $self = shift; | ||||
| 46 | my $io = shift; | ||||
| 47 | my $fd = fileno($io); | ||||
| 48 | return unless defined $fd; | ||||
| 49 | if (@_) { | ||||
| 50 | my $mask = shift; | ||||
| 51 | if($mask) { | ||||
| 52 | $self->[0]{$fd}{$io} = $mask; # the error events are always returned | ||||
| 53 | $self->[1]{$fd} = 0; # output mask | ||||
| 54 | $self->[2]{$io} = $io; # remember handle | ||||
| 55 | } else { | ||||
| 56 | delete $self->[0]{$fd}{$io}; | ||||
| 57 | unless(%{$self->[0]{$fd}}) { | ||||
| 58 | # We no longer have any handles for this FD | ||||
| 59 | delete $self->[1]{$fd}; | ||||
| 60 | delete $self->[0]{$fd}; | ||||
| 61 | } | ||||
| 62 | delete $self->[2]{$io}; | ||||
| 63 | } | ||||
| 64 | } | ||||
| 65 | |||||
| 66 | return unless exists $self->[0]{$fd} and exists $self->[0]{$fd}{$io}; | ||||
| 67 | return $self->[0]{$fd}{$io}; | ||||
| 68 | } | ||||
| 69 | |||||
| 70 | |||||
| 71 | sub poll { | ||||
| 72 | my($self,$timeout) = @_; | ||||
| 73 | |||||
| 74 | $self->[1] = {}; | ||||
| 75 | |||||
| 76 | my($fd,$mask,$iom); | ||||
| 77 | my @poll = (); | ||||
| 78 | |||||
| 79 | while(($fd,$iom) = each %{$self->[0]}) { | ||||
| 80 | $mask = 0; | ||||
| 81 | $mask |= $_ for values(%$iom); | ||||
| 82 | push(@poll,$fd => $mask); | ||||
| 83 | } | ||||
| 84 | |||||
| 85 | my $ret = _poll(defined($timeout) ? $timeout * 1000 : -1,@poll); | ||||
| 86 | |||||
| 87 | return $ret | ||||
| 88 | unless $ret > 0; | ||||
| 89 | |||||
| 90 | while(@poll) { | ||||
| 91 | my($fd,$got) = splice(@poll,0,2); | ||||
| 92 | $self->[1]{$fd} = $got if $got; | ||||
| 93 | } | ||||
| 94 | |||||
| 95 | return $ret; | ||||
| 96 | } | ||||
| 97 | |||||
| 98 | sub events { | ||||
| 99 | my $self = shift; | ||||
| 100 | my $io = shift; | ||||
| 101 | my $fd = fileno($io); | ||||
| 102 | exists $self->[1]{$fd} and exists $self->[0]{$fd}{$io} | ||||
| 103 | ? $self->[1]{$fd} & ($self->[0]{$fd}{$io}|POLLHUP|POLLERR|POLLNVAL) | ||||
| 104 | : 0; | ||||
| 105 | } | ||||
| 106 | |||||
| 107 | sub remove { | ||||
| 108 | my $self = shift; | ||||
| 109 | my $io = shift; | ||||
| 110 | $self->mask($io,0); | ||||
| 111 | } | ||||
| 112 | |||||
| 113 | sub handles { | ||||
| 114 | my $self = shift; | ||||
| 115 | return values %{$self->[2]} unless @_; | ||||
| 116 | |||||
| 117 | my $events = shift || 0; | ||||
| 118 | my($fd,$ev,$io,$mask); | ||||
| 119 | my @handles = (); | ||||
| 120 | |||||
| 121 | while(($fd,$ev) = each %{$self->[1]}) { | ||||
| 122 | while (($io,$mask) = each %{$self->[0]{$fd}}) { | ||||
| 123 | $mask |= POLLHUP|POLLERR|POLLNVAL; # must allow these | ||||
| 124 | push @handles,$self->[2]{$io} if ($ev & $mask) & $events; | ||||
| 125 | } | ||||
| 126 | } | ||||
| 127 | return @handles; | ||||
| 128 | } | ||||
| 129 | |||||
| 130 | 1 | 4µs | 1; | ||
| 131 | |||||
| 132 | __END__ |