File: Time.pm

package info (click to toggle)
libnet-perl 1.0502-1
  • links: PTS
  • area: main
  • in suites: hamm
  • size: 284 kB
  • ctags: 418
  • sloc: perl: 3,705; makefile: 43; sh: 4
file content (130 lines) | stat: -rw-r--r-- 2,999 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
# Net::Time.pm
#
# Copyright (c) 1995-1997 Graham Barr <gbarr@ti.com>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package Net::Time;

use strict;
use vars qw($VERSION @ISA @EXPORT_OK $TIMEOUT);
use Carp;
use IO::Socket;
require Exporter;
use Net::Config;
use IO::Select;

@ISA = qw(Exporter);
@EXPORT_OK = qw(inet_time inet_daytime);

$VERSION = do { my @r=(q$Revision: 2.5 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};

$TIMEOUT = 120;

sub _socket
{
 my($pname,$pnum,$host,$proto,$timeout) = @_;

 $proto ||= 'udp';

 my $port = (getservbyname($pname, $proto))[2] || $pnum;

 my $hosts = defined $host ? [ $host ] : $NetConfig{$pname . '_hosts'};

 my $me;

 foreach $host (@$hosts)
  {
   $me = IO::Socket::INET->new(PeerAddr => $host,
    	    	    	       PeerPort => $port,
    	    	    	       Proto    => $proto
    	    	    	      ) and last;
  }

 $me->send("\n")
	if(defined $me && $proto eq 'udp');

 $timeout = $TIMEOUT
	unless defined $timeout;

 IO::Select->new($me)->can_read($timeout)
	? $me
	: undef;
}

sub inet_time
{
 my $s = _socket('time',37,@_) || return undef;
 my $buf = '';

 # the time protocol return time in seconds since 1900, convert
 # it to a unix time (seconds since 1970)

 $s->recv($buf, length(pack("N",0)))
	? (unpack("N",$buf))[0] - 2208988800
	: undef;
}

sub inet_daytime
{
 my $s = _socket('daytime',13,@_) || return undef;
 my $buf = '';

 $s->recv($buf, 1024) ? $buf
    	              : undef;
}

1;

__END__

=head1 NAME

Net::Time - time and daytime network client interface

=head1 SYNOPSIS

    use Net::Time qw(inet_time inet_daytime);
    
    print inet_time();		# use default host from Net::Config
    print inet_time('localhost');
    print inet_time('localhost', 'tcp');
    
    print inet_daytime();	# use default host from Net::Config
    print inet_daytime('localhost');
    print inet_daytime('localhost', 'tcp');

=head1 DESCRIPTION

C<Net::Time> provides subroutines that obtain the time on a remote machine.

=over 4

=item inet_time ( [HOST [, PROTOCOL [, TIMEOUT]]])

Obtain the time on C<HOST>, or some default host if C<HOST> is not given
or not defined, using the protocol as defined in RFC868. The optional
argument C<PROTOCOL> should define the protocol to use, either C<tcp> or
C<udp>. The result will be a unix-like time value or I<undef> upon
failure.

=item inet_daytime ( [HOST [, PROTOCOL [, TIMEOUT]]])

Obtain the time on C<HOST>, or some default host if C<HOST> is not given
or not defined, using the protocol as defined in RFC867. The optional
argument C<PROTOCOL> should define the protocol to use, either C<tcp> or
C<udp>. The result will be an ASCII string or I<undef> upon failure.

=back

=head1 AUTHOR

Graham Barr <gbarr@ti.com>

=head1 COPYRIGHT

Copyright (c) 1995-1997 Graham Barr. All rights reserved.
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut