← Index
NYTProf Performance Profile   « block view • line view • sub view »
For ddd2.pl
  Run on Tue May 25 16:52:24 2010
Reported on Tue May 25 16:57:01 2010

File /usr/local/lib/perl5/5.8.8/i686-linux/IO/Socket.pm
Statements Executed 16636
Statement Execution Time 308ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
46111101ms48.2sIO::Socket::::connectIO::Socket::connect
4611148.4ms49.5sIO::Socket::::newIO::Socket::new
13832142.3ms57.6msIO::Socket::::peernameIO::Socket::peername
4611128.6ms49.2msIO::Socket::::socketIO::Socket::socket
9222228.1ms28.1msIO::Socket::::CORE:connectIO::Socket::CORE:connect (opcode)
4611220.6ms20.6msIO::Socket::::CORE:socketIO::Socket::CORE:socket (opcode)
13831215.3ms15.3msIO::Socket::::CORE:getpeernameIO::Socket::CORE:getpeername (opcode)
222129µs9.62msIO::Socket::::importIO::Socket::import
22244µs44µsIO::Socket::::register_domainIO::Socket::register_domain
1129µs9µsIO::Socket::::CORE:packIO::Socket::CORE:pack (opcode)
0000s0sIO::Socket::::BEGINIO::Socket::BEGIN
0000s0sIO::Socket::::acceptIO::Socket::accept
0000s0sIO::Socket::::atmarkIO::Socket::atmark
0000s0sIO::Socket::::bindIO::Socket::bind
0000s0sIO::Socket::::configureIO::Socket::configure
0000s0sIO::Socket::::connectedIO::Socket::connected
0000s0sIO::Socket::::getsockoptIO::Socket::getsockopt
0000s0sIO::Socket::::listenIO::Socket::listen
0000s0sIO::Socket::::protocolIO::Socket::protocol
0000s0sIO::Socket::::recvIO::Socket::recv
0000s0sIO::Socket::::sendIO::Socket::send
0000s0sIO::Socket::::setsockoptIO::Socket::setsockopt
0000s0sIO::Socket::::shutdownIO::Socket::shutdown
0000s0sIO::Socket::::sockdomainIO::Socket::sockdomain
0000s0sIO::Socket::::socketpairIO::Socket::socketpair
0000s0sIO::Socket::::socknameIO::Socket::sockname
0000s0sIO::Socket::::sockoptIO::Socket::sockopt
0000s0sIO::Socket::::socktypeIO::Socket::socktype
0000s0sIO::Socket::::timeoutIO::Socket::timeout
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# IO::Socket.pm
2#
3# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
4# This program is free software; you can redistribute it and/or
5# modify it under the same terms as Perl itself.
6
7package IO::Socket;
8
915µsrequire 5.006;
10
113110µs1159µsuse IO::Handle;
# spent 159µs making 1 call to Exporter::import
123773µs25.55msuse Socket 1.3;
# spent 5.33ms making 1 call to Exporter::import # spent 222µs making 1 call to UNIVERSAL::VERSION
13397µs1243µsuse Carp;
# spent 243µs making 1 call to Exporter::import
143125µs121µsuse strict;
# spent 21µs making 1 call to strict::import
1515µsour(@ISA, $VERSION, @EXPORT_OK);
163103µs1142µsuse Exporter;
# spent 142µs making 1 call to Exporter::import
1733.56ms1136µsuse Errno;
# spent 136µs making 1 call to Exporter::import
18
19# legacy
20
2116µsrequire IO::Socket::INET;
221244µsrequire IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian');
23
2418µs@ISA = qw(IO::Handle);
25
2615µs$VERSION = "1.29";
27
2815µs@EXPORT_OK = qw(sockatmark);
29
30
# spent 9.62ms (129µs+9.49) within IO::Socket::import which was called 2 times, avg 4.81ms/call: # once (71µs+4.83ms) by LWP::Protocol::implementor at line 11 of IO/Socket/UNIX.pm # once (58µs+4.66ms) by LWP::Protocol::implementor at line 11 of IO/Socket/INET.pm
sub import {
31212µs my $pkg = shift;
32246µs if (@_ && $_[0] eq 'sockatmark') { # not very extensible but for now, fast
33 Exporter::export_to_level('IO::Socket', 1, $pkg, 'sockatmark');
34 } else {
35212µs my $callpkg = caller;
36234µs2195µs Exporter::export 'Socket', $callpkg, @_;
# spent 195µs making 2 calls to Exporter::export, avg 98µs/call
37 }
38}
39
40
# spent 49.5s (48.4ms+49.5) within IO::Socket::new which was called 461 times, avg 107ms/call: # 461 times (48.4ms+49.5s) by IO::Socket::INET::new at line 32 of IO/Socket/INET.pm, avg 107ms/call
sub new {
414618.37ms my($class,%arg) = @_;
4246110.4ms46140.8ms my $sock = $class->SUPER::new();
# spent 40.8ms making 461 calls to IO::Handle::new, avg 89µs/call
43
4446115.2ms461116ms $sock->autoflush(1);
# spent 116ms making 461 calls to IO::Handle::autoflush, avg 252µs/call
45
464615.06ms ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
47
4846115.7ms46149.3s return scalar(%arg) ? $sock->configure(\%arg)
# spent 49.3s making 461 calls to Net::HTTP::configure, avg 107ms/call
49 : $sock;
50}
51
5214µsmy @domain2pkg;
53
54
# spent 44µs within IO::Socket::register_domain which was called 2 times, avg 22µs/call: # once (22µs+0s) by LWP::Protocol::implementor at line 22 of IO/Socket/INET.pm # once (22µs+0s) by LWP::Protocol::implementor at line 19 of IO/Socket/UNIX.pm
sub register_domain {
55215µs my($p,$d) = @_;
56240µs $domain2pkg[$d] = $p;
57}
58
59sub configure {
60 my($sock,$arg) = @_;
61 my $domain = delete $arg->{Domain};
62
63 croak 'IO::Socket: Cannot configure a generic socket'
64 unless defined $domain;
65
66 croak "IO::Socket: Unsupported socket domain"
67 unless defined $domain2pkg[$domain];
68
69 croak "IO::Socket: Cannot configure socket in domain '$domain'"
70 unless ref($sock) eq "IO::Socket";
71
72 bless($sock, $domain2pkg[$domain]);
73 $sock->configure($arg);
74}
75
76
# spent 49.2ms (28.6+20.6) within IO::Socket::socket which was called 461 times, avg 107µs/call: # 461 times (28.6ms+20.6ms) by IO::Socket::INET::configure at line 147 of IO/Socket/INET.pm, avg 107µs/call
sub socket {
774612.76ms @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)';
784613.07ms my($sock,$domain,$type,$protocol) = @_;
79
8046128.0ms46120.6ms socket($sock,$domain,$type,$protocol) or
# spent 20.6ms making 461 calls to IO::Socket::CORE:socket, avg 45µs/call
81 return undef;
82
834613.72ms ${*$sock}{'io_socket_domain'} = $domain;
844612.23ms ${*$sock}{'io_socket_type'} = $type;
854612.79ms ${*$sock}{'io_socket_proto'} = $protocol;
86
874616.87ms $sock;
88}
89
90sub socketpair {
91 @_ == 4 || croak 'usage: IO::Socket->socketpair(DOMAIN, TYPE, PROTOCOL)';
92 my($class,$domain,$type,$protocol) = @_;
93 my $sock1 = $class->new();
94 my $sock2 = $class->new();
95
96 socketpair($sock1,$sock2,$domain,$type,$protocol) or
97 return ();
98
99 ${*$sock1}{'io_socket_type'} = ${*$sock2}{'io_socket_type'} = $type;
100 ${*$sock1}{'io_socket_proto'} = ${*$sock2}{'io_socket_proto'} = $protocol;
101
102 ($sock1,$sock2);
103}
104
105
# spent 48.2s (101ms+48.1) within IO::Socket::connect which was called 461 times, avg 104ms/call: # 461 times (101ms+48.1s) by IO::Socket::INET::connect at line 224 of IO/Socket/INET.pm, avg 104ms/call
sub connect {
1064612.33ms @_ == 2 or croak 'usage: $sock->connect(NAME)';
1074612.32ms my $sock = shift;
1084612.46ms my $addr = shift;
1094612.62ms my $timeout = ${*$sock}{'io_socket_timeout'};
1104611.98ms my $err;
1114611.93ms my $blocking;
112
11346113.6ms4615.85ms $blocking = $sock->blocking(0) if $timeout;
# spent 5.85ms making 461 calls to IO::Handle::blocking, avg 13µs/call
11446133.4ms46122.3ms if (!connect($sock, $addr)) {
# spent 22.3ms making 461 calls to IO::Socket::CORE:connect, avg 48µs/call
11546119.6ms46140.5ms if (defined $timeout && $!{EINPROGRESS}) {
# spent 40.5ms making 461 calls to Errno::FETCH, avg 88µs/call
1164613.48ms require IO::Select;
117
11846111.8ms461133ms my $sel = new IO::Select $sock;
# spent 133ms making 461 calls to IO::Select::new, avg 289µs/call
119
12046120.8ms92247.8s if (!$sel->can_write($timeout)) {
# spent 47.8s making 461 calls to IO::Select::can_write, avg 104ms/call # spent 5.74ms making 461 calls to IO::Socket::CORE:connect, avg 12µs/call
121 $err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
122 $@ = "connect: timeout";
123 }
124 elsif (!connect($sock,$addr) && not $!{EISCONN}) {
125 # Some systems refuse to re-connect() to
126 # an already open socket and set errno to EISCONN.
127 $err = $!;
128 $@ = "connect: $!";
129 }
130 }
131 elsif ($blocking || !$!{EINPROGRESS}) {
132 $err = $!;
133 $@ = "connect: $!";
134 }
135 }
136
13746113.7ms4616.02ms $sock->blocking(1) if $blocking;
# spent 6.02ms making 461 calls to IO::Handle::blocking, avg 13µs/call
138
1394612.17ms $! = $err if $err;
140
1414616.68ms $err ? undef : $sock;
142}
143
144sub bind {
145 @_ == 2 or croak 'usage: $sock->bind(NAME)';
146 my $sock = shift;
147 my $addr = shift;
148
149 return bind($sock, $addr) ? $sock
150 : undef;
151}
152
153sub listen {
154 @_ >= 1 && @_ <= 2 or croak 'usage: $sock->listen([QUEUE])';
155 my($sock,$queue) = @_;
156 $queue = 5
157 unless $queue && $queue > 0;
158
159 return listen($sock, $queue) ? $sock
160 : undef;
161}
162
163sub accept {
164 @_ == 1 || @_ == 2 or croak 'usage $sock->accept([PKG])';
165 my $sock = shift;
166 my $pkg = shift || $sock;
167 my $timeout = ${*$sock}{'io_socket_timeout'};
168 my $new = $pkg->new(Timeout => $timeout);
169 my $peer = undef;
170
171 if(defined $timeout) {
172 require IO::Select;
173
174 my $sel = new IO::Select $sock;
175
176 unless ($sel->can_read($timeout)) {
177 $@ = 'accept: timeout';
178 $! = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
179 return;
180 }
181 }
182
183 $peer = accept($new,$sock)
184 or return;
185
186 return wantarray ? ($new, $peer)
187 : $new;
188}
189
190sub sockname {
191 @_ == 1 or croak 'usage: $sock->sockname()';
192 getsockname($_[0]);
193}
194
195
# spent 57.6ms (42.3+15.3) within IO::Socket::peername which was called 1383 times, avg 42µs/call: # 922 times (27.7ms+8.52ms) by IO::Socket::INET::peerport at line 265 of IO/Socket/INET.pm, avg 39µs/call # 461 times (14.6ms+6.79ms) by IO::Socket::INET::peeraddr at line 258 of IO/Socket/INET.pm, avg 46µs/call
sub peername {
19613836.34ms @_ == 1 or croak 'usage: $sock->peername()';
19713836.44ms my($sock) = @_;
198 getpeername($sock)
199138346.7ms138315.3ms || ${*$sock}{'io_socket_peername'}
# spent 15.3ms making 1383 calls to IO::Socket::CORE:getpeername, avg 11µs/call
200 || undef;
201}
202
203sub connected {
204 @_ == 1 or croak 'usage: $sock->connected()';
205 my($sock) = @_;
206 getpeername($sock);
207}
208
209sub send {
210 @_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])';
211 my $sock = $_[0];
212 my $flags = $_[2] || 0;
213 my $peer = $_[3] || $sock->peername;
214
215 croak 'send: Cannot determine peer address'
216 unless($peer);
217
218 my $r = defined(getpeername($sock))
219 ? send($sock, $_[1], $flags)
220 : send($sock, $_[1], $flags, $peer);
221
222 # remember who we send to, if it was successful
223 ${*$sock}{'io_socket_peername'} = $peer
224 if(@_ == 4 && defined $r);
225
226 $r;
227}
228
229sub recv {
230 @_ == 3 || @_ == 4 or croak 'usage: $sock->recv(BUF, LEN [, FLAGS])';
231 my $sock = $_[0];
232 my $len = $_[2];
233 my $flags = $_[3] || 0;
234
235 # remember who we recv'd from
236 ${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags);
237}
238
239sub shutdown {
240 @_ == 2 or croak 'usage: $sock->shutdown(HOW)';
241 my($sock, $how) = @_;
242 shutdown($sock, $how);
243}
244
245sub setsockopt {
246 @_ == 4 or croak '$sock->setsockopt(LEVEL, OPTNAME)';
247 setsockopt($_[0],$_[1],$_[2],$_[3]);
248}
249
250132µs19µsmy $intsize = length(pack("i",0));
# spent 9µs making 1 call to IO::Socket::CORE:pack
251
252sub getsockopt {
253 @_ == 3 or croak '$sock->getsockopt(LEVEL, OPTNAME)';
254 my $r = getsockopt($_[0],$_[1],$_[2]);
255 # Just a guess
256 $r = unpack("i", $r)
257 if(defined $r && length($r) == $intsize);
258 $r;
259}
260
261sub sockopt {
262 my $sock = shift;
263 @_ == 1 ? $sock->getsockopt(SOL_SOCKET,@_)
264 : $sock->setsockopt(SOL_SOCKET,@_);
265}
266
267sub atmark {
268 @_ == 1 or croak 'usage: $sock->atmark()';
269 my($sock) = @_;
270 sockatmark($sock);
271}
272
273sub timeout {
274 @_ == 1 || @_ == 2 or croak 'usage: $sock->timeout([VALUE])';
275 my($sock,$val) = @_;
276 my $r = ${*$sock}{'io_socket_timeout'};
277
278 ${*$sock}{'io_socket_timeout'} = defined $val ? 0 + $val : $val
279 if(@_ == 2);
280
281 $r;
282}
283
284sub sockdomain {
285 @_ == 1 or croak 'usage: $sock->sockdomain()';
286 my $sock = shift;
287 ${*$sock}{'io_socket_domain'};
288}
289
290sub socktype {
291 @_ == 1 or croak 'usage: $sock->socktype()';
292 my $sock = shift;
293 ${*$sock}{'io_socket_type'}
294}
295
296sub protocol {
297 @_ == 1 or croak 'usage: $sock->protocol()';
298 my($sock) = @_;
299 ${*$sock}{'io_socket_proto'};
300}
301
302120µs1;
303
304__END__
305
306=head1 NAME
307
308IO::Socket - Object interface to socket communications
309
310=head1 SYNOPSIS
311
312 use IO::Socket;
313
314=head1 DESCRIPTION
315
316C<IO::Socket> provides an object interface to creating and using sockets. It
317is built upon the L<IO::Handle> interface and inherits all the methods defined
318by L<IO::Handle>.
319
320C<IO::Socket> only defines methods for those operations which are common to all
321types of socket. Operations which are specified to a socket in a particular
322domain have methods defined in sub classes of C<IO::Socket>
323
324C<IO::Socket> will export all functions (and constants) defined by L<Socket>.
325
326=head1 CONSTRUCTOR
327
328=over 4
329
330=item new ( [ARGS] )
331
332Creates an C<IO::Socket>, which is a reference to a
333newly created symbol (see the C<Symbol> package). C<new>
334optionally takes arguments, these arguments are in key-value pairs.
335C<new> only looks for one key C<Domain> which tells new which domain
336the socket will be in. All other arguments will be passed to the
337configuration method of the package for that domain, See below.
338
339 NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
340
341As of VERSION 1.18 all IO::Socket objects have autoflush turned on
342by default. This was not the case with earlier releases.
343
344 NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
345
346=back
347
348=head1 METHODS
349
350See L<perlfunc> for complete descriptions of each of the following
351supported C<IO::Socket> methods, which are just front ends for the
352corresponding built-in functions:
353
354 socket
355 socketpair
356 bind
357 listen
358 accept
359 send
360 recv
361 peername (getpeername)
362 sockname (getsockname)
363 shutdown
364
365Some methods take slightly different arguments to those defined in L<perlfunc>
366in attempt to make the interface more flexible. These are
367
368=over 4
369
370=item accept([PKG])
371
372perform the system call C<accept> on the socket and return a new
373object. The new object will be created in the same class as the listen
374socket, unless C<PKG> is specified. This object can be used to
375communicate with the client that was trying to connect.
376
377In a scalar context the new socket is returned, or undef upon
378failure. In a list context a two-element array is returned containing
379the new socket and the peer address; the list will be empty upon
380failure.
381
382The timeout in the [PKG] can be specified as zero to effect a "poll",
383but you shouldn't do that because a new IO::Select object will be
384created behind the scenes just to do the single poll. This is
385horrendously inefficient. Use rather true select() with a zero
386timeout on the handle, or non-blocking IO.
387
388=item socketpair(DOMAIN, TYPE, PROTOCOL)
389
390Call C<socketpair> and return a list of two sockets created, or an
391empty list on failure.
392
393=back
394
395Additional methods that are provided are:
396
397=over 4
398
399=item atmark
400
401True if the socket is currently positioned at the urgent data mark,
402false otherwise.
403
404 use IO::Socket;
405
406 my $sock = IO::Socket::INET->new('some_server');
407 $sock->read($data, 1024) until $sock->atmark;
408
409Note: this is a reasonably new addition to the family of socket
410functions, so all systems may not support this yet. If it is
411unsupported by the system, an attempt to use this method will
412abort the program.
413
414The atmark() functionality is also exportable as sockatmark() function:
415
416 use IO::Socket 'sockatmark';
417
418This allows for a more traditional use of sockatmark() as a procedural
419socket function. If your system does not support sockatmark(), the
420C<use> declaration will fail at compile time.
421
422=item connected
423
424If the socket is in a connected state the peer address is returned.
425If the socket is not in a connected state then undef will be returned.
426
427=item protocol
428
429Returns the numerical number for the protocol being used on the socket, if
430known. If the protocol is unknown, as with an AF_UNIX socket, zero
431is returned.
432
433=item sockdomain
434
435Returns the numerical number for the socket domain type. For example, for
436an AF_INET socket the value of &AF_INET will be returned.
437
438=item sockopt(OPT [, VAL])
439
440Unified method to both set and get options in the SOL_SOCKET level. If called
441with one argument then getsockopt is called, otherwise setsockopt is called.
442
443=item socktype
444
445Returns the numerical number for the socket type. For example, for
446a SOCK_STREAM socket the value of &SOCK_STREAM will be returned.
447
448=item timeout([VAL])
449
450Set or get the timeout value associated with this socket. If called without
451any arguments then the current setting is returned. If called with an argument
452the current setting is changed and the previous value returned.
453
454=back
455
456=head1 SEE ALSO
457
458L<Socket>, L<IO::Handle>, L<IO::Socket::INET>, L<IO::Socket::UNIX>
459
460=head1 AUTHOR
461
462Graham Barr. atmark() by Lincoln Stein. Currently maintained by the
463Perl Porters. Please report all bugs to <perl5-porters@perl.org>.
464
465=head1 COPYRIGHT
466
467Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
468This program is free software; you can redistribute it and/or
469modify it under the same terms as Perl itself.
470
471The atmark() implementation: Copyright 2001, Lincoln Stein <lstein@cshl.org>.
472This module is distributed under the same terms as Perl itself.
473Feel free to use, modify and redistribute it as long as you retain
474the correct attribution.
475
476=cut
# spent 28.1ms within IO::Socket::CORE:connect which was called 922 times, avg 30µs/call: # 461 times (22.3ms+0s) by IO::Socket::connect at line 114 of IO/Socket.pm, avg 48µs/call # 461 times (5.74ms+0s) by IO::Socket::connect at line 120 of IO/Socket.pm, avg 12µs/call
sub IO::Socket::CORE:connect; # xsub
# spent 15.3ms within IO::Socket::CORE:getpeername which was called 1383 times, avg 11µs/call: # 1383 times (15.3ms+0s) by IO::Socket::peername at line 199 of IO/Socket.pm, avg 11µs/call
sub IO::Socket::CORE:getpeername; # xsub
# spent 9µs within IO::Socket::CORE:pack which was called # once (9µs+0s) by LWP::Protocol::implementor at line 250 of IO/Socket.pm
sub IO::Socket::CORE:pack; # xsub
# spent 20.6ms within IO::Socket::CORE:socket which was called 461 times, avg 45µs/call: # 461 times (20.6ms+0s) by IO::Socket::socket at line 80 of IO/Socket.pm, avg 45µs/call
sub IO::Socket::CORE:socket; # xsub
Report produced by the NYTProf 3.11 Perl profiler, developed by Tim Bunce and Adam Kaplan.