| Commit | Line | Data |
|---|
| 7e1af8bc |
1 | # Net::Time.pm |
| 2 | # |
| 3 | # Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights |
| 4 | # reserved. 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 | =head1 NAME |
| 10 | |
| 11 | Net::Time - time and daytime network client interface |
| 12 | |
| 13 | =head1 SYNOPSIS |
| 14 | |
| 15 | use Net::Time qw(inet_time inet_daytime); |
| 16 | |
| 17 | print inet_time('localhost'); |
| 18 | print inet_time('localhost', 'tcp'); |
| 19 | |
| 20 | print inet_daytime('localhost'); |
| 21 | print inet_daytime('localhost', 'tcp'); |
| 22 | |
| 23 | =head1 DESCRIPTION |
| 24 | |
| 25 | C<Net::Time> provides subroutines that obtain the time on a remote machine. |
| 26 | |
| 27 | =over 4 |
| 28 | |
| 29 | =item inet_time ( HOST [, PROTOCOL]) |
| 30 | |
| 31 | Obtain the time on C<HOST> using the protocol as defined in RFC868. The |
| 32 | optional argument C<PROTOCOL> should define the protocol to use, either |
| 33 | C<tcp> or C<udp>. The result will be a unix-like time value or I<undef> |
| 34 | upon failure. |
| 35 | |
| 36 | =item inet_daytime ( HOST [, PROTOCOL]) |
| 37 | |
| 38 | Obtain the time on C<HOST> using the protocol as defined in RFC867. The |
| 39 | optional argument C<PROTOCOL> should define the protocol to use, either |
| 40 | C<tcp> or C<udp>. The result will be an ASCII string or I<undef> |
| 41 | upon failure. |
| 42 | |
| 43 | =back |
| 44 | |
| 45 | =head1 AUTHOR |
| 46 | |
| 47 | Graham Barr <Graham.Barr@tiuk.ti.com> |
| 48 | |
| 49 | =head1 REVISION |
| 50 | |
| 51 | $Revision: 2.0 $ |
| 52 | |
| 53 | =head1 COPYRIGHT |
| 54 | |
| 55 | Copyright (c) 1995 Graham Barr. All rights reserved. This program is free |
| 56 | software; you can redistribute it and/or modify it under the same terms |
| 57 | as Perl itself. |
| 58 | |
| 59 | =cut |
| 60 | |
| 61 | use strict; |
| 62 | use vars qw($VERSION @ISA @EXPORT_OK); |
| 63 | use Carp; |
| 64 | use IO::Socket; |
| 65 | require Exporter; |
| 66 | |
| 67 | @ISA = qw(Exporter); |
| 68 | @EXPORT_OK = qw(inet_time inet_daytime); |
| 69 | |
| 70 | $VERSION = sprintf("%d.%02d", q$Revision: 2.0 $ =~ /(\d+)\.(\d+)/); |
| 71 | |
| 72 | sub _socket |
| 73 | { |
| 74 | my($pname,$pnum,$host,$proto) = @_; |
| 75 | |
| 76 | $proto ||= 'udp'; |
| 77 | |
| 78 | my $port = (getservbyname($pname, $proto))[2] || $pnum; |
| 79 | |
| 80 | my $me = IO::Socket::INET->new(PeerAddr => $host, |
| 81 | PeerPort => $port, |
| 82 | Proto => $proto |
| 83 | ); |
| 84 | |
| 85 | $me->send("\n") |
| 86 | if(defined $me && $proto eq 'udp'); |
| 87 | |
| 88 | $me; |
| 89 | } |
| 90 | |
| 91 | sub inet_time |
| 92 | { |
| 93 | my $s = _socket('time',37,@_) || return undef; |
| 94 | my $buf = ''; |
| 95 | |
| 96 | # the time protocol return time in seconds since 1900, convert |
| 97 | # it to a unix time (seconds since 1970) |
| 98 | |
| 99 | $s->recv($buf, length(pack("N",0))) ? (unpack("N",$buf))[0] - 2208988800 |
| 100 | : undef; |
| 101 | } |
| 102 | |
| 103 | sub inet_daytime |
| 104 | { |
| 105 | my $s = _socket('daytime',13,@_) || return undef; |
| 106 | my $buf = ''; |
| 107 | |
| 108 | $s->recv($buf, 1024) ? $buf |
| 109 | : undef; |
| 110 | } |
| 111 | |
| 112 | 1; |
projects / p5sagit/p5-mst-13.2.git / blame