This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move libnet from ext/ to cpan/
[perl5.git] / cpan / libnet / t / time.t
CommitLineData
c8570720
GB
1#!./perl -w
2
3BEGIN {
4 if ($ENV{PERL_CORE}) {
5 chdir 't' if -d 't';
6 @INC = '../lib';
7 }
1a8dcddb
JH
8 if (!eval "require Socket") {
9 print "1..0 # no Socket\n"; exit 0;
10 }
8b14f033
JH
11 if (ord('A') == 193 && !eval "require Convert::EBCDIC") {
12 print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0;
13 }
c8570720
GB
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;