use strict; use Carp; use IO::Select; use Storable qw/ nfreeze thaw /; sub send { my( $socket, $hash, $timeout ) = @_; return undef if( !_is_valid_socket( $socket ) ); foreach my $key ( keys %{ $hash } ) { if( !exists $hash->{ lc $key } ) { $hash->{ lc $key } = $hash->{ $key }; delete $hash->{ $key }; } } my $select = IO::Select->new( $socket ); my $data = nfreeze( $hash ); my $message = sprintf( "Content-Length: %d\015\012" , length( $data ) ); $message .= "\015\012" . $data; my $sofar = 0; $timeout ||= 60; while( $sofar != length( $message ) ) { last if( !_is_valid_socket( $socket ) ); last if( !$select->can_write( $timeout ) ); my $bytes = syswrite( $socket, $message, length($message) - $sofar, $sofar ); $sofar += $bytes; } if( $sofar != length( $message ) ){ return 0; } return 1; } sub _is_valid_socket { my $socket = shift; return undef if !$socket; if( ref( $socket ) eq 'IO::Socket::INET' ) { return undef if !$socket->opened; return undef if $socket->error; } else { return undef if !fileno( $socket ); } return 1; } sub read { my $socket = shift; my $timeout = shift; return undef if( !_is_valid_socket( $socket ) ); my $buf = ''; my $select = IO::Select->new( $socket ); while( 1 ) { last if( !_is_valid_socket( $socket ) ); last if( !$select->can_read( $timeout ) ); my $read_bytes = sysread( $socket, $buf, 8192, length( $buf ) ); last unless $read_bytes; if( my $pos = index( $buf, "\015\012\015\012" ) ) { my( $headers, $data ) = ( substr( $buf, 0, $pos ), substr( $buf, $pos + 4 ) ); my %headers = ( $headers =~ m{^\s*([a-zA-Z0-9_-]+)\s*:\s *([a-zA-Z0-9_-]+)\s*(?:\015\012)?$}msg ); foreach my $key( keys %headers ) { $headers{ lc $key } = $headers{ $key }; } ## Now read Content-Length bytes from the stream my $sofar = length( $data ); my $toread = $headers{ 'content-length' }; while( $sofar != $toread ) { last if( !_is_valid_socket( $socket ) ); last if( !$select->can_read( $timeout ) ); $read_bytes = sysread( $socket, $data, 8192, len gth( $data ) ); last unless $read_bytes; $sofar += $read_bytes; } if( $sofar != $toread ) { return undef; } my $object = eval{ thaw( $data ) }; if( $@ ) { return undef; } else { return $object; } } } }