Another possibility arises because Storable is written in C. Even if Perl handled signals as you expect, there is a chance that Storable might not handle exceptions arising at the Perl level.

Thanks for the tip!

However what needs to be done, needs to be done... so do you by any change have a good suggestion as to writing perl code that reads a Storable object from socket, but returns an error status when you exceed the timeout without resorting to signals?

UPDATE actually, I tried this, and it still segfaults:

sub read
{
        my $socket = shift;
        my $timeout = shift || 60;

        return undef unless( _is_valid( $socket ) );

        my $hash;
        local $@ = '';
        my $select = IO::Select->new( $socket );
        while( $timeout-- ) {
                last unless _is_valid( $socket );
                if( $select->can_read( 1 ) ) {
                        eval{
                                $hash = fd_retrieve( $socket );
                        };
                        return $@ ? undef : $hash
                }
        }

        return undef;
}
[download]

Well, you can always write a method for it at each end. Just nfreeze it to a scalar, figure out how long it is, send a header, then send the object. The reading code needs to read the header, figure out the length of the object, and then read the object.

The trick is getting the reading code to give up if it cannot get everything in the required time. At least two safe ways come to mind to do the trick. Both are a little heavy.

One is to use a select (or IO::Select)/sysread loop to read character by character and die if you fail. If you write this correctly you can actually multiplex multiple loops. But note that you are now writing a Perl level loop for every character coming in - this is not the most efficient thing to do...

The other is to put a process between you and the other end which you don't mind dying. You could launch it with IPC::Open2 with an argument saying how long it is going to live before dying, it sets up the alarm with an exit on read failure (unstable signal handling doesn't matter now since you want it to die), and it will process one object off of the pipe, echo it back to you, then die. You can now do a blocking read of that object, safe in the knowledge that the other end is going away. After it goes away you can reap it with wait or waitpid. Launching a process per object is extreme, but if the objects are very large it may be more efficient.

UPDATE
Response to your update. All that select will do is guarantee a single incoming byte. That is why you have to sysread single chars in a loop. You don't know that there will be more than that, and you don't want to block. And since you have to handle the read at a low-level, you can't punt to Storable's processing method. Which is why I said up front that you would want to write your own communication protocol at each end.

Taking tilly's advice, I wrote the following code, which seems to avoid the segfault all together!

Much, much thanks to tilly. Let me know if there's anything wrong.

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 stre
+am
                        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;
                        }
                }
        }
}
[download]

Subtle detail. $timeout is now the time you are willing to spend between bytes. It isn't the total time you are willing to wait for another object. If you want to do that, then you need to test time elapsed in the loop condition and then redo if you don't select within a timeout that is reasonably small.

Another point. You are using a full tab indent. Studies indicate that code is easier to comprehend when the indent is in the range 2-4 characters. For more on that and general coding advice, I recommend picking up Code Complete.

Thanks for the tips again --

For the timeout, I'm still undecided if I want to put the extra effort in calculating the total time elapsed, or just deal with it the new way... For now I think I'll just reduce the timeouts. Something tells me this is better.

And for the tabs, I just happened to copy the text from a machine where I didn't have vi aliased to vim... it wasn't reading my .vimrc( "set tabstop=4" ) :-)