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