imapsync/W/learn/io_socket_get

#!/usr/bin/perl

use warnings;
use strict;
use IO::Socket;
use English ;
use POSIX qw(uname SIGALRM);
use lib ( '../Mail-IMAPClient-3.25/lib' ) ;
use Mail::IMAPClient;

sub last_release {
	my $host = shift || 'linux-france.org' ;
	my $sock = new IO::Socket::INET (
		PeerAddr => $host,
		PeerPort => '80',
		Proto => 'tcp');
	return('unknown') if not $sock;
	print $sock
		"GET /prj/imapsync/VERSION HTTP/1.0\n", 
		"Host: www.linux-france.org\n\n";
	my @line = <$sock>;
	close($sock);
	my $last_release = $line[-1];
	chomp($last_release);
	return($last_release);
}

sub not_long {

	my ($func) = @_;
	my $val;
	eval {
		local $SIG{ALRM} = sub { die "alarm\n" };
		alarm 3;
		#print $func, "\n";
		{
			no strict "refs";
			$val = &$func();
		}
		alarm 0;
	};
	if ($@) {
		# timed out
		return('unknown') unless $@ eq "alarm\n"; # propagate unexpected errors
	
	}else {
	# didn't
		return($val);
	}
}

sub not_long2 {
	#print "Entering not_long\n";
	my ( $func ) = shift ;
	my ( @argv ) = @_ ;
	my $val ;
	
	# Doesn't work with gethostbyname (see perlipc)
	#local $SIG{ALRM} = sub { die "alarm\n" };
	
	if ('MSWin32' eq $OSNAME) {
		local $SIG{ALRM} = sub { die "alarm\n" };
	}else{
	
        	POSIX::sigaction(SIGALRM,
                         POSIX::SigAction->new(sub { die "alarm" }))
        		or warn "Error setting SIGALRM handler: $!\n";
	}
	
	eval {
		
		alarm(3);
		print "$func @argv", "\n";
		{
			no strict "refs";
			#print "Calling $func\n";
			$val = &$func( @argv ) ;
			#print "End of  $func\n";
		}
		alarm(0);
	};
	if ( $@ ) {
		#print "$@";
		if ($@ =~ /alarm/) {
		# timed out
			return('timeout');
		}else{
			alarm(0);
			return('unknown'); # propagate unexpected errors
		}
	}else {
	# didn't
		return($val);
	}
}

sub connect_test {
	my $host = 'localhost' ;

	my $imap = Mail::IMAPClient->new(  ) ;
	$imap->Debug( 1 ) ;
	$imap->Server( $host ) ;
	$imap->connect(  ) or die ;
	$imap->IsUnconnected(  ) ;
	$imap->logout(  ) ;
}


#print last_release(), "\n" ;
#print not_long('last_release'), "\n" ;
connect_test(  ) ;
print not_long2( 'last_release', ), "\n" ;
#print not_long2( 'last_release' ), "\n" ;

connect_test(  ) ;