releasing/cbrtools/perl/Net/Time.pm
author jjkang
Fri, 25 Jun 2010 18:37:20 +0800
changeset 602 3145852acc89
permissions -rw-r--r--
add releasing to new structure
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
602
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     1
# Net::Time.pm
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     2
#
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     3
# Copyright (c) 1995-1998 Graham Barr <gbarr@pobox.com>. All rights reserved.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     4
# This program is free software; you can redistribute it and/or
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     5
# modify it under the same terms as Perl itself.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     6
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     7
package Net::Time;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     8
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
     9
use strict;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    10
use vars qw($VERSION @ISA @EXPORT_OK $TIMEOUT);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    11
use Carp;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    12
use IO::Socket;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    13
require Exporter;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    14
use Net::Config;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    15
use IO::Select;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    16
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    17
@ISA = qw(Exporter);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    18
@EXPORT_OK = qw(inet_time inet_daytime);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    19
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    20
$VERSION = "2.09"; # $Id: //depot/libnet/Net/Time.pm#9 $
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    21
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    22
$TIMEOUT = 120;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    23
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    24
sub _socket
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    25
{
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    26
 my($pname,$pnum,$host,$proto,$timeout) = @_;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    27
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    28
 $proto ||= 'udp';
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    29
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    30
 my $port = (getservbyname($pname, $proto))[2] || $pnum;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    31
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    32
 my $hosts = defined $host ? [ $host ] : $NetConfig{$pname . '_hosts'};
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    33
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    34
 my $me;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    35
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    36
 foreach $host (@$hosts)
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    37
  {
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    38
   $me = IO::Socket::INET->new(PeerAddr => $host,
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    39
    	    	    	       PeerPort => $port,
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    40
    	    	    	       Proto    => $proto
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    41
    	    	    	      ) and last;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    42
  }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    43
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    44
 return unless $me;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    45
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    46
 $me->send("\n")
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    47
	if $proto eq 'udp';
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    48
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    49
 $timeout = $TIMEOUT
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    50
	unless defined $timeout;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    51
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    52
 IO::Select->new($me)->can_read($timeout)
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    53
	? $me
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    54
	: undef;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    55
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    56
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    57
sub inet_time
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    58
{
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    59
 my $s = _socket('time',37,@_) || return undef;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    60
 my $buf = '';
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    61
 my $offset = 0 | 0;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    62
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    63
 return undef
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    64
	unless $s->recv($buf, length(pack("N",0)));
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    65
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    66
 # unpack, we | 0 to ensure we have an unsigned
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    67
 my $time = (unpack("N",$buf))[0] | 0;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    68
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    69
 # the time protocol return time in seconds since 1900, convert
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    70
 # it to a the required format
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    71
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    72
 if($^O eq "MacOS") {
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    73
   # MacOS return seconds since 1904, 1900 was not a leap year.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    74
   $offset = (4 * 31536000) | 0;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    75
 }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    76
 else {
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    77
   # otherwise return seconds since 1972, there were 17 leap years between
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    78
   # 1900 and 1972
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    79
   $offset =  (70 * 31536000 + 17 * 86400) | 0;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    80
 }
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    81
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    82
 $time - $offset;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    83
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    84
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    85
sub inet_daytime
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    86
{
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    87
 my $s = _socket('daytime',13,@_) || return undef;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    88
 my $buf = '';
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    89
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    90
 $s->recv($buf, 1024) ? $buf
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    91
    	              : undef;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    92
}
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    93
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    94
1;
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    95
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    96
__END__
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    97
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    98
=head1 NAME
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
    99
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   100
Net::Time - time and daytime network client interface
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   101
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   102
=head1 SYNOPSIS
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   103
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   104
    use Net::Time qw(inet_time inet_daytime);
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   105
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   106
    print inet_time();		# use default host from Net::Config
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   107
    print inet_time('localhost');
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   108
    print inet_time('localhost', 'tcp');
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   109
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   110
    print inet_daytime();	# use default host from Net::Config
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   111
    print inet_daytime('localhost');
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   112
    print inet_daytime('localhost', 'tcp');
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   113
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   114
=head1 DESCRIPTION
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   115
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   116
C<Net::Time> provides subroutines that obtain the time on a remote machine.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   117
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   118
=over 4
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   119
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   120
=item inet_time ( [HOST [, PROTOCOL [, TIMEOUT]]])
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   121
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   122
Obtain the time on C<HOST>, or some default host if C<HOST> is not given
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   123
or not defined, using the protocol as defined in RFC868. The optional
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   124
argument C<PROTOCOL> should define the protocol to use, either C<tcp> or
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   125
C<udp>. The result will be a time value in the same units as returned
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   126
by time() or I<undef> upon failure.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   127
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   128
=item inet_daytime ( [HOST [, PROTOCOL [, TIMEOUT]]])
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   129
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   130
Obtain the time on C<HOST>, or some default host if C<HOST> is not given
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   131
or not defined, using the protocol as defined in RFC867. The optional
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   132
argument C<PROTOCOL> should define the protocol to use, either C<tcp> or
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   133
C<udp>. The result will be an ASCII string or I<undef> upon failure.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   134
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   135
=back
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   136
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   137
=head1 AUTHOR
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   138
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   139
Graham Barr <gbarr@pobox.com>
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   140
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   141
=head1 COPYRIGHT
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   142
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   143
Copyright (c) 1995-1998 Graham Barr. All rights reserved.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   144
This program is free software; you can redistribute it and/or modify
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   145
it under the same terms as Perl itself.
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   146
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   147
=for html <hr>
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   148
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   149
I<$Id: //depot/libnet/Net/Time.pm#9 $>
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   150
3145852acc89 add releasing to new structure
jjkang
parents:
diff changeset
   151
=cut