This is *not* being sent to p5p _yet_, because I did something either brilliantly
clever or fiendishly stupid to get good coverage. (It's hard to tell the
difference.)
Relying on reliable networking is pretty unportable, and it's really hard to
get useful test information that way. I coded up some mock objects for
IO::Socket and IO::Select that made this test much easier.
I've been thinking of using them for other Net::* modules -- if they can be
generalized a little more, our lives will be much easier. I'd like some
feedback on the approach.
If it's a stupid idea, that's cool. If it's in the wrong place, that's fine.
If there's a better way to do it, I'm all ears.
Someone has to get this done, though, and if doing things the Max Power way
(wrong, but faster and with more yelling) shakes out better ideas, I'll rush in
where fools fear to tread.
HELP!,
-- c
--- ~MANIFEST Thu Oct 18 00:54:07 2001
+++ MANIFEST Thu Oct 18 00:55:15 2001
@@ -1100,7 +1100,8 @@
lib/Net/t/nntp.t libnet
lib/Net/t/require.t libnet
lib/Net/t/smtp.t libnet
-lib/Net/Time.pm libnet
+lib/Net/Time.pm Get the time from a remote machine
+lib/Net/Time.t See if Net::Time works
lib/newgetopt.pl A perl library supporting long option parsing
lib/NEXT.pm Pseudo-class NEXT for method redispatch
lib/NEXT/Changes NEXT
--- /dev/null Thu Aug 30 03:54:37 2001
+++ lib/Net/Time.t Fri Oct 12 12:59:29 2001
@@ -0,0 +1,46 @@
+#!./perl -w
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Net::t::Mock;
+
+use Test::More 'no_plan';
+
+use_ok( 'Net::Time' );
+
+# force the socket to fail
+make_fail('IO::Socket::INET', 'new');
+is( Net::Time::_socket('foo', 1, 'bar', 'baz'), 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');
+isa_ok( $sock, 'IO::Socket::INET' );
+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);
+isa_ok( $sock, 'IO::Socket::INET' );
+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()' );
--- /dev/null Thu Aug 30 03:54:37 2001
+++ lib/Net/t/Mock.pm Fri Oct 12 12:53:59 2001
@@ -0,0 +1,80 @@
+package Net::t::Mock;
+
+my %fail;
+
+sub import {
+ my $pkg = caller;
+ *{ $pkg . '::make_fail' } = sub {
+ my ($pack, $func, $num) = @_;
+ $num = 1 unless defined $num;
+
+ $fail{$pack}{$func} = $num;
+ };
+}
+
+package IO::Socket::INET;
+
+$INC{'IO/Socket/INET.pm'} = 1;
+
+$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])) {
+ $self->{msg} = $_[1];
+ } else {
+ $msg = shift;
+ }
+}
+
+sub do_recv (\$$$) {
+ my ($buf, $len, $msg) = @_;
+ $$buf .= 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;
+
+$INC{'IO/Select.pm'} = 1;
+
+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;
