zydronium/imapsync
1
0
Fork 0
mirror of https://github.com/imapsync/imapsync.git synced 2025-06-14 16:34:46 +02:00
Code Issues Projects Releases Packages Wiki Activity

1.504

Browse source
This commit is contained in:
Nick Bebout 2012-09-02 19:08:57 -05:00
parent 495d5a9526
commit c08a56e486
277 changed files with 692 additions and 10803 deletions
Download patch file Download diff file Expand all files Collapse all files

115
learn/io_socket_get
View file

@ -1,115 +0,0 @@
#!/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( ) ;