This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
APItest/t/handy.t: Use abbrev. char name in test names
[perl5.git] / cpan / libnet / t / time.t
CommitLineData
2e173144
CBW
1#!perl
2
3use 5.008001;
4
5use strict;
6use warnings;
c8570720
GB
7
8BEGIN {
162b417c 9 if (!eval { require Socket }) {
5abafd4c 10 print "1..0 # no Socket\n"; exit 0;
1a8dcddb 11 }
162b417c 12 if (ord('A') == 193 && !eval { require Convert::EBCDIC }) {
5abafd4c 13 print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0;
8b14f033 14 }
c8570720
GB
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' ?
5abafd4c 54 (4 * 31536000) : (70 * 31536000 + 17 * 86400);
c8570720
GB
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,
5abafd4c 61 'inet_time() should calculate time since offset for time()' );
c8570720
GB
62
63
64my %fail;
65
66sub make_fail {
5abafd4c
SH
67 my ($pack, $func, $num) = @_;
68 $num = 1 unless defined $num;
c8570720 69
5abafd4c 70 $fail{$pack}{$func} = $num;
c8570720
GB
71}
72
73package IO::Socket::INET;
74
75$fail{'IO::Socket::INET'} = {
5abafd4c
SH
76 new => 0,
77 'send' => 0,
c8570720
GB
78};
79
80sub new {
5abafd4c
SH
81 my $class = shift;
82 return if $fail{$class}{new} and $fail{$class}{new}--;
83 bless( { @_ }, $class );
c8570720
GB
84}
85
86sub send {
5abafd4c
SH
87 my $self = shift;
88 my $class = ref($self);
89 return if $fail{$class}{'send'} and $fail{$class}{'send'}--;
90 $self->{sent} .= shift;
c8570720
GB
91}
92
93my $msg;
94sub set_message {
5abafd4c
SH
95 if (ref($_[0])) {
96 $_[0]->{msg} = $_[1];
97 } else {
98 $msg = shift;
99 }
c8570720
GB
100}
101
102sub do_recv {
5abafd4c
SH
103 my ($len, $msg) = @_[1,2];
104 $_[0] .= substr($msg, 0, $len);
c8570720
GB
105}
106
107sub recv {
5abafd4c
SH
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;
c8570720
GB
116}
117
118package IO::Select;
119
120sub new {
5abafd4c
SH
121 my $class = shift;
122 return if defined $fail{$class}{new} and $fail{$class}{new}--;
123 bless({sock => shift}, $class);
c8570720
GB
124}
125
126sub can_read {
5abafd4c
SH
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;
c8570720
GB
132}
133
1341;