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