?????????? ????????? - ??????????????? - /home/agenciai/public_html/cd38d8/IO.tar
???????
Poll.pm 0000644 00000010634 15125156224 0006017 0 ustar 00 # IO::Poll.pm # # Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package IO::Poll; use strict; use IO::Handle; use Exporter (); our @ISA = qw(Exporter); our $VERSION = "1.41"; our @EXPORT = qw( POLLIN POLLOUT POLLERR POLLHUP POLLNVAL ); our @EXPORT_OK = qw( POLLPRI POLLRDNORM POLLWRNORM POLLRDBAND POLLWRBAND POLLNORM ); # [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; $self; } sub mask { my $self = shift; my $io = shift; my $fd = fileno($io); return unless defined $fd; if (@_) { my $mask = shift; if($mask) { $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}; unless(%{$self->[0]{$fd}}) { # We no longer have any handles for this FD delete $self->[1]{$fd}; delete $self->[0]{$fd}; } delete $self->[2]{$io}; } } return unless exists $self->[0]{$fd} and exists $self->[0]{$fd}{$io}; return $self->[0]{$fd}{$io}; } sub poll { my($self,$timeout) = @_; $self->[1] = {}; my($fd,$mask,$iom); my @poll = (); while(($fd,$iom) = each %{$self->[0]}) { $mask = 0; $mask |= $_ for values(%$iom); push(@poll,$fd => $mask); } my $ret = _poll(defined($timeout) ? $timeout * 1000 : -1,@poll); return $ret unless $ret > 0; while(@poll) { my($fd,$got) = splice(@poll,0,2); $self->[1]{$fd} = $got if $got; } return $ret; } sub events { my $self = shift; my $io = shift; my $fd = fileno($io); exists $self->[1]{$fd} and exists $self->[0]{$fd}{$io} ? $self->[1]{$fd} & ($self->[0]{$fd}{$io}|POLLHUP|POLLERR|POLLNVAL) : 0; } sub remove { my $self = shift; my $io = shift; $self->mask($io,0); } sub handles { my $self = shift; return values %{$self->[2]} unless @_; my $events = shift || 0; my($fd,$ev,$io,$mask); my @handles = (); while(($fd,$ev) = each %{$self->[1]}) { 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; } 1; __END__ =head1 NAME IO::Poll - Object interface to system poll call =head1 SYNOPSIS use IO::Poll qw(POLLRDNORM POLLWRNORM POLLIN POLLHUP); $poll = IO::Poll->new(); $poll->mask($input_handle => POLLIN); $poll->mask($output_handle => POLLOUT); $poll->poll($timeout); $ev = $poll->events($input); =head1 DESCRIPTION C<IO::Poll> is a simple interface to the system level poll routine. =head1 METHODS =over 4 =item mask ( IO [, EVENT_MASK ] ) If EVENT_MASK is given, then, if EVENT_MASK is non-zero, IO is added to the list of file descriptors and the next call to poll will check for any event specified in EVENT_MASK. If EVENT_MASK is zero then IO will be removed from the list of file descriptors. If EVENT_MASK is not given then the return value will be the current event mask value for IO. =item poll ( [ TIMEOUT ] ) Call the system level poll routine. If TIMEOUT is not specified then the call will block. Returns the number of handles which had events happen, or -1 on error. =item events ( IO ) Returns the event mask which represents the events that happened on IO during the last call to C<poll>. =item remove ( IO ) Remove IO from the list of file descriptors for the next poll. =item handles( [ EVENT_MASK ] ) Returns a list of handles. If EVENT_MASK is not given then a list of all handles known will be returned. If EVENT_MASK is given then a list of handles will be returned which had one of the events specified by EVENT_MASK happen during the last call ti C<poll> =back =head1 SEE ALSO L<poll(2)>, L<IO::Handle>, L<IO::Select> =head1 AUTHOR Graham Barr. Currently maintained by the Perl Porters. Please report all bugs to <perlbug@perl.org>. =head1 COPYRIGHT Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut File.pm 0000644 00000011410 15125156224 0005761 0 ustar 00 # package IO::File; =head1 NAME IO::File - supply object methods for filehandles =head1 SYNOPSIS use IO::File; $fh = IO::File->new(); if ($fh->open("< file")) { print <$fh>; $fh->close; } $fh = IO::File->new("> file"); if (defined $fh) { print $fh "bar\n"; $fh->close; } $fh = IO::File->new("file", "r"); if (defined $fh) { print <$fh>; undef $fh; # automatically closes the file } $fh = IO::File->new("file", O_WRONLY|O_APPEND); if (defined $fh) { print $fh "corge\n"; $pos = $fh->getpos; $fh->setpos($pos); undef $fh; # automatically closes the file } autoflush STDOUT 1; =head1 DESCRIPTION C<IO::File> inherits from C<IO::Handle> and C<IO::Seekable>. It extends these classes with methods that are specific to file handles. =head1 CONSTRUCTOR =over 4 =item new ( FILENAME [,MODE [,PERMS]] ) Creates an C<IO::File>. If it receives any parameters, they are passed to the method C<open>; if the open fails, the object is destroyed. Otherwise, it is returned to the caller. =item new_tmpfile Creates an C<IO::File> opened for read/write on a newly created temporary file. On systems where this is possible, the temporary file is anonymous (i.e. it is unlinked after creation, but held open). If the temporary file cannot be created or opened, the C<IO::File> object is destroyed. Otherwise, it is returned to the caller. =back =head1 METHODS =over 4 =item open( FILENAME [,MODE [,PERMS]] ) =item open( FILENAME, IOLAYERS ) C<open> accepts one, two or three parameters. With one parameter, it is just a front end for the built-in C<open> function. With two or three parameters, the first parameter is a filename that may include whitespace or other special characters, and the second parameter is the open mode, optionally followed by a file permission value. If C<IO::File::open> receives a Perl mode string ("E<gt>", "+E<lt>", etc.) or an ANSI C fopen() mode string ("w", "r+", etc.), it uses the basic Perl C<open> operator (but protects any special characters). If C<IO::File::open> is given a numeric mode, it passes that mode and the optional permissions value to the Perl C<sysopen> operator. The permissions default to 0666. If C<IO::File::open> is given a mode that includes the C<:> character, it passes all the three arguments to the three-argument C<open> operator. For convenience, C<IO::File> exports the O_XXX constants from the Fcntl module, if this module is available. =item binmode( [LAYER] ) C<binmode> sets C<binmode> on the underlying C<IO> object, as documented in C<perldoc -f binmode>. C<binmode> accepts one optional parameter, which is the layer to be passed on to the C<binmode> call. =back =head1 NOTE Some operating systems may perform C<IO::File::new()> or C<IO::File::open()> on a directory without errors. This behavior is not portable and not suggested for use. Using C<opendir()> and C<readdir()> or C<IO::Dir> are suggested instead. =head1 SEE ALSO L<perlfunc>, L<perlop/"I/O Operators">, L<IO::Handle>, L<IO::Seekable>, L<IO::Dir> =head1 HISTORY Derived from FileHandle.pm by Graham Barr E<lt>F<gbarr@pobox.com>E<gt>. =cut use 5.008_001; use strict; use Carp; use Symbol; use SelectSaver; use IO::Seekable; require Exporter; our @ISA = qw(IO::Handle IO::Seekable Exporter); our $VERSION = "1.41"; our @EXPORT = @IO::Seekable::EXPORT; eval { # Make all Fcntl O_XXX constants available for importing require Fcntl; my @O = grep /^O_/, @Fcntl::EXPORT; Fcntl->import(@O); # first we import what we want to export push(@EXPORT, @O); }; ################################################ ## Constructor ## sub new { my $type = shift; my $class = ref($type) || $type || "IO::File"; @_ >= 0 && @_ <= 3 or croak "usage: $class->new([FILENAME [,MODE [,PERMS]]])"; my $fh = $class->SUPER::new(); if (@_) { $fh->open(@_) or return undef; } $fh; } ################################################ ## Open ## sub open { @_ >= 2 && @_ <= 4 or croak 'usage: $fh->open(FILENAME [,MODE [,PERMS]])'; my ($fh, $file) = @_; if (@_ > 2) { my ($mode, $perms) = @_[2, 3]; if ($mode =~ /^\d+$/) { defined $perms or $perms = 0666; return sysopen($fh, $file, $mode, $perms); } elsif ($mode =~ /:/) { return open($fh, $mode, $file) if @_ == 3; croak 'usage: $fh->open(FILENAME, IOLAYERS)'; } else { return open($fh, IO::Handle::_open_mode_string($mode), $file); } } open($fh, $file); } ################################################ ## Binmode ## sub binmode { ( @_ == 1 or @_ == 2 ) or croak 'usage $fh->binmode([LAYER])'; my($fh, $layer) = @_; return binmode $$fh unless $layer; return binmode $$fh, $layer; } 1; Seekable.pm 0000644 00000005513 15125156224 0006624 0 ustar 00 # package IO::Seekable; =head1 NAME IO::Seekable - supply seek based methods for I/O objects =head1 SYNOPSIS use IO::Seekable; package IO::Something; @ISA = qw(IO::Seekable); =head1 DESCRIPTION C<IO::Seekable> does not have a constructor of its own as it is intended to be inherited by other C<IO::Handle> based objects. It provides methods which allow seeking of the file descriptors. =over 4 =item $io->getpos Returns an opaque value that represents the current position of the IO::File, or C<undef> if this is not possible (eg an unseekable stream such as a terminal, pipe or socket). If the fgetpos() function is available in your C library it is used to implements getpos, else perl emulates getpos using C's ftell() function. =item $io->setpos Uses the value of a previous getpos call to return to a previously visited position. Returns "0 but true" on success, C<undef> on failure. =back See L<perlfunc> for complete descriptions of each of the following supported C<IO::Seekable> methods, which are just front ends for the corresponding built-in functions: =over 4 =item $io->seek ( POS, WHENCE ) Seek the IO::File to position POS, relative to WHENCE: =over 8 =item WHENCE=0 (SEEK_SET) POS is absolute position. (Seek relative to the start of the file) =item WHENCE=1 (SEEK_CUR) POS is an offset from the current position. (Seek relative to current) =item WHENCE=2 (SEEK_END) POS is an offset from the end of the file. (Seek relative to end) =back The SEEK_* constants can be imported from the C<Fcntl> module if you don't wish to use the numbers C<0> C<1> or C<2> in your code. Returns C<1> upon success, C<0> otherwise. =item $io->sysseek( POS, WHENCE ) Similar to $io->seek, but sets the IO::File's position using the system call lseek(2) directly, so will confuse most perl IO operators except sysread and syswrite (see L<perlfunc> for full details) Returns the new position, or C<undef> on failure. A position of zero is returned as the string C<"0 but true"> =item $io->tell Returns the IO::File's current position, or -1 on error. =back =head1 SEE ALSO L<perlfunc>, L<perlop/"I/O Operators">, L<IO::Handle> L<IO::File> =head1 HISTORY Derived from FileHandle.pm by Graham Barr E<lt>gbarr@pobox.comE<gt> =cut use 5.008_001; use Carp; use strict; use IO::Handle (); # XXX we can't get these from IO::Handle or we'll get prototype # mismatch warnings on C<use POSIX; use IO::File;> :-( use Fcntl qw(SEEK_SET SEEK_CUR SEEK_END); require Exporter; our @EXPORT = qw(SEEK_SET SEEK_CUR SEEK_END); our @ISA = qw(Exporter); our $VERSION = "1.41"; sub seek { @_ == 3 or croak 'usage: $io->seek(POS, WHENCE)'; seek($_[0], $_[1], $_[2]); } sub sysseek { @_ == 3 or croak 'usage: $io->sysseek(POS, WHENCE)'; sysseek($_[0], $_[1], $_[2]); } sub tell { @_ == 1 or croak 'usage: $io->tell()'; tell($_[0]); } 1; Socket/INET.pm 0000644 00000030263 15125156224 0007100 0 ustar 00 # IO::Socket::INET.pm # # Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package IO::Socket::INET; use strict; use IO::Socket; use Socket; use Carp; use Exporter; use Errno; our @ISA = qw(IO::Socket); our $VERSION = "1.41"; my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1; IO::Socket::INET->register_domain( AF_INET ); my %socket_type = ( tcp => SOCK_STREAM, udp => SOCK_DGRAM, icmp => SOCK_RAW ); my %proto_number; $proto_number{tcp} = Socket::IPPROTO_TCP() if defined &Socket::IPPROTO_TCP; $proto_number{udp} = Socket::IPPROTO_UDP() if defined &Socket::IPPROTO_UDP; $proto_number{icmp} = Socket::IPPROTO_ICMP() if defined &Socket::IPPROTO_ICMP; my %proto_name = reverse %proto_number; sub new { my $class = shift; unshift(@_, "PeerAddr") if @_ == 1; return $class->SUPER::new(@_); } sub _cache_proto { my @proto = @_; for (map lc($_), $proto[0], split(' ', $proto[1])) { $proto_number{$_} = $proto[2]; } $proto_name{$proto[2]} = $proto[0]; } sub _get_proto_number { my $name = lc(shift); return undef unless defined $name; return $proto_number{$name} if exists $proto_number{$name}; my @proto = eval { getprotobyname($name) }; return undef unless @proto; _cache_proto(@proto); return $proto[2]; } sub _get_proto_name { my $num = shift; return undef unless defined $num; return $proto_name{$num} if exists $proto_name{$num}; my @proto = eval { getprotobynumber($num) }; return undef unless @proto; _cache_proto(@proto); return $proto[0]; } sub _sock_info { my($addr,$port,$proto) = @_; my $origport = $port; my @serv = (); $port = $1 if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,); if(defined $proto && $proto =~ /\D/) { my $num = _get_proto_number($proto); unless (defined $num) { $@ = "Bad protocol '$proto'"; return; } $proto = $num; } if(defined $port) { my $defport = ($port =~ s,\((\d+)\)$,,) ? $1 : undef; my $pnum = ($port =~ m,^(\d+)$,)[0]; @serv = getservbyname($port, _get_proto_name($proto) || "") if ($port =~ m,\D,); $port = $serv[2] || $defport || $pnum; unless (defined $port) { $@ = "Bad service '$origport'"; return; } $proto = _get_proto_number($serv[3]) if @serv && !$proto; } return ($addr || undef, $port || undef, $proto || undef ); } sub _error { my $sock = shift; my $err = shift; { local($!); my $title = ref($sock).": "; $@ = join("", $_[0] =~ /^$title/ ? "" : $title, @_); $sock->close() if(defined fileno($sock)); } $! = $err; return undef; } sub _get_addr { my($sock,$addr_str, $multi) = @_; my @addr; if ($multi && $addr_str !~ /^\d+(?:\.\d+){3}$/) { (undef, undef, undef, undef, @addr) = gethostbyname($addr_str); } else { my $h = inet_aton($addr_str); push(@addr, $h) if defined $h; } @addr; } sub configure { my($sock,$arg) = @_; my($lport,$rport,$laddr,$raddr,$proto,$type); $arg->{LocalAddr} = $arg->{LocalHost} if exists $arg->{LocalHost} && !exists $arg->{LocalAddr}; ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr}, $arg->{LocalPort}, $arg->{Proto}) or return _error($sock, $!, $@); $laddr = defined $laddr ? inet_aton($laddr) : INADDR_ANY; return _error($sock, $EINVAL, "Bad hostname '",$arg->{LocalAddr},"'") unless(defined $laddr); $arg->{PeerAddr} = $arg->{PeerHost} if exists $arg->{PeerHost} && !exists $arg->{PeerAddr}; unless(exists $arg->{Listen}) { ($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr}, $arg->{PeerPort}, $proto) or return _error($sock, $!, $@); } $proto ||= _get_proto_number('tcp'); $type = $arg->{Type} || $socket_type{lc _get_proto_name($proto)}; my @raddr = (); if(defined $raddr) { @raddr = $sock->_get_addr($raddr, $arg->{MultiHomed}); return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'") unless @raddr; } while(1) { $sock->socket(AF_INET, $type, $proto) or return _error($sock, $!, "$!"); if (defined $arg->{Blocking}) { defined $sock->blocking($arg->{Blocking}) or return _error($sock, $!, "$!"); } if ($arg->{Reuse} || $arg->{ReuseAddr}) { $sock->sockopt(SO_REUSEADDR,1) or return _error($sock, $!, "$!"); } if ($arg->{ReusePort}) { $sock->sockopt(SO_REUSEPORT,1) or return _error($sock, $!, "$!"); } if ($arg->{Broadcast}) { $sock->sockopt(SO_BROADCAST,1) or return _error($sock, $!, "$!"); } if($lport || ($laddr ne INADDR_ANY) || exists $arg->{Listen}) { $sock->bind($lport || 0, $laddr) or return _error($sock, $!, "$!"); } if(exists $arg->{Listen}) { $sock->listen($arg->{Listen} || 5) or return _error($sock, $!, "$!"); last; } # don't try to connect unless we're given a PeerAddr last unless exists($arg->{PeerAddr}); $raddr = shift @raddr; return _error($sock, $EINVAL, 'Cannot determine remote port') unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW); last unless($type == SOCK_STREAM || defined $raddr); return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'") unless defined $raddr; # my $timeout = ${*$sock}{'io_socket_timeout'}; # my $before = time() if $timeout; undef $@; if ($sock->connect(pack_sockaddr_in($rport, $raddr))) { # ${*$sock}{'io_socket_timeout'} = $timeout; return $sock; } return _error($sock, $!, $@ || "Timeout") unless @raddr; # if ($timeout) { # my $new_timeout = $timeout - (time() - $before); # return _error($sock, # (exists(&Errno::ETIMEDOUT) ? Errno::ETIMEDOUT() : $EINVAL), # "Timeout") if $new_timeout <= 0; # ${*$sock}{'io_socket_timeout'} = $new_timeout; # } } $sock; } sub connect { @_ == 2 || @_ == 3 or croak 'usage: $sock->connect(NAME) or $sock->connect(PORT, ADDR)'; my $sock = shift; return $sock->SUPER::connect(@_ == 1 ? shift : pack_sockaddr_in(@_)); } sub bind { @_ == 2 || @_ == 3 or croak 'usage: $sock->bind(NAME) or $sock->bind(PORT, ADDR)'; my $sock = shift; return $sock->SUPER::bind(@_ == 1 ? shift : pack_sockaddr_in(@_)) } sub sockaddr { @_ == 1 or croak 'usage: $sock->sockaddr()'; my($sock) = @_; my $name = $sock->sockname; $name ? (sockaddr_in($name))[1] : undef; } sub sockport { @_ == 1 or croak 'usage: $sock->sockport()'; my($sock) = @_; my $name = $sock->sockname; $name ? (sockaddr_in($name))[0] : undef; } sub sockhost { @_ == 1 or croak 'usage: $sock->sockhost()'; my($sock) = @_; my $addr = $sock->sockaddr; $addr ? inet_ntoa($addr) : undef; } sub peeraddr { @_ == 1 or croak 'usage: $sock->peeraddr()'; my($sock) = @_; my $name = $sock->peername; $name ? (sockaddr_in($name))[1] : undef; } sub peerport { @_ == 1 or croak 'usage: $sock->peerport()'; my($sock) = @_; my $name = $sock->peername; $name ? (sockaddr_in($name))[0] : undef; } sub peerhost { @_ == 1 or croak 'usage: $sock->peerhost()'; my($sock) = @_; my $addr = $sock->peeraddr; $addr ? inet_ntoa($addr) : undef; } 1; __END__ =head1 NAME IO::Socket::INET - Object interface for AF_INET domain sockets =head1 SYNOPSIS use IO::Socket::INET; =head1 DESCRIPTION C<IO::Socket::INET> provides an object interface to creating and using sockets in the AF_INET domain. It is built upon the L<IO::Socket> interface and inherits all the methods defined by L<IO::Socket>. =head1 CONSTRUCTOR =over 4 =item new ( [ARGS] ) Creates an C<IO::Socket::INET> object, which is a reference to a newly created symbol (see the C<Symbol> package). C<new> optionally takes arguments, these arguments are in key-value pairs. In addition to the key-value pairs accepted by L<IO::Socket>, C<IO::Socket::INET> provides. PeerAddr Remote host address <hostname>[:<port>] PeerHost Synonym for PeerAddr PeerPort Remote port or service <service>[(<no>)] | <no> LocalAddr Local host bind address hostname[:port] LocalHost Synonym for LocalAddr LocalPort Local host bind port <service>[(<no>)] | <no> Proto Protocol name (or number) "tcp" | "udp" | ... Type Socket type SOCK_STREAM | SOCK_DGRAM | ... Listen Queue size for listen ReuseAddr Set SO_REUSEADDR before binding Reuse Set SO_REUSEADDR before binding (deprecated, prefer ReuseAddr) ReusePort Set SO_REUSEPORT before binding Broadcast Set SO_BROADCAST before binding Timeout Timeout value for various operations MultiHomed Try all addresses for multi-homed hosts Blocking Determine if connection will be blocking mode If C<Listen> is defined then a listen socket is created, else if the socket type, which is derived from the protocol, is SOCK_STREAM then connect() is called. If the C<Listen> argument is given, but false, the queue size will be set to 5. Although it is not illegal, the use of C<MultiHomed> on a socket which is in non-blocking mode is of little use. This is because the first connect will never fail with a timeout as the connect call will not block. The C<PeerAddr> can be a hostname or the IP-address on the "xx.xx.xx.xx" form. The C<PeerPort> can be a number or a symbolic service name. The service name might be followed by a number in parenthesis which is used if the service is not known by the system. The C<PeerPort> specification can also be embedded in the C<PeerAddr> by preceding it with a ":". If C<Proto> is not given and you specify a symbolic C<PeerPort> port, then the constructor will try to derive C<Proto> from the service name. As a last resort C<Proto> "tcp" is assumed. The C<Type> parameter will be deduced from C<Proto> if not specified. If the constructor is only passed a single argument, it is assumed to be a C<PeerAddr> specification. If C<Blocking> is set to 0, the connection will be in nonblocking mode. If not specified it defaults to 1 (blocking mode). Examples: $sock = IO::Socket::INET->new(PeerAddr => 'www.perl.org', PeerPort => 'http(80)', Proto => 'tcp'); $sock = IO::Socket::INET->new(PeerAddr => 'localhost:smtp(25)'); $sock = IO::Socket::INET->new(Listen => 5, LocalAddr => 'localhost', LocalPort => 9000, Proto => 'tcp'); $sock = IO::Socket::INET->new('127.0.0.1:25'); $sock = IO::Socket::INET->new( PeerPort => 9999, PeerAddr => inet_ntoa(INADDR_BROADCAST), Proto => udp, LocalAddr => 'localhost', Broadcast => 1 ) or die "Can't bind : $@\n"; B<NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE> As of VERSION 1.18 all IO::Socket objects have autoflush turned on by default. This was not the case with earlier releases. B<NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE> =back =head2 METHODS =over 4 =item sockaddr () Return the address part of the sockaddr structure for the socket =item sockport () Return the port number that the socket is using on the local host =item sockhost () Return the address part of the sockaddr structure for the socket in a text form xx.xx.xx.xx =item peeraddr () Return the address part of the sockaddr structure for the socket on the peer host =item peerport () Return the port number for the socket on the peer host. =item peerhost () Return the address part of the sockaddr structure for the socket on the peer host in a text form xx.xx.xx.xx =back =head1 SEE ALSO L<Socket>, L<IO::Socket> =head1 AUTHOR Graham Barr. Currently maintained by the Perl Porters. Please report all bugs to <perlbug@perl.org>. =head1 COPYRIGHT Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Socket/UNIX.pm 0000644 00000006640 15125156224 0007126 0 ustar 00 # IO::Socket::UNIX.pm # # Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package IO::Socket::UNIX; use strict; use IO::Socket; use Carp; our @ISA = qw(IO::Socket); our $VERSION = "1.42"; IO::Socket::UNIX->register_domain( AF_UNIX ); sub new { my $class = shift; unshift(@_, "Peer") if @_ == 1; return $class->SUPER::new(@_); } sub configure { my($sock,$arg) = @_; my($bport,$cport); my $type = $arg->{Type} || SOCK_STREAM; $sock->socket(AF_UNIX, $type, 0) or return undef; if(exists $arg->{Blocking}) { $sock->blocking($arg->{Blocking}) or return undef; } if(exists $arg->{Local}) { my $addr = sockaddr_un($arg->{Local}); $sock->bind($addr) or return undef; } if(exists $arg->{Listen} && $type != SOCK_DGRAM) { $sock->listen($arg->{Listen} || 5) or return undef; } elsif(exists $arg->{Peer}) { my $addr = sockaddr_un($arg->{Peer}); $sock->connect($addr) or return undef; } $sock; } sub hostpath { @_ == 1 or croak 'usage: $sock->hostpath()'; my $n = $_[0]->sockname || return undef; (sockaddr_un($n))[0]; } sub peerpath { @_ == 1 or croak 'usage: $sock->peerpath()'; my $n = $_[0]->peername || return undef; (sockaddr_un($n))[0]; } 1; # Keep require happy __END__ =head1 NAME IO::Socket::UNIX - Object interface for AF_UNIX domain sockets =head1 SYNOPSIS use IO::Socket::UNIX; my $SOCK_PATH = "$ENV{HOME}/unix-domain-socket-test.sock"; # Server: my $server = IO::Socket::UNIX->new( Type => SOCK_STREAM(), Local => $SOCK_PATH, Listen => 1, ); my $count = 1; while (my $conn = $server->accept()) { $conn->print("Hello " . ($count++) . "\n"); } # Client: my $client = IO::Socket::UNIX->new( Type => SOCK_STREAM(), Peer => $SOCK_PATH, ); # Now read and write from $client =head1 DESCRIPTION C<IO::Socket::UNIX> provides an object interface to creating and using sockets in the AF_UNIX domain. It is built upon the L<IO::Socket> interface and inherits all the methods defined by L<IO::Socket>. =head1 CONSTRUCTOR =over 4 =item new ( [ARGS] ) Creates an C<IO::Socket::UNIX> object, which is a reference to a newly created symbol (see the C<Symbol> package). C<new> optionally takes arguments, these arguments are in key-value pairs. In addition to the key-value pairs accepted by L<IO::Socket>, C<IO::Socket::UNIX> provides. Type Type of socket (eg SOCK_STREAM or SOCK_DGRAM) Local Path to local fifo Peer Path to peer fifo Listen Queue size for listen If the constructor is only passed a single argument, it is assumed to be a C<Peer> specification. If the C<Listen> argument is given, but false, the queue size will be set to 5. =back =head1 METHODS =over 4 =item hostpath() Returns the pathname to the fifo at the local end =item peerpath() Returns the pathanme to the fifo at the peer end =back =head1 SEE ALSO L<Socket>, L<IO::Socket> =head1 AUTHOR Graham Barr. Currently maintained by the Perl Porters. Please report all bugs to <perlbug@perl.org>. =head1 COPYRIGHT Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Pipe.pm 0000644 00000012525 15125156224 0006007 0 ustar 00 # IO::Pipe.pm # # Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package IO::Pipe; use 5.008_001; use IO::Handle; use strict; use Carp; use Symbol; our $VERSION = "1.41"; sub new { my $type = shift; my $class = ref($type) || $type || "IO::Pipe"; @_ == 0 || @_ == 2 or croak "usage: $class->([READFH, WRITEFH])"; my $me = bless gensym(), $class; my($readfh,$writefh) = @_ ? @_ : $me->handles; pipe($readfh, $writefh) or return undef; @{*$me} = ($readfh, $writefh); $me; } sub handles { @_ == 1 or croak 'usage: $pipe->handles()'; (IO::Pipe::End->new(), IO::Pipe::End->new()); } my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32'; sub _doit { my $me = shift; my $rw = shift; my $pid = $do_spawn ? 0 : fork(); if($pid) { # Parent return $pid; } elsif(defined $pid) { # Child or spawn my $fh; my $io = $rw ? \*STDIN : \*STDOUT; my ($mode, $save) = $rw ? "r" : "w"; if ($do_spawn) { require Fcntl; $save = IO::Handle->new_from_fd($io, $mode); my $handle = shift; # Close in child: unless ($^O eq 'MSWin32') { fcntl($handle, Fcntl::F_SETFD(), 1) or croak "fcntl: $!"; } $fh = $rw ? ${*$me}[0] : ${*$me}[1]; } else { shift; $fh = $rw ? $me->reader() : $me->writer(); # close the other end } bless $io, "IO::Handle"; $io->fdopen($fh, $mode); $fh->close; if ($do_spawn) { $pid = eval { system 1, @_ }; # 1 == P_NOWAIT my $err = $!; $io->fdopen($save, $mode); $save->close or croak "Cannot close $!"; croak "IO::Pipe: Cannot spawn-NOWAIT: $err" if not $pid or $pid < 0; return $pid; } else { exec @_ or croak "IO::Pipe: Cannot exec: $!"; } } else { croak "IO::Pipe: Cannot fork: $!"; } # NOT Reached } sub reader { @_ >= 1 or croak 'usage: $pipe->reader( [SUB_COMMAND_ARGS] )'; my $me = shift; return undef unless(ref($me) || ref($me = $me->new)); my $fh = ${*$me}[0]; my $pid; $pid = $me->_doit(0, $fh, @_) if(@_); close ${*$me}[1]; bless $me, ref($fh); *$me = *$fh; # Alias self to handle $me->fdopen($fh->fileno,"r") unless defined($me->fileno); bless $fh; # Really wan't un-bless here ${*$me}{'io_pipe_pid'} = $pid if defined $pid; $me; } sub writer { @_ >= 1 or croak 'usage: $pipe->writer( [SUB_COMMAND_ARGS] )'; my $me = shift; return undef unless(ref($me) || ref($me = $me->new)); my $fh = ${*$me}[1]; my $pid; $pid = $me->_doit(1, $fh, @_) if(@_); close ${*$me}[0]; bless $me, ref($fh); *$me = *$fh; # Alias self to handle $me->fdopen($fh->fileno,"w") unless defined($me->fileno); bless $fh; # Really wan't un-bless here ${*$me}{'io_pipe_pid'} = $pid if defined $pid; $me; } package IO::Pipe::End; our(@ISA); @ISA = qw(IO::Handle); sub close { my $fh = shift; my $r = $fh->SUPER::close(@_); waitpid(${*$fh}{'io_pipe_pid'},0) if(defined ${*$fh}{'io_pipe_pid'}); $r; } 1; __END__ =head1 NAME IO::Pipe - supply object methods for pipes =head1 SYNOPSIS use IO::Pipe; $pipe = IO::Pipe->new(); if($pid = fork()) { # Parent $pipe->reader(); while(<$pipe>) { ... } } elsif(defined $pid) { # Child $pipe->writer(); print $pipe ... } or $pipe = IO::Pipe->new(); $pipe->reader(qw(ls -l)); while(<$pipe>) { ... } =head1 DESCRIPTION C<IO::Pipe> provides an interface to creating pipes between processes. =head1 CONSTRUCTOR =over 4 =item new ( [READER, WRITER] ) Creates an C<IO::Pipe>, which is a reference to a newly created symbol (see the C<Symbol> package). C<IO::Pipe::new> optionally takes two arguments, which should be objects blessed into C<IO::Handle>, or a subclass thereof. These two objects will be used for the system call to C<pipe>. If no arguments are given then method C<handles> is called on the new C<IO::Pipe> object. These two handles are held in the array part of the GLOB until either C<reader> or C<writer> is called. =back =head1 METHODS =over 4 =item reader ([ARGS]) The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a handle at the reading end of the pipe. If C<ARGS> are given then C<fork> is called and C<ARGS> are passed to exec. =item writer ([ARGS]) The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a handle at the writing end of the pipe. If C<ARGS> are given then C<fork> is called and C<ARGS> are passed to exec. =item handles () This method is called during construction by C<IO::Pipe::new> on the newly created C<IO::Pipe> object. It returns an array of two objects blessed into C<IO::Pipe::End>, or a subclass thereof. =back =head1 SEE ALSO L<IO::Handle> =head1 AUTHOR Graham Barr. Currently maintained by the Perl Porters. Please report all bugs to <perlbug@perl.org>. =head1 COPYRIGHT Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Dir.pm 0000644 00000012316 15125156224 0005626 0 ustar 00 # IO::Dir.pm # # Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package IO::Dir; use 5.008_001; use strict; use Carp; use Symbol; use Exporter; use IO::File; use Tie::Hash; use File::stat; use File::Spec; our @ISA = qw(Tie::Hash Exporter); our $VERSION = "1.41"; our @EXPORT_OK = qw(DIR_UNLINK); sub DIR_UNLINK () { 1 } sub new { @_ >= 1 && @_ <= 2 or croak 'usage: IO::Dir->new([DIRNAME])'; my $class = shift; my $dh = gensym; if (@_) { IO::Dir::open($dh, $_[0]) or return undef; } bless $dh, $class; } sub DESTROY { my ($dh) = @_; local($., $@, $!, $^E, $?); no warnings 'io'; closedir($dh); } sub open { @_ == 2 or croak 'usage: $dh->open(DIRNAME)'; my ($dh, $dirname) = @_; return undef unless opendir($dh, $dirname); # a dir name should always have a ":" in it; assume dirname is # in current directory $dirname = ':' . $dirname if ( ($^O eq 'MacOS') && ($dirname !~ /:/) ); ${*$dh}{io_dir_path} = $dirname; 1; } sub close { @_ == 1 or croak 'usage: $dh->close()'; my ($dh) = @_; closedir($dh); } sub read { @_ == 1 or croak 'usage: $dh->read()'; my ($dh) = @_; readdir($dh); } sub seek { @_ == 2 or croak 'usage: $dh->seek(POS)'; my ($dh,$pos) = @_; seekdir($dh,$pos); } sub tell { @_ == 1 or croak 'usage: $dh->tell()'; my ($dh) = @_; telldir($dh); } sub rewind { @_ == 1 or croak 'usage: $dh->rewind()'; my ($dh) = @_; rewinddir($dh); } sub TIEHASH { my($class,$dir,$options) = @_; my $dh = $class->new($dir) or return undef; $options ||= 0; ${*$dh}{io_dir_unlink} = $options & DIR_UNLINK; $dh; } sub FIRSTKEY { my($dh) = @_; $dh->rewind; scalar $dh->read; } sub NEXTKEY { my($dh) = @_; scalar $dh->read; } sub EXISTS { my($dh,$key) = @_; -e File::Spec->catfile(${*$dh}{io_dir_path}, $key); } sub FETCH { my($dh,$key) = @_; &lstat(File::Spec->catfile(${*$dh}{io_dir_path}, $key)); } sub STORE { my($dh,$key,$data) = @_; my($atime,$mtime) = ref($data) ? @$data : ($data,$data); my $file = File::Spec->catfile(${*$dh}{io_dir_path}, $key); unless(-e $file) { my $io = IO::File->new($file,O_CREAT | O_RDWR); $io->close if $io; } utime($atime,$mtime, $file); } sub DELETE { my($dh,$key) = @_; # Only unlink if unlink-ing is enabled return 0 unless ${*$dh}{io_dir_unlink}; my $file = File::Spec->catfile(${*$dh}{io_dir_path}, $key); -d $file ? rmdir($file) : unlink($file); } 1; __END__ =head1 NAME IO::Dir - supply object methods for directory handles =head1 SYNOPSIS use IO::Dir; $d = IO::Dir->new("."); if (defined $d) { while (defined($_ = $d->read)) { something($_); } $d->rewind; while (defined($_ = $d->read)) { something_else($_); } undef $d; } tie %dir, 'IO::Dir', "."; foreach (keys %dir) { print $_, " " , $dir{$_}->size,"\n"; } =head1 DESCRIPTION The C<IO::Dir> package provides two interfaces to perl's directory reading routines. The first interface is an object approach. C<IO::Dir> provides an object constructor and methods, which are just wrappers around perl's built in directory reading routines. =over 4 =item new ( [ DIRNAME ] ) C<new> is the constructor for C<IO::Dir> objects. It accepts one optional argument which, if given, C<new> will pass to C<open> =back The following methods are wrappers for the directory related functions built into perl (the trailing 'dir' has been removed from the names). See L<perlfunc> for details of these functions. =over 4 =item open ( DIRNAME ) =item read () =item seek ( POS ) =item tell () =item rewind () =item close () =back C<IO::Dir> also provides an interface to reading directories via a tied hash. The tied hash extends the interface beyond just the directory reading routines by the use of C<lstat>, from the C<File::stat> package, C<unlink>, C<rmdir> and C<utime>. =over 4 =item tie %hash, 'IO::Dir', DIRNAME [, OPTIONS ] =back The keys of the hash will be the names of the entries in the directory. Reading a value from the hash will be the result of calling C<File::stat::lstat>. Deleting an element from the hash will delete the corresponding file or subdirectory, provided that C<DIR_UNLINK> is included in the C<OPTIONS>. Assigning to an entry in the hash will cause the time stamps of the file to be modified. If the file does not exist then it will be created. Assigning a single integer to a hash element will cause both the access and modification times to be changed to that value. Alternatively a reference to an array of two values can be passed. The first array element will be used to set the access time and the second element will be used to set the modification time. =head1 SEE ALSO L<File::stat> =head1 AUTHOR Graham Barr. Currently maintained by the Perl Porters. Please report all bugs to <perlbug@perl.org>. =head1 COPYRIGHT Copyright (c) 1997-2003 Graham Barr <gbarr@pobox.com>. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Handle.pm 0000644 00000040401 15125156224 0006277 0 ustar 00 package IO::Handle; =head1 NAME IO::Handle - supply object methods for I/O handles =head1 SYNOPSIS use IO::Handle; $io = IO::Handle->new(); if ($io->fdopen(fileno(STDIN),"r")) { print $io->getline; $io->close; } $io = IO::Handle->new(); if ($io->fdopen(fileno(STDOUT),"w")) { $io->print("Some text\n"); } # setvbuf is not available by default on Perls 5.8.0 and later. use IO::Handle '_IOLBF'; $io->setvbuf($buffer_var, _IOLBF, 1024); undef $io; # automatically closes the file if it's open autoflush STDOUT 1; =head1 DESCRIPTION C<IO::Handle> is the base class for all other IO handle classes. It is not intended that objects of C<IO::Handle> would be created directly, but instead C<IO::Handle> is inherited from by several other classes in the IO hierarchy. If you are reading this documentation, looking for a replacement for the C<FileHandle> package, then I suggest you read the documentation for C<IO::File> too. =head1 CONSTRUCTOR =over 4 =item new () Creates a new C<IO::Handle> object. =item new_from_fd ( FD, MODE ) Creates an C<IO::Handle> like C<new> does. It requires two parameters, which are passed to the method C<fdopen>; if the fdopen fails, the object is destroyed. Otherwise, it is returned to the caller. =back =head1 METHODS See L<perlfunc> for complete descriptions of each of the following supported C<IO::Handle> methods, which are just front ends for the corresponding built-in functions: $io->close $io->eof $io->fcntl( FUNCTION, SCALAR ) $io->fileno $io->format_write( [FORMAT_NAME] ) $io->getc $io->ioctl( FUNCTION, SCALAR ) $io->read ( BUF, LEN, [OFFSET] ) $io->print ( ARGS ) $io->printf ( FMT, [ARGS] ) $io->say ( ARGS ) $io->stat $io->sysread ( BUF, LEN, [OFFSET] ) $io->syswrite ( BUF, [LEN, [OFFSET]] ) $io->truncate ( LEN ) See L<perlvar> for complete descriptions of each of the following supported C<IO::Handle> methods. All of them return the previous value of the attribute and takes an optional single argument that when given will set the value. If no argument is given the previous value is unchanged (except for $io->autoflush will actually turn ON autoflush by default). $io->autoflush ( [BOOL] ) $| $io->format_page_number( [NUM] ) $% $io->format_lines_per_page( [NUM] ) $= $io->format_lines_left( [NUM] ) $- $io->format_name( [STR] ) $~ $io->format_top_name( [STR] ) $^ $io->input_line_number( [NUM]) $. The following methods are not supported on a per-filehandle basis. IO::Handle->format_line_break_characters( [STR] ) $: IO::Handle->format_formfeed( [STR]) $^L IO::Handle->output_field_separator( [STR] ) $, IO::Handle->output_record_separator( [STR] ) $\ IO::Handle->input_record_separator( [STR] ) $/ Furthermore, for doing normal I/O you might need these: =over 4 =item $io->fdopen ( FD, MODE ) C<fdopen> is like an ordinary C<open> except that its first parameter is not a filename but rather a file handle name, an IO::Handle object, or a file descriptor number. (For the documentation of the C<open> method, see L<IO::File>.) =item $io->opened Returns true if the object is currently a valid file descriptor, false otherwise. =item $io->getline This works like <$io> described in L<perlop/"I/O Operators"> except that it's more readable and can be safely called in a list context but still returns just one line. If used as the conditional within a C<while> or C-style C<for> loop, however, you will need to emulate the functionality of <$io> with C<< defined($_ = $io->getline) >>. =item $io->getlines This works like <$io> when called in a list context to read all the remaining lines in a file, except that it's more readable. It will also croak() if accidentally called in a scalar context. =item $io->ungetc ( ORD ) Pushes a character with the given ordinal value back onto the given handle's input stream. Only one character of pushback per handle is guaranteed. =item $io->write ( BUF, LEN [, OFFSET ] ) This C<write> is somewhat like C<write> found in C, in that it is the opposite of read. The wrapper for the perl C<write> function is called C<format_write>. However, whilst the C C<write> function returns the number of bytes written, this C<write> function simply returns true if successful (like C<print>). A more C-like C<write> is C<syswrite> (see above). =item $io->error Returns a true value if the given handle has experienced any errors since it was opened or since the last call to C<clearerr>, or if the handle is invalid. It only returns false for a valid handle with no outstanding errors. =item $io->clearerr Clear the given handle's error indicator. Returns -1 if the handle is invalid, 0 otherwise. =item $io->sync C<sync> synchronizes a file's in-memory state with that on the physical medium. C<sync> does not operate at the perlio api level, but operates on the file descriptor (similar to sysread, sysseek and systell). This means that any data held at the perlio api level will not be synchronized. To synchronize data that is buffered at the perlio api level you must use the flush method. C<sync> is not implemented on all platforms. Returns "0 but true" on success, C<undef> on error, C<undef> for an invalid handle. See L<fsync(3c)>. =item $io->flush C<flush> causes perl to flush any buffered data at the perlio api level. Any unread data in the buffer will be discarded, and any unwritten data will be written to the underlying file descriptor. Returns "0 but true" on success, C<undef> on error. =item $io->printflush ( ARGS ) Turns on autoflush, print ARGS and then restores the autoflush status of the C<IO::Handle> object. Returns the return value from print. =item $io->blocking ( [ BOOL ] ) If called with an argument C<blocking> will turn on non-blocking IO if C<BOOL> is false, and turn it off if C<BOOL> is true. C<blocking> will return the value of the previous setting, or the current setting if C<BOOL> is not given. If an error occurs C<blocking> will return undef and C<$!> will be set. =back If the C functions setbuf() and/or setvbuf() are available, then C<IO::Handle::setbuf> and C<IO::Handle::setvbuf> set the buffering policy for an IO::Handle. The calling sequences for the Perl functions are the same as their C counterparts--including the constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> for setvbuf()--except that the buffer parameter specifies a scalar variable to use as a buffer. You should only change the buffer before any I/O, or immediately after calling flush. WARNING: The IO::Handle::setvbuf() is not available by default on Perls 5.8.0 and later because setvbuf() is rather specific to using the stdio library, while Perl prefers the new perlio subsystem instead. WARNING: A variable used as a buffer by C<setbuf> or C<setvbuf> B<must not be modified> in any way until the IO::Handle is closed or C<setbuf> or C<setvbuf> is called again, or memory corruption may result! Remember that the order of global destruction is undefined, so even if your buffer variable remains in scope until program termination, it may be undefined before the file IO::Handle is closed. Note that you need to import the constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly. Like C, setbuf returns nothing. setvbuf returns "0 but true", on success, C<undef> on failure. Lastly, there is a special method for working under B<-T> and setuid/gid scripts: =over 4 =item $io->untaint Marks the object as taint-clean, and as such data read from it will also be considered taint-clean. Note that this is a very trusting action to take, and appropriate consideration for the data source and potential vulnerability should be kept in mind. Returns 0 on success, -1 if setting the taint-clean flag failed. (eg invalid handle) =back =head1 NOTE An C<IO::Handle> object is a reference to a symbol/GLOB reference (see the C<Symbol> package). Some modules that inherit from C<IO::Handle> may want to keep object related variables in the hash table part of the GLOB. In an attempt to prevent modules trampling on each other I propose the that any such module should prefix its variables with its own name separated by _'s. For example the IO::Socket module keeps a C<timeout> variable in 'io_socket_timeout'. =head1 SEE ALSO L<perlfunc>, L<perlop/"I/O Operators">, L<IO::File> =head1 BUGS Due to backwards compatibility, all filehandles resemble objects of class C<IO::Handle>, or actually classes derived from that class. They actually aren't. Which means you can't derive your own class from C<IO::Handle> and inherit those methods. =head1 HISTORY Derived from FileHandle.pm by Graham Barr E<lt>F<gbarr@pobox.com>E<gt> =cut use 5.008_001; use strict; use Carp; use Symbol; use SelectSaver; use IO (); # Load the XS module require Exporter; our @ISA = qw(Exporter); our $VERSION = "1.42"; our @EXPORT_OK = qw( autoflush output_field_separator output_record_separator input_record_separator input_line_number format_page_number format_lines_per_page format_lines_left format_name format_top_name format_line_break_characters format_formfeed format_write print printf say getline getlines printflush flush SEEK_SET SEEK_CUR SEEK_END _IOFBF _IOLBF _IONBF ); ################################################ ## Constructors, destructors. ## sub new { my $class = ref($_[0]) || $_[0] || "IO::Handle"; if (@_ != 1) { # Since perl will automatically require IO::File if needed, but # also initialises IO::File's @ISA as part of the core we must # ensure IO::File is loaded if IO::Handle is. This avoids effect- # ively "half-loading" IO::File. if ($] > 5.013 && $class eq 'IO::File' && !$INC{"IO/File.pm"}) { require IO::File; shift; return IO::File::->new(@_); } croak "usage: $class->new()"; } my $io = gensym; bless $io, $class; } sub new_from_fd { my $class = ref($_[0]) || $_[0] || "IO::Handle"; @_ == 3 or croak "usage: $class->new_from_fd(FD, MODE)"; my $io = gensym; shift; IO::Handle::fdopen($io, @_) or return undef; bless $io, $class; } # # There is no need for DESTROY to do anything, because when the # last reference to an IO object is gone, Perl automatically # closes its associated files (if any). However, to avoid any # attempts to autoload DESTROY, we here define it to do nothing. # sub DESTROY {} ################################################ ## Open and close. ## sub _open_mode_string { my ($mode) = @_; $mode =~ /^\+?(<|>>?)$/ or $mode =~ s/^r(\+?)$/$1</ or $mode =~ s/^w(\+?)$/$1>/ or $mode =~ s/^a(\+?)$/$1>>/ or croak "IO::Handle: bad open mode: $mode"; $mode; } sub fdopen { @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)'; my ($io, $fd, $mode) = @_; local(*GLOB); if (ref($fd) && "$fd" =~ /GLOB\(/o) { # It's a glob reference; Alias it as we cannot get name of anon GLOBs my $n = qualify(*GLOB); *GLOB = *{*$fd}; $fd = $n; } elsif ($fd =~ m#^\d+$#) { # It's an FD number; prefix with "=". $fd = "=$fd"; } open($io, _open_mode_string($mode) . '&' . $fd) ? $io : undef; } sub close { @_ == 1 or croak 'usage: $io->close()'; my($io) = @_; close($io); } ################################################ ## Normal I/O functions. ## # flock # select sub opened { @_ == 1 or croak 'usage: $io->opened()'; defined fileno($_[0]); } sub fileno { @_ == 1 or croak 'usage: $io->fileno()'; fileno($_[0]); } sub getc { @_ == 1 or croak 'usage: $io->getc()'; getc($_[0]); } sub eof { @_ == 1 or croak 'usage: $io->eof()'; eof($_[0]); } sub print { @_ or croak 'usage: $io->print(ARGS)'; my $this = shift; print $this @_; } sub printf { @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])'; my $this = shift; printf $this @_; } sub say { @_ or croak 'usage: $io->say(ARGS)'; my $this = shift; local $\ = "\n"; print $this @_; } sub truncate { @_ == 2 or croak 'usage: $io->truncate(LEN)'; truncate($_[0], $_[1]); } sub read { @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])'; read($_[0], $_[1], $_[2], $_[3] || 0); } sub sysread { @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])'; sysread($_[0], $_[1], $_[2], $_[3] || 0); } sub write { @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])'; local($\) = ""; $_[2] = length($_[1]) unless defined $_[2]; print { $_[0] } substr($_[1], $_[3] || 0, $_[2]); } sub syswrite { @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])'; if (defined($_[2])) { syswrite($_[0], $_[1], $_[2], $_[3] || 0); } else { syswrite($_[0], $_[1]); } } sub stat { @_ == 1 or croak 'usage: $io->stat()'; stat($_[0]); } ################################################ ## State modification functions. ## sub autoflush { my $old = SelectSaver->new(qualify($_[0], caller)); my $prev = $|; $| = @_ > 1 ? $_[1] : 1; $prev; } sub output_field_separator { carp "output_field_separator is not supported on a per-handle basis" if ref($_[0]); my $prev = $,; $, = $_[1] if @_ > 1; $prev; } sub output_record_separator { carp "output_record_separator is not supported on a per-handle basis" if ref($_[0]); my $prev = $\; $\ = $_[1] if @_ > 1; $prev; } sub input_record_separator { carp "input_record_separator is not supported on a per-handle basis" if ref($_[0]); my $prev = $/; $/ = $_[1] if @_ > 1; $prev; } sub input_line_number { local $.; () = tell qualify($_[0], caller) if ref($_[0]); my $prev = $.; $. = $_[1] if @_ > 1; $prev; } sub format_page_number { my $old; $old = SelectSaver->new(qualify($_[0], caller)) if ref($_[0]); my $prev = $%; $% = $_[1] if @_ > 1; $prev; } sub format_lines_per_page { my $old; $old = SelectSaver->new(qualify($_[0], caller)) if ref($_[0]); my $prev = $=; $= = $_[1] if @_ > 1; $prev; } sub format_lines_left { my $old; $old = SelectSaver->new(qualify($_[0], caller)) if ref($_[0]); my $prev = $-; $- = $_[1] if @_ > 1; $prev; } sub format_name { my $old; $old = SelectSaver->new(qualify($_[0], caller)) if ref($_[0]); my $prev = $~; $~ = qualify($_[1], caller) if @_ > 1; $prev; } sub format_top_name { my $old; $old = SelectSaver->new(qualify($_[0], caller)) if ref($_[0]); my $prev = $^; $^ = qualify($_[1], caller) if @_ > 1; $prev; } sub format_line_break_characters { carp "format_line_break_characters is not supported on a per-handle basis" if ref($_[0]); my $prev = $:; $: = $_[1] if @_ > 1; $prev; } sub format_formfeed { carp "format_formfeed is not supported on a per-handle basis" if ref($_[0]); my $prev = $^L; $^L = $_[1] if @_ > 1; $prev; } sub formline { my $io = shift; my $picture = shift; local($^A) = $^A; local($\) = ""; formline($picture, @_); print $io $^A; } sub format_write { @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )'; if (@_ == 2) { my ($io, $fmt) = @_; my $oldfmt = $io->format_name(qualify($fmt,caller)); CORE::write($io); $io->format_name($oldfmt); } else { CORE::write($_[0]); } } sub fcntl { @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );'; my ($io, $op) = @_; return fcntl($io, $op, $_[2]); } sub ioctl { @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );'; my ($io, $op) = @_; return ioctl($io, $op, $_[2]); } # this sub is for compatibility with older releases of IO that used # a sub called constant to determine if a constant existed -- GMB # # The SEEK_* and _IO?BF constants were the only constants at that time # any new code should just check defined(&CONSTANT_NAME) sub constant { no strict 'refs'; my $name = shift; (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name}) ? &{$name}() : undef; } # so that flush.pl can be deprecated sub printflush { my $io = shift; my $old; $old = SelectSaver->new(qualify($io, caller)) if ref($io); local $| = 1; if(ref($io)) { print $io @_; } else { print @_; } } 1; Select.pm 0000644 00000022057 15125156224 0006332 0 ustar 00 # IO::Select.pm # # Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package IO::Select; use strict; use warnings::register; require Exporter; our $VERSION = "1.42"; our @ISA = qw(Exporter); # This is only so we can do version checking sub VEC_BITS () {0} sub FD_COUNT () {1} sub FIRST_FD () {2} sub new { my $self = shift; my $type = ref($self) || $self; my $vec = bless [undef,0], $type; $vec->add(@_) if @_; $vec; } sub add { shift->_update('add', @_); } sub remove { shift->_update('remove', @_); } sub exists { my $vec = shift; my $fno = $vec->_fileno(shift); return undef unless defined $fno; $vec->[$fno + FIRST_FD]; } sub _fileno { my($self, $f) = @_; return unless defined $f; $f = $f->[0] if ref($f) eq 'ARRAY'; if($f =~ /^[0-9]+$/) { # plain file number return $f; } elsif(defined(my $fd = fileno($f))) { return $fd; } else { # Neither a plain file number nor an opened filehandle; but maybe it was # previously registered and has since been closed. ->remove still wants to # know what fileno it had foreach my $i ( FIRST_FD .. $#$self ) { return $i - FIRST_FD if $self->[$i] == $f; } return undef; } } sub _update { my $vec = shift; my $add = shift eq 'add'; my $bits = $vec->[VEC_BITS]; $bits = '' unless defined $bits; my $count = 0; my $f; foreach $f (@_) { my $fn = $vec->_fileno($f); if ($add) { next unless defined $fn; my $i = $fn + FIRST_FD; if (defined $vec->[$i]) { $vec->[$i] = $f; # if array rest might be different, so we update next; } $vec->[FD_COUNT]++; vec($bits, $fn, 1) = 1; $vec->[$i] = $f; } else { # remove if ( ! defined $fn ) { # remove if fileno undef'd $fn = 0; for my $fe (@{$vec}[FIRST_FD .. $#$vec]) { if (defined($fe) && $fe == $f) { $vec->[FD_COUNT]--; $fe = undef; vec($bits, $fn, 1) = 0; last; } ++$fn; } } else { my $i = $fn + FIRST_FD; next unless defined $vec->[$i]; $vec->[FD_COUNT]--; vec($bits, $fn, 1) = 0; $vec->[$i] = undef; } } $count++; } $vec->[VEC_BITS] = $vec->[FD_COUNT] ? $bits : undef; $count; } sub can_read { my $vec = shift; my $timeout = shift; my $r = $vec->[VEC_BITS]; defined($r) && (select($r,undef,undef,$timeout) > 0) ? handles($vec, $r) : (); } sub can_write { my $vec = shift; my $timeout = shift; my $w = $vec->[VEC_BITS]; defined($w) && (select(undef,$w,undef,$timeout) > 0) ? handles($vec, $w) : (); } sub has_exception { my $vec = shift; my $timeout = shift; my $e = $vec->[VEC_BITS]; defined($e) && (select(undef,undef,$e,$timeout) > 0) ? handles($vec, $e) : (); } sub has_error { warnings::warn("Call to deprecated method 'has_error', use 'has_exception'") if warnings::enabled(); goto &has_exception; } sub count { my $vec = shift; $vec->[FD_COUNT]; } sub bits { my $vec = shift; $vec->[VEC_BITS]; } sub as_string # for debugging { my $vec = shift; my $str = ref($vec) . ": "; my $bits = $vec->bits; my $count = $vec->count; $str .= defined($bits) ? unpack("b*", $bits) : "undef"; $str .= " $count"; my @handles = @$vec; splice(@handles, 0, FIRST_FD); for (@handles) { $str .= " " . (defined($_) ? "$_" : "-"); } $str; } sub _max { my($a,$b,$c) = @_; $a > $b ? $a > $c ? $a : $c : $b > $c ? $b : $c; } sub select { shift if defined $_[0] && !ref($_[0]); my($r,$w,$e,$t) = @_; my @result = (); my $rb = defined $r ? $r->[VEC_BITS] : undef; my $wb = defined $w ? $w->[VEC_BITS] : undef; my $eb = defined $e ? $e->[VEC_BITS] : undef; if(select($rb,$wb,$eb,$t) > 0) { my @r = (); my @w = (); my @e = (); my $i = _max(defined $r ? scalar(@$r)-1 : 0, defined $w ? scalar(@$w)-1 : 0, defined $e ? scalar(@$e)-1 : 0); for( ; $i >= FIRST_FD ; $i--) { my $j = $i - FIRST_FD; push(@r, $r->[$i]) if defined $rb && defined $r->[$i] && vec($rb, $j, 1); push(@w, $w->[$i]) if defined $wb && defined $w->[$i] && vec($wb, $j, 1); push(@e, $e->[$i]) if defined $eb && defined $e->[$i] && vec($eb, $j, 1); } @result = (\@r, \@w, \@e); } @result; } sub handles { my $vec = shift; my $bits = shift; my @h = (); my $i; my $max = scalar(@$vec) - 1; for ($i = FIRST_FD; $i <= $max; $i++) { next unless defined $vec->[$i]; push(@h, $vec->[$i]) if !defined($bits) || vec($bits, $i - FIRST_FD, 1); } @h; } 1; __END__ =head1 NAME IO::Select - OO interface to the select system call =head1 SYNOPSIS use IO::Select; $s = IO::Select->new(); $s->add(\*STDIN); $s->add($some_handle); @ready = $s->can_read($timeout); @ready = IO::Select->new(@handles)->can_read(0); =head1 DESCRIPTION The C<IO::Select> package implements an object approach to the system C<select> function call. It allows the user to see what IO handles, see L<IO::Handle>, are ready for reading, writing or have an exception pending. =head1 CONSTRUCTOR =over 4 =item new ( [ HANDLES ] ) The constructor creates a new object and optionally initialises it with a set of handles. =back =head1 METHODS =over 4 =item add ( HANDLES ) Add the list of handles to the C<IO::Select> object. It is these values that will be returned when an event occurs. C<IO::Select> keeps these values in a cache which is indexed by the C<fileno> of the handle, so if more than one handle with the same C<fileno> is specified then only the last one is cached. Each handle can be an C<IO::Handle> object, an integer or an array reference where the first element is an C<IO::Handle> or an integer. =item remove ( HANDLES ) Remove all the given handles from the object. This method also works by the C<fileno> of the handles. So the exact handles that were added need not be passed, just handles that have an equivalent C<fileno> =item exists ( HANDLE ) Returns a true value (actually the handle itself) if it is present. Returns undef otherwise. =item handles Return an array of all registered handles. =item can_read ( [ TIMEOUT ] ) Return an array of handles that are ready for reading. C<TIMEOUT> is the maximum amount of time to wait before returning an empty list (with C<$!> unchanged), in seconds, possibly fractional. If C<TIMEOUT> is not given and any handles are registered then the call will block indefinitely. Upon error, an empty list is returned, with C<$!> set to indicate the error. To distinguish between timeout and error, set C<$!> to zero before calling this method, and check it after an empty list is returned. =item can_write ( [ TIMEOUT ] ) Same as C<can_read> except check for handles that can be written to. =item has_exception ( [ TIMEOUT ] ) Same as C<can_read> except check for handles that have an exception condition, for example pending out-of-band data. =item count () Returns the number of handles that the object will check for when one of the C<can_> methods is called or the object is passed to the C<select> static method. =item bits() Return the bit string suitable as argument to the core select() call. =item select ( READ, WRITE, EXCEPTION [, TIMEOUT ] ) C<select> is a static method, that is you call it with the package name like C<new>. C<READ>, C<WRITE> and C<EXCEPTION> are either C<undef> or C<IO::Select> objects. C<TIMEOUT> is optional and has the same effect as for the core select call. If at least one handle is ready for the specified kind of operation, the result will be an array of 3 elements, each a reference to an array which will hold the handles that are ready for reading, writing and have exceptions respectively. Upon timeout, an empty list is returned, with C<$!> unchanged. Upon error, an empty list is returned, with C<$!> set to indicate the error. To distinguish between timeout and error, set C<$!> to zero before calling this method, and check it after an empty list is returned. =back =head1 EXAMPLE Here is a short example which shows how C<IO::Select> could be used to write a server which communicates with several sockets while also listening for more connections on a listen socket use IO::Select; use IO::Socket; $lsn = IO::Socket::INET->new(Listen => 1, LocalPort => 8080); $sel = IO::Select->new( $lsn ); while(@ready = $sel->can_read) { foreach $fh (@ready) { if($fh == $lsn) { # Create a new socket $new = $lsn->accept; $sel->add($new); } else { # Process socket # Maybe we have finished with the socket $sel->remove($fh); $fh->close; } } } =head1 AUTHOR Graham Barr. Currently maintained by the Perl Porters. Please report all bugs to <perlbug@perl.org>. =head1 COPYRIGHT Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Socket.pm 0000644 00000066251 15125156224 0006347 0 ustar 00 # IO::Socket.pm # # Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package IO::Socket; use 5.008_001; use IO::Handle; use Socket 1.3; use Carp; use strict; use Exporter; use Errno; # legacy require IO::Socket::INET; require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian'); our @ISA = qw(IO::Handle); our $VERSION = "1.43"; our @EXPORT_OK = qw(sockatmark); sub import { my $pkg = shift; if (@_ && $_[0] eq 'sockatmark') { # not very extensible but for now, fast Exporter::export_to_level('IO::Socket', 1, $pkg, 'sockatmark'); } else { my $callpkg = caller; Exporter::export 'Socket', $callpkg, @_; } } sub new { my($class,%arg) = @_; my $sock = $class->SUPER::new(); $sock->autoflush(1); ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout}; return scalar(%arg) ? $sock->configure(\%arg) : $sock; } my @domain2pkg; sub register_domain { my($p,$d) = @_; $domain2pkg[$d] = $p; } sub configure { my($sock,$arg) = @_; my $domain = delete $arg->{Domain}; croak 'IO::Socket: Cannot configure a generic socket' unless defined $domain; croak "IO::Socket: Unsupported socket domain" unless defined $domain2pkg[$domain]; croak "IO::Socket: Cannot configure socket in domain '$domain'" unless ref($sock) eq "IO::Socket"; bless($sock, $domain2pkg[$domain]); $sock->configure($arg); } sub socket { @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)'; my($sock,$domain,$type,$protocol) = @_; socket($sock,$domain,$type,$protocol) or return undef; ${*$sock}{'io_socket_domain'} = $domain; ${*$sock}{'io_socket_type'} = $type; # "A value of 0 for protocol will let the system select an # appropriate protocol" # so we need to look up what the system selected, # not cache PF_UNSPEC. ${*$sock}{'io_socket_proto'} = $protocol if $protocol; $sock; } sub socketpair { @_ == 4 || croak 'usage: IO::Socket->socketpair(DOMAIN, TYPE, PROTOCOL)'; my($class,$domain,$type,$protocol) = @_; my $sock1 = $class->new(); my $sock2 = $class->new(); socketpair($sock1,$sock2,$domain,$type,$protocol) or return (); ${*$sock1}{'io_socket_type'} = ${*$sock2}{'io_socket_type'} = $type; ${*$sock1}{'io_socket_proto'} = ${*$sock2}{'io_socket_proto'} = $protocol; ($sock1,$sock2); } sub connect { @_ == 2 or croak 'usage: $sock->connect(NAME)'; my $sock = shift; my $addr = shift; my $timeout = ${*$sock}{'io_socket_timeout'}; my $err; my $blocking; $blocking = $sock->blocking(0) if $timeout; if (!connect($sock, $addr)) { if (defined $timeout && ($!{EINPROGRESS} || $!{EWOULDBLOCK})) { require IO::Select; my $sel = new IO::Select $sock; undef $!; my($r,$w,$e) = IO::Select::select(undef,$sel,$sel,$timeout); if(@$e[0]) { # Windows return from select after the timeout in case of # WSAECONNREFUSED(10061) if exception set is not used. # This behavior is different from Linux. # Using the exception # set we now emulate the behavior in Linux # - Karthik Rajagopalan $err = $sock->getsockopt(SOL_SOCKET,SO_ERROR); $@ = "connect: $err"; } elsif(!@$w[0]) { $err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1); $@ = "connect: timeout"; } elsif (!connect($sock,$addr) && not ($!{EISCONN} || ($^O eq 'MSWin32' && ($! == (($] < 5.019004) ? 10022 : Errno::EINVAL)))) ) { # Some systems refuse to re-connect() to # an already open socket and set errno to EISCONN. # Windows sets errno to WSAEINVAL (10022) (pre-5.19.4) or # EINVAL (22) (5.19.4 onwards). $err = $!; $@ = "connect: $!"; } } elsif ($blocking || !($!{EINPROGRESS} || $!{EWOULDBLOCK})) { $err = $!; $@ = "connect: $!"; } } $sock->blocking(1) if $blocking; $! = $err if $err; $err ? undef : $sock; } # Enable/disable blocking IO on sockets. # Without args return the current status of blocking, # with args change the mode as appropriate, returning the # old setting, or in case of error during the mode change # undef. sub blocking { my $sock = shift; return $sock->SUPER::blocking(@_) if $^O ne 'MSWin32' && $^O ne 'VMS'; # Windows handles blocking differently # # http://groups.google.co.uk/group/perl.perl5.porters/browse_thread/thread/b4e2b1d88280ddff/630b667a66e3509f?#630b667a66e3509f # http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winsock/winsock/ioctlsocket_2.asp # # 0x8004667e is FIONBIO # # which is used to set blocking behaviour. # NOTE: # This is a little confusing, the perl keyword for this is # 'blocking' but the OS level behaviour is 'non-blocking', probably # because sockets are blocking by default. # Therefore internally we have to reverse the semantics. my $orig= !${*$sock}{io_sock_nonblocking}; return $orig unless @_; my $block = shift; if ( !$block != !$orig ) { ${*$sock}{io_sock_nonblocking} = $block ? 0 : 1; ioctl($sock, 0x8004667e, pack("L!",${*$sock}{io_sock_nonblocking})) or return undef; } return $orig; } sub close { @_ == 1 or croak 'usage: $sock->close()'; my $sock = shift; ${*$sock}{'io_socket_peername'} = undef; $sock->SUPER::close(); } sub bind { @_ == 2 or croak 'usage: $sock->bind(NAME)'; my $sock = shift; my $addr = shift; return bind($sock, $addr) ? $sock : undef; } sub listen { @_ >= 1 && @_ <= 2 or croak 'usage: $sock->listen([QUEUE])'; my($sock,$queue) = @_; $queue = 5 unless $queue && $queue > 0; return listen($sock, $queue) ? $sock : undef; } sub accept { @_ == 1 || @_ == 2 or croak 'usage $sock->accept([PKG])'; my $sock = shift; my $pkg = shift || $sock; my $timeout = ${*$sock}{'io_socket_timeout'}; my $new = $pkg->new(Timeout => $timeout); my $peer = undef; if(defined $timeout) { require IO::Select; my $sel = new IO::Select $sock; unless ($sel->can_read($timeout)) { $@ = 'accept: timeout'; $! = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1); return; } } $peer = accept($new,$sock) or return; ${*$new}{$_} = ${*$sock}{$_} for qw( io_socket_domain io_socket_type io_socket_proto ); return wantarray ? ($new, $peer) : $new; } sub sockname { @_ == 1 or croak 'usage: $sock->sockname()'; getsockname($_[0]); } sub peername { @_ == 1 or croak 'usage: $sock->peername()'; my($sock) = @_; ${*$sock}{'io_socket_peername'} ||= getpeername($sock); } sub connected { @_ == 1 or croak 'usage: $sock->connected()'; my($sock) = @_; getpeername($sock); } sub send { @_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])'; my $sock = $_[0]; my $flags = $_[2] || 0; my $peer; if ($_[3]) { # the caller explicitly requested a TO, so use it # this is non-portable for "connected" UDP sockets $peer = $_[3]; } elsif (!defined getpeername($sock)) { # we're not connected, so we require a peer from somewhere $peer = $sock->peername; croak 'send: Cannot determine peer address' unless(defined $peer); } my $r = $peer ? send($sock, $_[1], $flags, $peer) : send($sock, $_[1], $flags); # remember who we send to, if it was successful ${*$sock}{'io_socket_peername'} = $peer if(@_ == 4 && defined $r); $r; } sub recv { @_ == 3 || @_ == 4 or croak 'usage: $sock->recv(BUF, LEN [, FLAGS])'; my $sock = $_[0]; my $len = $_[2]; my $flags = $_[3] || 0; # remember who we recv'd from ${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags); } sub shutdown { @_ == 2 or croak 'usage: $sock->shutdown(HOW)'; my($sock, $how) = @_; ${*$sock}{'io_socket_peername'} = undef; shutdown($sock, $how); } sub setsockopt { @_ == 4 or croak '$sock->setsockopt(LEVEL, OPTNAME, OPTVAL)'; setsockopt($_[0],$_[1],$_[2],$_[3]); } my $intsize = length(pack("i",0)); sub getsockopt { @_ == 3 or croak '$sock->getsockopt(LEVEL, OPTNAME)'; my $r = getsockopt($_[0],$_[1],$_[2]); # Just a guess $r = unpack("i", $r) if(defined $r && length($r) == $intsize); $r; } sub sockopt { my $sock = shift; @_ == 1 ? $sock->getsockopt(SOL_SOCKET,@_) : $sock->setsockopt(SOL_SOCKET,@_); } sub atmark { @_ == 1 or croak 'usage: $sock->atmark()'; my($sock) = @_; sockatmark($sock); } sub timeout { @_ == 1 || @_ == 2 or croak 'usage: $sock->timeout([VALUE])'; my($sock,$val) = @_; my $r = ${*$sock}{'io_socket_timeout'}; ${*$sock}{'io_socket_timeout'} = defined $val ? 0 + $val : $val if(@_ == 2); $r; } sub sockdomain { @_ == 1 or croak 'usage: $sock->sockdomain()'; my $sock = shift; if (!defined(${*$sock}{'io_socket_domain'})) { my $addr = $sock->sockname(); ${*$sock}{'io_socket_domain'} = sockaddr_family($addr) if (defined($addr)); } ${*$sock}{'io_socket_domain'}; } sub socktype { @_ == 1 or croak 'usage: $sock->socktype()'; my $sock = shift; ${*$sock}{'io_socket_type'} = $sock->sockopt(Socket::SO_TYPE) if (!defined(${*$sock}{'io_socket_type'}) && defined(eval{Socket::SO_TYPE})); ${*$sock}{'io_socket_type'} } sub protocol { @_ == 1 or croak 'usage: $sock->protocol()'; my($sock) = @_; ${*$sock}{'io_socket_proto'} = $sock->sockopt(Socket::SO_PROTOCOL) if (!defined(${*$sock}{'io_socket_proto'}) && defined(eval{Socket::SO_PROTOCOL})); ${*$sock}{'io_socket_proto'}; } 1; __END__ =head1 NAME IO::Socket - Object interface to socket communications =head1 SYNOPSIS use strict; use warnings; use IO::Socket qw(AF_INET AF_UNIX); # create a new AF_INET socket my $sock = IO::Socket->new(Domain => AF_INET); # which is the same as $sock = IO::Socket::INET->new(); # create a new AF_UNIX socket $sock = IO::Socket->new(Domain => AF_UNIX); # which is the same as $sock = IO::Socket::UNIX->new(); =head1 DESCRIPTION C<IO::Socket> provides an object-oriented, L<IO::Handle>-based interface to creating and using sockets via L<Socket>, which provides a near one-to-one interface to the C socket library. C<IO::Socket> is a base class that really only defines methods for those operations which are common to all types of sockets. Operations which are specific to a particular socket domain have methods defined in subclasses of C<IO::Socket>. See L<IO::Socket::INET>, L<IO::Socket::UNIX>, and L<IO::Socket::IP> for examples of such a subclass. C<IO::Socket> will export all functions (and constants) defined by L<Socket>. =head1 CONSTRUCTOR ARGUMENTS Given that C<IO::Socket> doesn't have attributes in the traditional sense, the following arguments, rather than attributes, can be passed into the constructor. Constructor arguments should be passed in C<< Key => 'Value' >> pairs. The only required argument is L<IO::Socket/"Domain">. =head2 Blocking my $sock = IO::Socket->new(..., Blocking => 1); $sock = IO::Socket->new(..., Blocking => 0); If defined but false, the socket will be set to non-blocking mode. If not specified it defaults to C<1> (blocking mode). =head2 Domain my $sock = IO::Socket->new(Domain => IO::Socket::AF_INET); $sock = IO::Socket->new(Domain => IO::Socket::AF_UNIX); The socket domain will define which subclass of C<IO::Socket> to use. The two options available along with this distribution are C<AF_INET> and C<AF_UNIX>. C<AF_INET> is for the internet address family of sockets and is handled via L<IO::Socket::INET>. C<AF_INET> sockets are bound to an internet address and port. C<AF_UNIX> is for the unix domain socket and is handled via L<IO::Socket::UNIX>. C<AF_UNIX> sockets are bound to the file system as their address name space. This argument is B<required>. All other arguments are optional. =head2 Listen my $sock = IO::Socket->new(..., Listen => 5); Listen should be an integer value or left unset. If provided, this argument will place the socket into listening mode. New connections can then be accepted using the L<IO::Socket/"accept"> method. The value given is used as the C<listen(2)> queue size. If the C<Listen> argument is given, but false, the queue size will be set to 5. =head2 Timeout my $sock = IO::Socket->new(..., Timeout => 5); The timeout value, in seconds, for this socket connection. How exactly this value is utilized is defined in the socket domain subclasses that make use of the value. =head2 Type my $sock = IO::Socket->new(..., Type => IO::Socket::SOCK_STREAM); The socket type that will be used. These are usually C<SOCK_STREAM>, C<SOCK_DGRAM>, or C<SOCK_RAW>. If this argument is left undefined an attempt will be made to infer the type from the service name. For example, you'll usually use C<SOCK_STREAM> with a C<tcp> connection and C<SOCK_DGRAM> with a C<udp> connection. =head1 CONSTRUCTORS C<IO::Socket> extends the L<IO::Handle> constructor. =head2 new my $sock = IO::Socket->new(); # get a new IO::Socket::INET instance $sock = IO::Socket->new(Domain => IO::Socket::AF_INET); # get a new IO::Socket::UNIX instance $sock = IO::Socket->new(Domain => IO::Socket::AF_UNIX); # Domain is the only required argument $sock = IO::Socket->new( Domain => IO::Socket::AF_INET, # AF_INET, AF_UNIX Type => IO::Socket::SOCK_STREAM, # SOCK_STREAM, SOCK_DGRAM, ... Proto => 'tcp', # 'tcp', 'udp', IPPROTO_TCP, IPPROTO_UDP # and so on... ); Creates an C<IO::Socket>, which is a reference to a newly created symbol (see the L<Symbol> package). C<new> optionally takes arguments, these arguments are defined in L<IO::Socket/"CONSTRUCTOR ARGUMENTS">. Any of the L<IO::Socket/"CONSTRUCTOR ARGUMENTS"> may be passed to the constructor, but if any arguments are provided, then one of them must be the L<IO::Socket/"Domain"> argument. The L<IO::Socket/"Domain"> argument can, by default, be either C<AF_INET> or C<AF_UNIX>. Other domains can be used if a proper subclass for the domain family is registered. All other arguments will be passed to the C<configuration> method of the package for that domain. =head1 METHODS C<IO::Socket> inherits all methods from L<IO::Handle> and implements the following new ones. =head2 accept my $client_sock = $sock->accept(); my $inet_sock = $sock->accept('IO::Socket::INET'); The accept method will perform the system call C<accept> on the socket and return a new object. The new object will be created in the same class as the listen socket, unless a specific package name is specified. This object can be used to communicate with the client that was trying to connect. This differs slightly from the C<accept> function in L<perlfunc>. In a scalar context the new socket is returned, or C<undef> upon failure. In a list context a two-element array is returned containing the new socket and the peer address; the list will be empty upon failure. =head2 atmark my $integer = $sock->atmark(); # read in some data on a given socket my $data; $sock->read($data, 1024) until $sock->atmark; # or, export the function to use: use IO::Socket 'sockatmark'; $sock->read($data, 1024) until sockatmark($sock); True if the socket is currently positioned at the urgent data mark, false otherwise. If your system doesn't yet implement C<sockatmark> this will throw an exception. If your system does not support C<sockatmark>, the C<use> declaration will fail at compile time. =head2 autoflush # by default, autoflush will be turned on when referenced $sock->autoflush(); # turns on autoflush # turn off autoflush $sock->autoflush(0); # turn on autoflush $sock->autoflush(1); This attribute isn't overridden from L<IO::Handle>'s implementation. However, since we turn it on by default, it's worth mentioning here. =head2 bind use Socket qw(pack_sockaddr_in); my $port = 3000; my $ip_address = '0.0.0.0'; my $packed_addr = pack_sockaddr_in($port, $ip_address); $sock->bind($packed_addr); Binds a network address to a socket, just as C<bind(2)> does. Returns true if it succeeded, false otherwise. You should provide a packed address of the appropriate type for the socket. =head2 connected my $peer_addr = $sock->connected(); if ($peer_addr) { say "We're connected to $peer_addr"; } If the socket is in a connected state, the peer address is returned. If the socket is not in a connected state, C<undef> is returned. Note that this method considers a half-open TCP socket to be "in a connected state". Specifically, it does not distinguish between the B<ESTABLISHED> and B<CLOSE-WAIT> TCP states; it returns the peer address, rather than C<undef>, in either case. Thus, in general, it cannot be used to reliably learn whether the peer has initiated a graceful shutdown because in most cases (see below) the local TCP state machine remains in B<CLOSE-WAIT> until the local application calls L<IO::Socket/"shutdown"> or C<close>. Only at that point does this function return C<undef>. The "in most cases" hedge is because local TCP state machine behavior may depend on the peer's socket options. In particular, if the peer socket has C<SO_LINGER> enabled with a zero timeout, then the peer's C<close> will generate a C<RST> segment. Upon receipt of that segment, the local TCP transitions immediately to B<CLOSED>, and in that state, this method I<will> return C<undef>. =head2 getsockopt my $value = $sock->getsockopt(SOL_SOCKET, SO_REUSEADDR); my $buf = $socket->getsockopt(SOL_SOCKET, SO_RCVBUF); say "Receive buffer is $buf bytes"; Get an option associated with the socket. Levels other than C<SOL_SOCKET> may be specified here. As a convenience, this method will unpack a byte buffer of the correct size back into a number. =head2 listen $sock->listen(5); Does the same thing that the C<listen(2)> system call does. Returns true if it succeeded, false otherwise. Listens to a socket with a given queue size. =head2 peername my $sockaddr_in = $sock->peername(); Returns the packed C<sockaddr> address of the other end of the socket connection. It calls C<getpeername>. =head2 protocol my $proto = $sock->protocol(); Returns the number for the protocol being used on the socket, if known. If the protocol is unknown, as with an C<AF_UNIX> socket, zero is returned. =head2 recv my $buffer = ""; my $length = 1024; my $flags = 0; # default. optional $sock->recv($buffer, $length); $sock->recv($buffer, $length, $flags); Similar in functionality to L<perlfunc/recv>. Receives a message on a socket. Attempts to receive C<$length> characters of data into C<$buffer> from the specified socket. C<$buffer> will be grown or shrunk to the length actually read. Takes the same flags as the system call of the same name. Returns the address of the sender if socket's protocol supports this; returns an empty string otherwise. If there's an error, returns C<undef>. This call is actually implemented in terms of the C<recvfrom(2)> system call. Flags are ORed together values, such as C<MSG_BCAST>, C<MSG_OOB>, C<MSG_TRUNC>. The default value for the flags is C<0>. The cached value of L<IO::Socket/"peername"> is updated with the result of C<recv>. B<Note:> In Perl v5.30 and newer, if the socket has been marked as C<:utf8>, C<recv> will throw an exception. The C<:encoding(...)> layer implicitly introduces the C<:utf8> layer. See L<perlfunc/binmode>. B<Note:> In Perl versions older than v5.30, depending on the status of the socket, either (8-bit) bytes or characters are received. By default all sockets operate on bytes, but for example if the socket has been changed using L<perlfunc/binmode> to operate with the C<:encoding(UTF-8)> I/O layer (see the L<perlfunc/open> pragma), the I/O will operate on UTF8-encoded Unicode characters, not bytes. Similarly for the C<:encoding> layer: in that case pretty much any characters can be read. =head2 send my $message = "Hello, world!"; my $flags = 0; # defaults to zero my $to = '0.0.0.0'; # optional destination my $sent = $sock->send($message); $sent = $sock->send($message, $flags); $sent = $sock->send($message, $flags, $to); Similar in functionality to L<perlfunc/send>. Sends a message on a socket. Attempts to send the scalar message to the socket. Takes the same flags as the system call of the same name. On unconnected sockets, you must specify a destination to send to, in which case it does a C<sendto(2)> syscall. Returns the number of characters sent, or C<undef> on error. The C<sendmsg(2)> syscall is currently unimplemented. The C<flags> option is optional and defaults to C<0>. After a successful send with C<$to>, further calls to C<send> on an unconnected socket without C<$to> will send to the same address, and C<$to> will be used as the result of L<IO::Socket/"peername">. B<Note:> In Perl v5.30 and newer, if the socket has been marked as C<:utf8>, C<send> will throw an exception. The C<:encoding(...)> layer implicitly introduces the C<:utf8> layer. See L<perlfunc/binmode>. B<Note:> In Perl versions older than v5.30, depending on the status of the socket, either (8-bit) bytes or characters are sent. By default all sockets operate on bytes, but for example if the socket has been changed using L<perlfunc/binmode> to operate with the C<:encoding(UTF-8)> I/O layer (see the L<perlfunc/open> pragma), the I/O will operate on UTF8-encoded Unicode characters, not bytes. Similarly for the C<:encoding> layer: in that case pretty much any characters can be sent. =head2 setsockopt $sock->setsockopt(SOL_SOCKET, SO_REUSEADDR, 1); $sock->setsockopt(SOL_SOCKET, SO_RCVBUF, 64*1024); Set option associated with the socket. Levels other than C<SOL_SOCKET> may be specified here. As a convenience, this method will convert a number into a packed byte buffer. =head2 shutdown $sock->shutdown(SHUT_RD); # we stopped reading data $sock->shutdown(SHUT_WR); # we stopped writing data $sock->shutdown(SHUT_RDWR); # we stopped using this socket Shuts down a socket connection in the manner indicated by the value passed in, which has the same interpretation as in the syscall of the same name. This is useful with sockets when you want to tell the other side you're done writing but not done reading, or vice versa. It's also a more insistent form of C<close> because it also disables the file descriptor in any forked copies in other processes. Returns C<1> for success; on error, returns C<undef> if the socket is not a valid filehandle, or returns C<0> and sets C<$!> for any other failure. =head2 sockdomain my $domain = $sock->sockdomain(); Returns the number for the socket domain type. For example, for an C<AF_INET> socket the value of C<&AF_INET> will be returned. =head2 socket my $sock = IO::Socket->new(); # no values given # now let's actually get a socket with the socket method # domain, type, and protocol are required $sock = $sock->socket(AF_INET, SOCK_STREAM, 'tcp'); Opens a socket of the specified kind and returns it. Domain, type, and protocol are specified the same as for the syscall of the same name. =head2 socketpair my ($r, $w) = $sock->socketpair(AF_UNIX, SOCK_STREAM, PF_UNSPEC); ($r, $w) = IO::Socket::UNIX ->socketpair(AF_UNIX, SOCK_STREAM, PF_UNSPEC); Will return a list of two sockets created (read and write), or an empty list on failure. Differs slightly from C<socketpair> in L<perlfunc> in that the argument list is a bit simpler. =head2 sockname my $packed_addr = $sock->sockname(); Returns the packed C<sockaddr> address of this end of the connection. It's the same as C<getsockname(2)>. =head2 sockopt my $value = $sock->sockopt(SO_REUSEADDR); $sock->sockopt(SO_REUSEADDR, 1); Unified method to both set and get options in the C<SOL_SOCKET> level. If called with one argument then L<IO::Socket/"getsockopt"> is called, otherwise L<IO::Socket/"setsockopt"> is called. =head2 socktype my $type = $sock->socktype(); Returns the number for the socket type. For example, for a C<SOCK_STREAM> socket the value of C<&SOCK_STREAM> will be returned. =head2 timeout my $seconds = $sock->timeout(); my $old_val = $sock->timeout(5); # set new and return old value Set or get the timeout value (in seconds) associated with this socket. If called without any arguments then the current setting is returned. If called with an argument the current setting is changed and the previous value returned. This method is available to all C<IO::Socket> implementations but may or may not be used by the individual domain subclasses. =head1 EXAMPLES Let's create a TCP server on C<localhost:3333>. use strict; use warnings; use feature 'say'; use IO::Socket qw(AF_INET AF_UNIX SOCK_STREAM SHUT_WR); my $server = IO::Socket->new( Domain => AF_INET, Type => SOCK_STREAM, Proto => 'tcp', LocalHost => '0.0.0.0', LocalPort => 3333, ReusePort => 1, Listen => 5, ) || die "Can't open socket: $@"; say "Waiting on 3333"; while (1) { # waiting for a new client connection my $client = $server->accept(); # get information about a newly connected client my $client_address = $client->peerhost(); my $client_port = $client->peerport(); say "Connection from $client_address:$client_port"; # read up to 1024 characters from the connected client my $data = ""; $client->recv($data, 1024); say "received data: $data"; # write response data to the connected client $data = "ok"; $client->send($data); # notify client that response has been sent $client->shutdown(SHUT_WR); } $server->close(); A client for such a server could be use strict; use warnings; use feature 'say'; use IO::Socket qw(AF_INET AF_UNIX SOCK_STREAM SHUT_WR); my $client = IO::Socket->new( Domain => AF_INET, Type => SOCK_STREAM, proto => 'tcp', PeerPort => 3333, PeerHost => '0.0.0.0', ) || die "Can't open socket: $@"; say "Sending Hello World!"; my $size = $client->send("Hello World!"); say "Sent data of length: $size"; $client->shutdown(SHUT_WR); my $buffer; $client->recv($buffer, 1024); say "Got back $buffer"; $client->close(); =head1 LIMITATIONS On some systems, for an IO::Socket object created with C<new_from_fd>, or created with L<IO::Socket/"accept"> from such an object, the L<IO::Socket/"protocol">, L<IO::Socket/"sockdomain"> and L<IO::Socket/"socktype"> methods may return C<undef>. =head1 SEE ALSO L<Socket>, L<IO::Handle>, L<IO::Socket::INET>, L<IO::Socket::UNIX>, L<IO::Socket::IP> =head1 AUTHOR Graham Barr. atmark() by Lincoln Stein. Currently maintained by the Perl Porters. Please report all bugs to <perlbug@perl.org>. =head1 COPYRIGHT Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The atmark() implementation: Copyright 2001, Lincoln Stein <lstein@cshl.org>. This module is distributed under the same terms as Perl itself. Feel free to use, modify and redistribute it as long as you retain the correct attribution. =cut IO.so 0000755 00000066040 15125175620 0005433 0 ustar 00 ELF > 0& @ `e @ 8 @ � � P P P � � 8\ 8l 8l � � P\ Pl Pl � � � � � � � � $ $ S�td � � � P�td �S �S �S � � Q�td R�td 8\ 8l 8l � � GNU � GNU !�餆\U %�b�� I}�� 5 5 �V�� } � � � � $ � � 2 r c � ! s V C � � � D F � � � � � t 6 � V 6 � � � U � � � � + d , � � F " a � �; M __gmon_start__ _ITM_deregisterTMCloneTable _ITM_registerTMCloneTable __cxa_finalize Perl_sv_2io Perl_sv_newmortal PerlIO_getpos __errno_location Perl_croak_xs_usage PerlIO_setpos Perl_sv_setpvn Perl_sv_setiv PerlIO_tmpfile Perl_newGVgen_flags Perl_hv_common_key_len Perl_do_openn Perl_sv_2pv_flags Perl_newRV Perl_sv_2mortal Perl_gv_stashpv Perl_sv_bless Perl_sv_free2 Perl_newSV Perl_sv_2iv_flags poll Perl_newSViv Perl_PerlIO_fileno fcntl64 Perl_sv_setiv_mg Perl_croak_nocontext PerlIO_isutf8 Perl_uvoffuni_to_utf8_flags_msgs Perl_PerlIO_unread Perl_sv_2uv_flags PerlIO_ungetc Perl_sv_2nv_flags Perl_newSVuv __stack_chk_fail Perl_PerlIO_error Perl_PerlIO_clearerr Perl_PerlIO_flush Perl_croak fsync PL_ppaddr Perl_stack_grow sockatmark boot_IO Perl_xs_handshake Perl_newXS_deffile Perl_newXS_flags Perl_gv_stashpvn Perl_newCONSTSUB Perl_xs_boot_epilog libperl.so.5.32 libc.so.6 GLIBC_2.28 GLIBC_2.4 GLIBC_2.2.5 g ��� q ii | ui � 8l �& @l �& Hl Hl �o �o �o # �o 0 �o 3 Xn `n hn pn xn �n �n �n �n �n �n �n �n �n �n �n �n �n �n �n �n o o o o o (o 0o 8o @o Ho ! Po " Xo $ `o % ho & po ' xo ( �o ) �o * �o + �o , �o - �o . �o / �o 1 �o 2 �o 3 �o 4 � �H��H��O H��t��H��� �5"N �%#N � �h ������ �h ������� �h ������ �h ������ �h ������ �h ������ �h ������ �h ��q����� �h ��a����� �h ��Q����� �h ��A����� �h ��1����� �h ��!����� �h ������� �h ������� �h ����� �h ������ �h ������� �h ������ �h ������ �h ������ �h ������ �h ������ �h ��q����� �h ��a����� �h ��Q����� �h ��A����� �h ��1����� �h ��!����� �h ������� �h ������� �h ����� �h ������ �h! ������� �h" ������ �h# ������ �h$ ������ �h% ������ �h& ������ �h' ��q����� �h( ��a����� �h) ��Q����� �h* ��A����� �h+ ��1����� �h, ��!����� �h- ������� �h. ������� �h/ ����� ��% K D � ��%K D � ��% K D � ��%K D � ��%�J D � ��%�J D � ��%�J D � ��%�J D � ��%�J D � ��%�J D � ��%�J D � ��%�J D � ��%�J D � ��%�J D � ��%�J D � ��%�J D � ��%�J D � ��%�J D � ��%�J D � ��%�J D � ��%}J D � ��%uJ D � ��%mJ D � ��%eJ D � ��%]J D � ��%UJ D � ��%MJ D � ��%EJ D � ��%=J D � ��%5J D � ��%-J D � ��%%J D � ��% J D � ��%J D � ��% J D � ��%J D � ��%�I D � ��%�I D � ��%�I D � ��%�I D � ��%�I D � ��%�I D � ��%�I D � ��%�I D � ��%�I D � ��%�I D � ��%�I D � ��%�I D H�=�I H��I H9�tH��I H��t �� � � � H�=�I H�5�I H)�H��H��?H��H�H�tH�eI H��t��f D � � � ��=UI u+UH�=BI H��t H�=�E �I����d����-I ]� � � � ��w��� � � �AVAUATUSH�GxH��H�P�H�WxH�WHc H� hH�H)�H������ Hc�H�4�L�$� �@���L�hM��tGL�sH������L��M�I�H�CH�4������tH�CH��P H��LcL�#[]A\A]A^�f�����H��P � H�CH����H��H�5J( ��� D � �AVAUATUSH�GxH��H�P�H�WxH�WHc H� �H��D�`H�H)�H������ Mc��J�4�Hc�N�,� �f���H�xH�CH�4�H��te���H��A�����H��A���t E��u7� H��' H��H���`���H�CJ�,�LkL�+[]A\A]A^� � Ic�H��H���r���������H��� �}���H���H��H�5U' ���f � � �AWAVAUATUSH��H��H�GxH�P�H�WxH�WHc H� �D�`H�H)�H�����| Mc�L�5' N�,� ��~J�4�F % = �� L�v�w���1�L��H��I���w���H��H���� �@H� H��E1�A�D H��H�P H�p(�Jj H���.���XZj j E1�E1�� AWH��& H��H��j ���H�� ��uoH�CH��P J��U���� ���ULkL�+H��[]A\A]A^A_� � � 1��4���I���0��� @ H�CH��P J��� � H��H�����L�{H��H�����M� L��I�H���@���H��H��H�CJ�4�����U���]���H��H���f����S���H��H�5�% ���f�� �AWI��H��AVAUATUSH��(I�GxM�'H�P�I�WxI�WHc0H��FH�4�I)�I��E���� H�H�4�H� � H� $�F % = �� H��@ �D$ A��L��A�Ic�H�4� H�D$���L��H�����E���f L�p��F�$cA��L�t$L���Lf D H��@ A�A�EI�WH�H�4F % = uRH��@ fA�FA��1�I��fA�F�E9�tBI�WIc�H�4F % = t�� L���k����f � � L���S���릐�T$ H�t$H�|$�m���A�ƅ�xCf D I�GHc�HcU L��H��H�4����I�w�CL��H�H�U���H�4�����A9�u�Ic�L�����L�4$I�_L��H������L�H�MwM�7H��([]A\A]A^A_�f � � L������D$ �q���f. � �T$ 1�H�����A���H�5�# ����� �AWAVAUATUSH��H��H�GxH�/H�P�H�WxHcH�GI��D�jH��H)�H���U����j Mc�J�4�N�4� �c���L�x��� H�CA��Mc�J�4�F % = �� H�1�@ ��@��M���� L��H������A�ą��� 1҉Ǿ 1�������� ��� ��A��A������ ��9�t1�� D�������xlA��H��� ���H�kH��H���A���L�H�E LsL�3H��[]A\A]A^A_� @ � H��1��!�����@���@���f D �K���� D H�CH��P J��Ls� @��@��l-����� � ���[������:���H��H�5�! ���ff. � � �AUATUSH��H��H��H�CxH�KH�P�H�SxHc H�4��PH�H)�H������ Hc�L�,�L�$� H�C�@#tnH�PH�CL��H��H�,�����H��tmH� E1���� H�CN�l ��E ������ud��� t[��L�E�E I�mLcL�#H��[]A\A]� H�����L��H��H������H��u���I������ �f � L��H��H���R��H�5Y ��� @ � �USH��H��H��H�CxH�KH�P�H�SxHc H�4��PH�H)�H����~4Hc�H��H�4�H�,� ���H� H�x( u H�CH�D(�H�H��[]�H�5: �H�H�5: H�=b" 1��� � �AWAVAUATUSH��H��H��8H�KdH�%( H�D$(H�CxH�P�H�SxHc H�4�H�ōPH�H)�H������ Hc�H�߃�H�4�L�$� Hc����L�hH�CL�4�H�C�@#�� H�PH�CH�,�M���� A�F �� ��� �& ��t&�� �� �� I�f�f/B(�� % �= �� I�L�p I���' I��� wL������ L������� L�L$E1�1�L��L��H��L�L$���L�L$L��H��L)�L��H��I����I�����I9��� H�C�U N�l ���%������< ��� �/ ��L�E�U I�mLcL�#H�D$(dH+%( �g H��8[]A\A]A^A_� � �� �� �� I�H�z �� ������� D L��� H��� �I��I������D��L�����Lc��8���H����H��M���N������I������ � ��� D � L��H����f��f/�wYA�F % �= ��W����m��� D � L��H���8�H��x&A�F ���������L��H��H���������H�=� 1��� � L��H�����H�kH��H�����L�H�E LcL�#���H�5 ���j�H�=k �N�ff. � � �AVAUATUSH��H��H�CxH�KH�P�H�SxHc H�4��PH�H)�H����� Hc�H��H�4�L�$� ��L�hH� L�p(H�C�@#�� H�PH�CH�,�M���| L��H����� ��tHH�CN�l ��E ���������� ��� �~ ��H�U�E I�mLcL�#[]A\A]A^�M��tKM9�tFL��H���{�1҅����f����H������ � @ H���p�H���S��� � 1��a���f � H��H�����|���H�5 �� @ � �AWAVAUATUSH��H��H��H�CxH�KH�P�H�SxHc H�4��PH�H)�H����� Hc�H��L�,�L�$� L���1�L�pH� L�@(H�C�@#�� H�PH�CH�,�L�D$M��trL��H��E1����L�D$M9�t L��H����H�CN�l ��E ������un��� te��L�}�E I�mLcL�#H��[]A\A]A^A_�f � �{�I������ � @ H��L�D$� �L�D$H���R���f D L��H��H�����H�5� �,�ff. � �� �AVAUATUSH�GxH��H�P�H�WxH�WHc H� hH�H)�H������ Hc�H�4�L�,� ���H� H�p(H��tdH����H��A���a�I��A���t E��u3� H�: H��H�����H�CL�$�LkL�+[]A\A]A^� @ Ic�H��H��������[�H��� ��I���H��H�5� �9�f � � �PXH��H�GxH�P�H�WxHcH�GH��H�H)�H����tH�5� 1��2�H�5 H�= 1��=�ff. � f�� �AVAUATUSH�GxH��H�P�H�WxH�WHc H� hH�H)�H������ Hc�L�$�L�,� L����H� H�p(H���� H���5��Dž�y/�Z�H��� ��I��H�CL�$�LkL�+[]A\A]A^Ð�[�H��A�����I��A���t�E��u"� H�� H��H���K��f � Ic�H��H���r��L��H�����H�pH���[������H��� �e�I���d���H��H�5� ��ff. � � �AWI��AVAUATUH��SH��HH� H�wdH�%( H�D$81�H�GxH�P�H�WxHc L�}H�ƍHH��H)�I�H���z(Hc�H��H)Ӄ��1 ���� A�G"��u*H��� HcB(���1 H�<@H��H�zH���@��<� f�C )$)D$)D$ �D$"Hc�H��L�cL�-,6 I��� H�D$�D$ f% ���f�D$ I�H�$H��H�EL�4��0�H�CH�E L)�H��~`M�t$I��H��L�e A��� L�}H�D$8dH+%( uMH��H[]A\A]A^A_�f D f�B )$)D$)D$ �K��� @ L��L�� H��� �I����c���H�: H��H� H�5 HD�1���H�5� H��1���ff. � f�� �AVAUATUSH�GxH��H�P�H�WxH�WHc H� hH�H)�H������ Hc�H�4�L�,� �p�H��H�p�$��Dž�y.�I�H��� ���I��H�CL�$�LkL�+[]A\A]A^�� �H��A����I��A���t�E��u"� H�� H��H���;��f � Ic�H��H���b��H��H�5 ���� �AVL�� H��1�AUH� � L�5���ATL�%� UL��H�����H����H��H���H�5� A�����H��H���H�5� ��H��H���H�5� ��H��H�Q�H�5� ��E1�L��H��L�� H�^�H�5� ��H��H���H�5� �\�H��H����H�5� �F�H��H�L���H�5� �0�H��H���H�5� ��H��H�����H�5� ��H��H���H�5| ���H��H�D���H�5� ���H��H�����H�5v ���L��H��H�5u ��L��H��H�5w H� �@( ��L��H��H�5p H� �@( �x�E1�L��H��H� L�� H�>���H�5Q �@( �{�� H�� H�5H �R�H�� I���2�H�5 L��H��H�����H�� ��H� L��H��H�����H�� ���H� L��H��H����H��@ ���H�� L��H��H����H�� ��H�� L��H��H���e�H�ﾀ ��H�� L��H��H���C�H�� �f�H�� L��H��H���!�H�� �D�H�� L��H��H����H�� �"�H�p L��H��H�����H�� � �L��H��H�P H����� H�� H�5= ���H��1�I�����H�/ L��H��H����H�� ��H� L��H��H���^�H�� ��H�� L��H��H���<�H��1��b�H�� L��H��H��� �H�� �@�H�� L��H��H����H�� � �L��H��H�� H�����H��D��H��]A\A]A^�C� � �H��H��� handle handle, pos 0 but true IO::File packname = "IO::File" +>& timeout, ... handle, blk=-1 handle, ... IO::Handle::setbuf handle, c IO::Handle::setvbuf arg usage: $io->%s() sock 1.43 v5.32.0 IO.c IO::Seekable::getpos IO::Seekable::setpos IO::File::new_tmpfile IO::Poll::_poll $;$ IO::Handle::blocking IO::Handle::ungetc IO::Handle::error IO::Handle::clearerr IO::Handle::untaint IO::Handle::flush IO::Handle::sync IO::Handle::getline IO::Handle::getlines IO::Handle::gets IO::Socket::sockatmark IO::Poll POLLIN POLLPRI POLLOUT POLLRDNORM POLLWRNORM POLLRDBAND POLLWRBAND POLLERR POLLHUP POLLNVAL IO::Handle _IOFBF _IOLBF _IONBF SEEK_SET SEEK_CUR SEEK_END %s not implemented on this architecture Negative character number in ungetc() Wide character number in ungetc() Usage: IO::Handle::setvbuf(handle, buf, type, size) Can't call $io->getlines in a scalar context, use $io->getline ;� ���� ���� h��� 8��8 8��x ��� 8��, ��x (��� ���� �, h�l ��� ��� � X�T 8�� (�� zR x � $ ��� FJ w� ?:*3$" D ��� < \ h��� F�B�B �A(�A0�� (A BBBC < � ���� F�B�B �A(�A0�� (A BBBI d � ���� F�B�B �B(�A0�A8�G@�HYPJHA@BHBPMXO`I@p 8A0A(B BBBI H D ��/ F�H�B �B(�A0�A8�D`� 8A0A(B BBBJ H � ��� F�B�B �B(�A0�A8�G@ 8A0A(B BBBE 8 � ��� F�B�A �A(�J0� (A ABBD ( l��� E�A�J Y AAA H D ���B F�B�B �B(�A0�A8�Jp� 8A0A(B BBBH < � ���\ F�B�B �A(�A0�� (A BBBA H � ���T F�B�B �B(�A0�A8�JP� 8A0A(B BBBJ < ��� F�B�B �A(�A0�� (A BBBE \ ���S EAD < x ���2 F�B�B �A(�A0�� (A BBBB L � ��� F�E�B �B(�A0�D8�D�7 8A0A(B BBBG < ��� F�B�B �A(�A0�| (A BBBA 8 H <�M F�N�P �H(�O0 (G BBB �& �& Hl W g @ 8l @l ���o � ( � @n � ( h � ���o ���o ( ���o �o � ���o Pl 0 @ P ` p � � � � � � � � ! ! ! 0! @! P! `! p! �! �! �! �! �! �! �! �! " " " 0" @" P" `" p" �" �" �" �" �" �" �" �" # # # IO.so-5.32.1-481.1.el9_6.x86_64.debug ���7zXZ �ִF ! t/����] ?�E�h=��ڊ�2N��� 5������@�sɈT ��s�l@[xo��Jb��YO ��Y�Q%��ֱ6� MSN{���\�r��1�� � DZ�#�cҡ�"��Ax�ۗ��K2�9 ����ib�_J����Ǽ�P�*�vN�̌Y��l���=P��l����"@�9��%Q�r��q8Z�3�p�[&�Rh�� ��� ��C2GݛHd4p���i��QQ�Ԃ >�))�f6� r'� �9L��!D��/�t�*R��X�*(�F ��w��4ncd������a�q��&x�u�t�i�����/�*����p��نx Zb�� ڪ���z�&s���X��A�� �� ��, �P�"@��h h� &�QR�n��7Ż��=8:eB\m5U1�:�����,��1 *o��� ��Rhym�.- S51XWq���Ui���a�]���R@���հ��W�e��t�� W�l�^��]~ O�;^t 7 4a��1 �se=�I5M� �1�i��`�sf߱� ���- W���vX�-V�(� �t*Лa����3 ��Ƙ��G��%~�"� �f� ��4��q|KLF+v#�L,5�U��!`�լ<u�Ǐ��BC��1�%!���>�U E�$� rX�D�I�D�)�7<�nˬX�kh�����)���t��%\3�g���TRJ���'&�i3�!Æ�Q��"V/��+�FP��:A{�8@�u�I�܊�ߜ�t��'Ώ-��I�6�G��VI �T�>��V���SU2rϤJʦ~���}����M 2��}���n���J ��Q��3Ʀ��+�l, V�h� �k R=��{R?_nE�-0�EQ�Q�R�[z�%b�뇘�0 5\`���siaH����n4���YW��� ��7�9'�vR#�Y���f�����H��5��?��6j ���q�I���Me״g��4'�7Jn_�I�uc1v����5bh�v�1߂]�t�'�Vi��4��z�w+ �ցA�BQB ��! �����g� YZ .shstrtab .note.gnu.property .note.gnu.build-id .gnu.hash .dynsym .dynstr .gnu.version .gnu.version_r .rela.dyn .rela.plt .init .plt.sec .text .fini .rodata .eh_frame_hdr .eh_frame .init_array .fini_array .data.rel.ro .dynamic .got .bss .gnu_debuglink .gnu_debugdata � � � � $ 1 ���o � � $ ; C ( ( � K ���o � � l X ���o ( ( @ g h h � q B ( ( � { v � 0# 0# � 0& 0& � � @ @ � 2 P P � � �S �S � � (T (T � � 8l 8\ � @l @\ � Hl H\ � Pl P\ � � @n @^ � � p ` � ` , � ,` $ Pd
| ver. 1.6 |
Github
|
.
| PHP 8.2.30 | ??????????? ?????????: 0 |
proxy
|
phpinfo
|
???????????