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