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