cpan/libnet/t/time.t

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