shared hash keys and ++/--
[p5sagit/p5-mst-13.2.git] / lib / Net / t / time.t
CommitLineData
c8570720 1#!./perl -w
2
3BEGIN {
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/;
17require $libnet_t;
18
19print "1..12\n";
20# cannot use(), otherwise it will use IO::Socket and IO::Select
21eval{ require Net::Time; };
22ok( !$@, 'should be able to require() Net::Time safely' );
23ok( exists $INC{'Net/Time.pm'}, 'should be able to use Net::Time' );
24
25# force the socket to fail
26make_fail('IO::Socket::INET', 'new');
27my $badsock = Net::Time::_socket('foo', 1, 'bar', 'baz');
28is( $badsock, undef, '_socket() should fail if Socket creation fails' );
29
30# if socket is created with protocol UDP (default), it will send a newline
31my $sock = Net::Time::_socket('foo', 2, 'bar');
32ok( $sock->isa('IO::Socket::INET'), 'should be an IO::Socket::INET object' );
33is( $sock->{sent}, "\n", 'should send \n with UDP protocol set' );
34is( $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);
38ok( $sock->isa('IO::Socket::INET'), 'should be an IO::Socket::INET object' );
39is( $sock->{sent}, undef, '_socket() should send nothing unless UDP protocol' );
40is( $sock->{PeerAddr}, 'bar', '_socket() should set PeerAddr in socket' );
41is( $sock->{timeout}, 11, '_socket() should respect custom timeout value' );
42
43# inet_daytime
44# check for correct args (daytime, 13)
45IO::Socket::INET::set_message('z');
46is( Net::Time::inet_daytime('bob'), 'z', 'inet_daytime() should receive data' );
47
48# magic numbers defined in Net::Time
49my $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
55IO::Socket::INET::set_message(pack("N", $offset + 6));
56is( Net::Time::inet_time('foo'), 6,
57 'inet_time() should calculate time since offset for time()' );
58
59
60my %fail;
61
62sub make_fail {
63 my ($pack, $func, $num) = @_;
64 $num = 1 unless defined $num;
65
66 $fail{$pack}{$func} = $num;
67}
68
69package IO::Socket::INET;
70
71$fail{'IO::Socket::INET'} = {
72 new => 0,
73 'send' => 0,
74};
75
76sub new {
77 my $class = shift;
78 return if $fail{$class}{new} and $fail{$class}{new}--;
79 bless( { @_ }, $class );
80}
81
82sub 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
89my $msg;
90sub set_message {
91 if (ref($_[0])) {
92 $_[0]->{msg} = $_[1];
93 } else {
94 $msg = shift;
95 }
96}
97
98sub do_recv {
99 my ($len, $msg) = @_[1,2];
100 $_[0] .= substr($msg, 0, $len);
101}
102
103sub 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
114package IO::Select;
115
116sub new {
117 my $class = shift;
118 return if defined $fail{$class}{new} and $fail{$class}{new}--;
119 bless({sock => shift}, $class);
120}
121
122sub 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
1301;