diff options
| author | Paul "LeoNerd" Evans <leonerd@leonerd.org.uk> | 2021-01-04 11:25:32 +0000 |
|---|---|---|
| committer | Tony Cook <tony@develop-help.com> | 2021-01-04 21:46:42 +0000 |
| commit | 17d6745fa31cd682049fda05fac46d7ba49e14a6 (patch) | |
| tree | 241d97234bc18723c57d87d78770c76ebdd6a9c8 /dist/IO | |
| parent | b52b12abf8b9ae61054fee0e3b56abb68d86dea4 (diff) | |
| download | perl-17d6745fa31cd682049fda05fac46d7ba49e14a6.tar.gz | |
Have IO's socket code write errors also into $IO::Socket::errstr
Diffstat (limited to 'dist/IO')
| -rw-r--r-- | dist/IO/lib/IO/Socket.pm | 16 | ||||
| -rw-r--r-- | dist/IO/lib/IO/Socket/INET.pm | 8 |
2 files changed, 13 insertions, 11 deletions
diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm index ad8966dd22..0dc4f58efa 100644 --- a/dist/IO/lib/IO/Socket.pm +++ b/dist/IO/lib/IO/Socket.pm @@ -27,6 +27,8 @@ our $VERSION = "1.44"; our @EXPORT_OK = qw(sockatmark); +our $errstr; + sub import { my $pkg = shift; if (@_ && $_[0] eq 'sockatmark') { # not very extensible but for now, fast @@ -132,11 +134,11 @@ sub connect { # set we now emulate the behavior in Linux # - Karthik Rajagopalan $err = $sock->getsockopt(SOL_SOCKET,SO_ERROR); - $@ = "connect: $err"; + $errstr = $@ = "connect: $err"; } elsif(!@$w[0]) { $err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1); - $@ = "connect: timeout"; + $errstr = $@ = "connect: timeout"; } elsif (!connect($sock,$addr) && not ($!{EISCONN} || ($^O eq 'MSWin32' && @@ -147,12 +149,12 @@ sub connect { # Windows sets errno to WSAEINVAL (10022) (pre-5.19.4) or # EINVAL (22) (5.19.4 onwards). $err = $!; - $@ = "connect: $!"; + $errstr = $@ = "connect: $!"; } } elsif ($blocking || !($!{EINPROGRESS} || $!{EWOULDBLOCK})) { $err = $!; - $@ = "connect: $!"; + $errstr = $@ = "connect: $!"; } } @@ -246,7 +248,7 @@ sub accept { my $sel = IO::Select->new( $sock ); unless ($sel->can_read($timeout)) { - $@ = 'accept: timeout'; + $errstr = $@ = 'accept: timeout'; $! = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1); return; } @@ -832,7 +834,7 @@ Let's create a TCP server on C<localhost:3333>. LocalPort => 3333, ReusePort => 1, Listen => 5, - ) || die "Can't open socket: $@"; + ) || die "Can't open socket: $IO::Socket::errstr"; say "Waiting on 3333"; while (1) { @@ -873,7 +875,7 @@ A client for such a server could be proto => 'tcp', PeerPort => 3333, PeerHost => '0.0.0.0', - ) || die "Can't open socket: $@"; + ) || die "Can't open socket: $IO::Socket::errstr"; say "Sending Hello World!"; my $size = $client->send("Hello World!"); diff --git a/dist/IO/lib/IO/Socket/INET.pm b/dist/IO/lib/IO/Socket/INET.pm index 8688f375b5..5f21d0d741 100644 --- a/dist/IO/lib/IO/Socket/INET.pm +++ b/dist/IO/lib/IO/Socket/INET.pm @@ -79,7 +79,7 @@ sub _sock_info { if(defined $proto && $proto =~ /\D/) { my $num = _get_proto_number($proto); unless (defined $num) { - $@ = "Bad protocol '$proto'"; + $IO::Socket::errstr = $@ = "Bad protocol '$proto'"; return; } $proto = $num; @@ -94,7 +94,7 @@ sub _sock_info { $port = $serv[2] || $defport || $pnum; unless (defined $port) { - $@ = "Bad service '$origport'"; + $IO::Socket::errstr = $@ = "Bad service '$origport'"; return; } @@ -113,7 +113,7 @@ sub _error { { local($!); my $title = ref($sock).": "; - $@ = join("", $_[0] =~ /^$title/ ? "" : $title, @_); + $IO::Socket::errstr = $@ = join("", $_[0] =~ /^$title/ ? "" : $title, @_); $sock->close() if(defined fileno($sock)); } @@ -404,7 +404,7 @@ Examples: Proto => udp, LocalAddr => 'localhost', Broadcast => 1 ) - or die "Can't bind : $@\n"; + or die "Can't bind : $IO::Socket::errstr\n"; B<NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE> |