home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_ste.zip / Net / Time.pm < prev   
Text File  |  1997-09-26  |  3KB  |  131 lines
  1. # Net::Time.pm
  2. #
  3. # Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
  4. # This program is free software; you can redistribute it and/or
  5. # modify it under the same terms as Perl itself.
  6.  
  7. package Net::Time;
  8.  
  9. use strict;
  10. use vars qw($VERSION @ISA @EXPORT_OK $TIMEOUT);
  11. use Carp;
  12. use IO::Socket;
  13. require Exporter;
  14. use Net::Config;
  15. use IO::Select;
  16.  
  17. @ISA = qw(Exporter);
  18. @EXPORT_OK = qw(inet_time inet_daytime);
  19.  
  20. $VERSION = do { my @r=(q$Revision: 2.5 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
  21.  
  22. $TIMEOUT = 120;
  23.  
  24. sub _socket
  25. {
  26.  my($pname,$pnum,$host,$proto,$timeout) = @_;
  27.  
  28.  $proto ||= 'udp';
  29.  
  30.  my $port = (getservbyname($pname, $proto))[2] || $pnum;
  31.  
  32.  my $hosts = defined $host ? [ $host ] : $NetConfig{$pname . '_hosts'};
  33.  
  34.  my $me;
  35.  
  36.  foreach $host (@$hosts)
  37.   {
  38.    $me = IO::Socket::INET->new(PeerAddr => $host,
  39.                                PeerPort => $port,
  40.                                Proto    => $proto
  41.                               ) and last;
  42.   }
  43.  
  44.  $me->send("\n")
  45.     if(defined $me && $proto eq 'udp');
  46.  
  47.  $timeout = $TIMEOUT
  48.     unless defined $timeout;
  49.  
  50.  IO::Select->new($me)->can_read($timeout)
  51.     ? $me
  52.     : undef;
  53. }
  54.  
  55. sub inet_time
  56. {
  57.  my $s = _socket('time',37,@_) || return undef;
  58.  my $buf = '';
  59.  
  60.  # the time protocol return time in seconds since 1900, convert
  61.  # it to a unix time (seconds since 1970)
  62.  
  63.  $s->recv($buf, length(pack("N",0)))
  64.     ? (unpack("N",$buf))[0] - 2208988800
  65.     : undef;
  66. }
  67.  
  68. sub inet_daytime
  69. {
  70.  my $s = _socket('daytime',13,@_) || return undef;
  71.  my $buf = '';
  72.  
  73.  $s->recv($buf, 1024) ? $buf
  74.                       : undef;
  75. }
  76.  
  77. 1;
  78.  
  79. __END__
  80.  
  81. =head1 NAME
  82.  
  83. Net::Time - time and daytime network client interface
  84.  
  85. =head1 SYNOPSIS
  86.  
  87.     use Net::Time qw(inet_time inet_daytime);
  88.     
  89.     print inet_time();        # use default host from Net::Config
  90.     print inet_time('localhost');
  91.     print inet_time('localhost', 'tcp');
  92.     
  93.     print inet_daytime();    # use default host from Net::Config
  94.     print inet_daytime('localhost');
  95.     print inet_daytime('localhost', 'tcp');
  96.  
  97. =head1 DESCRIPTION
  98.  
  99. C<Net::Time> provides subroutines that obtain the time on a remote machine.
  100.  
  101. =over 4
  102.  
  103. =item inet_time ( [HOST [, PROTOCOL [, TIMEOUT]]])
  104.  
  105. Obtain the time on C<HOST>, or some default host if C<HOST> is not given
  106. or not defined, using the protocol as defined in RFC868. The optional
  107. argument C<PROTOCOL> should define the protocol to use, either C<tcp> or
  108. C<udp>. The result will be a unix-like time value or I<undef> upon
  109. failure.
  110.  
  111. =item inet_daytime ( [HOST [, PROTOCOL [, TIMEOUT]]])
  112.  
  113. Obtain the time on C<HOST>, or some default host if C<HOST> is not given
  114. or not defined, using the protocol as defined in RFC867. The optional
  115. argument C<PROTOCOL> should define the protocol to use, either C<tcp> or
  116. C<udp>. The result will be an ASCII string or I<undef> upon failure.
  117.  
  118. =back
  119.  
  120. =head1 AUTHOR
  121.  
  122. Graham Barr <gbarr@pobox.com>
  123.  
  124. =head1 COPYRIGHT
  125.  
  126. Copyright (c) 1995-1997 Graham Barr. All rights reserved.
  127. This program is free software; you can redistribute it and/or modify
  128. it under the same terms as Perl itself.
  129.  
  130. =cut
  131.