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