Profile of IO/Poll.pm

Filename	/Users/ether/perl5/perlbrew/perls/36.0/lib/5.36.0/darwin-2level/IO/Poll.pm
Statements	Executed 11 statements in 505µs

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	30µs	33µs	IO::Poll::::BEGIN@10IO::Poll::BEGIN@10
1	1	1	5µs	28µs	IO::Poll::::BEGIN@11IO::Poll::BEGIN@11
1	1	1	3µs	3µs	IO::Poll::::BEGIN@12IO::Poll::BEGIN@12
0	0	0	0s	0s	IO::Poll::::eventsIO::Poll::events
0	0	0	0s	0s	IO::Poll::::handlesIO::Poll::handles
0	0	0	0s	0s	IO::Poll::::maskIO::Poll::mask
0	0	0	0s	0s	IO::Poll::::newIO::Poll::new
0	0	0	0s	0s	IO::Poll::::pollIO::Poll::poll
0	0	0	0s	0s	IO::Poll::::removeIO::Poll::remove

Call graph for these subroutines as a Graphviz dot language file.

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	33µs	2	36µs	# spent 33µs (30+3) within IO::Poll::BEGIN@10 which was called: # once (30µs+3µs) by Mojo::Util::BEGIN@13.4 at line 10 use strict; # spent 33µs making 1 call to IO::Poll::BEGIN@10 # spent 3µs making 1 call to strict::import
11	2	23µs	2	51µs	# spent 28µs (5+23) within IO::Poll::BEGIN@11 which was called: # once (5µs+23µs) by Mojo::Util::BEGIN@13.4 at line 11 use IO::Handle; # spent 28µs making 1 call to IO::Poll::BEGIN@11 # spent 23µs making 1 call to Exporter::import
12	2	436µs	1	3µs	# spent 3µs within IO::Poll::BEGIN@12 which was called: # once (3µs+0s) by Mojo::Util::BEGIN@13.4 at line 12 use Exporter (); # spent 3µs making 1 call to IO::Poll::BEGIN@12
13
14	1	8µs			our @ISA = qw(Exporter);
15	1	0s			our $VERSION = "1.49";
16
17	1	0s			our @EXPORT = qw( POLLIN
18					POLLOUT
19					POLLERR
20					POLLHUP
21					POLLNVAL
22					);
23
24	1	1µs			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__