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