lib/Net/t/time.t

   1 #!./perl -w
   2
   3 BEGIN {
   4     if ($ENV{PERL_CORE}) {
   5         chdir 't' if -d 't';
   6         @INC = '../lib';
   7     }
   8     if (ord('A') == 193 && !eval "require Convert::EBCDIC") {
   9         print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0;
  10     }
  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;