1#!perl 2 3use 5.008001; 4 5use strict; 6use warnings; 7 8use Test::More; 9 10BEGIN { 11 if (!eval { require Socket }) { 12 plan skip_all => "no Socket"; 13 } 14 elsif (ord('A') == 193 && !eval { require Convert::EBCDIC }) { 15 plan skip_all => "EBCDIC but no Convert::EBCDIC"; 16 } 17 else { 18 plan tests => 12; 19 } 20 21 $INC{'IO/Socket.pm'} = 1; 22 $INC{'IO/Select.pm'} = 1; 23 $INC{'IO/Socket/INET.pm'} = 1; 24} 25 26# cannot use(), otherwise it will use IO::Socket and IO::Select 27eval{ require Net::Time; }; 28ok( !$@, 'should be able to require() Net::Time safely' ); 29ok( exists $INC{'Net/Time.pm'}, 'should be able to use Net::Time' ); 30 31# force the socket to fail 32make_fail('IO::Socket::INET', 'new'); 33my $badsock = Net::Time::_socket('foo', 1, 'bar', 'baz'); 34is( $badsock, undef, '_socket() should fail if Socket creation fails' ); 35 36# if socket is created with protocol UDP (default), it will send a newline 37my $sock = Net::Time::_socket('foo', 2, 'bar'); 38ok( $sock->isa('IO::Socket::INET'), 'should be an IO::Socket::INET object' ); 39is( $sock->{sent}, "\n", 'should send \n with UDP protocol set' ); 40is( $sock->{timeout}, 120, 'timeout should default to 120' ); 41 42# now try it with a custom timeout and a different protocol 43$sock = Net::Time::_socket('foo', 3, 'bar', 'tcp', 11); 44ok( $sock->isa('IO::Socket::INET'), 'should be an IO::Socket::INET object' ); 45is( $sock->{sent}, undef, '_socket() should send nothing unless UDP protocol' ); 46is( $sock->{PeerAddr}, 'bar', '_socket() should set PeerAddr in socket' ); 47is( $sock->{timeout}, 11, '_socket() should respect custom timeout value' ); 48 49# inet_daytime 50# check for correct args (daytime, 13) 51IO::Socket::INET::set_message('z'); 52is( Net::Time::inet_daytime('bob'), 'z', 'inet_daytime() should receive data' ); 53 54# magic numbers defined in Net::Time 55my $offset = $^O eq 'MacOS' ? 56 (4 * 31536000) : (70 * 31536000 + 17 * 86400); 57 58# check for correct args (time, 13) 59# pretend it is only six seconds since the offset, create a fake message 60# inet_time 61IO::Socket::INET::set_message(pack("N", $offset + 6)); 62is( Net::Time::inet_time('foo'), 6, 63 'inet_time() should calculate time since offset for time()' ); 64 65 66my %fail; 67 68sub make_fail { 69 my ($pack, $func, $num) = @_; 70 $num = 1 unless defined $num; 71 72 $fail{$pack}{$func} = $num; 73} 74 75package IO::Socket::INET; 76 77$fail{'IO::Socket::INET'} = { 78 new => 0, 79 'send' => 0, 80}; 81 82sub new { 83 my $class = shift; 84 return if $fail{$class}{new} and $fail{$class}{new}--; 85 bless( { @_ }, $class ); 86} 87 88sub send { 89 my $self = shift; 90 my $class = ref($self); 91 return if $fail{$class}{'send'} and $fail{$class}{'send'}--; 92 $self->{sent} .= shift; 93} 94 95my $msg; 96sub set_message { 97 if (ref($_[0])) { 98 $_[0]->{msg} = $_[1]; 99 } else { 100 $msg = shift; 101 } 102} 103 104sub do_recv { 105 my ($len, $msg) = @_[1,2]; 106 $_[0] .= substr($msg, 0, $len); 107} 108 109sub recv { 110 my ($self, $buf, $length, $flags) = @_; 111 my $message = exists $self->{msg} ? 112 $self->{msg} : $msg; 113 114 if (defined($message)) { 115 do_recv($_[1], $length, $message); 116 } 117 1; 118} 119 120package IO::Select; 121 122sub new { 123 my $class = shift; 124 return if defined $fail{$class}{new} and $fail{$class}{new}--; 125 bless({sock => shift}, $class); 126} 127 128sub can_read { 129 my ($self, $timeout) = @_; 130 my $class = ref($self); 131 return if defined $fail{$class}{can_read} and $fail{class}{can_read}--; 132 $self->{sock}{timeout} = $timeout; 133 1; 134} 135 1361; 137