This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[shell changes from patch from perl5.003_13 to perl5.003_14]
authorChip Salzenberg <chip@atlantic.net>
Mon, 23 Dec 1996 00:58:58 +0000 (12:58 +1200)
committerChip Salzenberg <chip@atlantic.net>
Mon, 23 Dec 1996 00:58:58 +0000 (12:58 +1200)
Change from running these commands:

 # get rid of old files
 rm -f lib/Net/Cmd.pm
 rm -f lib/Net/Domain.pm
 rm -f lib/Net/DummyInetd.pm
 rm -f lib/Net/FTP.pm
 rm -f lib/Net/NNTP.pm
 rm -f lib/Net/Netrc.pm
 rm -f lib/Net/POP3.pm
 rm -f lib/Net/SMTP.pm
 rm -f lib/Net/SNPP.pm
 rm -f lib/Net/Telnet.pm
 rm -f lib/Net/Time.pm

 # ready to patch
 exit 0

lib/Net/Cmd.pm [deleted file]
lib/Net/Domain.pm [deleted file]
lib/Net/DummyInetd.pm [deleted file]
lib/Net/FTP.pm [deleted file]
lib/Net/NNTP.pm [deleted file]
lib/Net/Netrc.pm [deleted file]
lib/Net/POP3.pm [deleted file]
lib/Net/SMTP.pm [deleted file]
lib/Net/SNPP.pm [deleted file]
lib/Net/Telnet.pm [deleted file]
lib/Net/Time.pm [deleted file]

diff --git a/lib/Net/Cmd.pm b/lib/Net/Cmd.pm
deleted file mode 100644 (file)
index 6697ad1..0000000
+++ /dev/null
@@ -1,529 +0,0 @@
-# Net::Cmd.pm
-#
-# Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.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::Cmd;
-
-=head1 NAME
-
-Net::Cmd - Network Command class (as used by FTP, SMTP etc)
-
-=head1 SYNOPSIS
-
-    use Net::Cmd;
-    
-    @ISA = qw(Net::Cmd);
-
-=head1 DESCRIPTION
-
-C<Net::Cmd> is a collection of methods that can be inherited by a sub class
-of C<IO::Handle>. These methods implement the functionality required for a
-command based protocol, for example FTP and SMTP.
-
-=head1 USER METHODS
-
-These methods provide a user interface to the C<Net::Cmd> object.
-
-=over 4
-
-=item debug ( VALUE )
-
-Set the level of debug information for this object. If C<VALUE> is not given
-then the current state is returned. Otherwise the state is changed to 
-C<VALUE> and the previous state returned. If C<VALUE> is C<undef> then
-the debug level will be set to the default debug level for the class.
-
-This method can also be called as a I<static> method to set/get the default
-debug level for a given class.
-
-=item message ()
-
-Returns the text message returned from the last command
-
-=item code ()
-
-Returns the 3-digit code from the last command. If a command is pending
-then the value 0 is returned
-
-=item ok ()
-
-Returns non-zero if the last code value was greater than zero and
-less than 400. This holds true for most command servers. Servers
-where this does not hold may override this method.
-
-=item status ()
-
-Returns the most significant digit of the current status code. If a command
-is pending then C<CMD_PENDING> is returned.
-
-=item datasend ( DATA )
-
-Send data to the remote server, delimiting lines with CRLF. Any lin starting
-with a '.' will be prefixed with another '.'.
-
-=item dataend ()
-
-End the sending of data to the remote server. This is done by ensureing that
-the data already sent ends with CRLF then sending '.CRLF' to end the
-transmission. Once this data has been sent C<dataend> calls C<response> and
-returns true if C<response> returns CMD_OK.
-
-=back
-
-=head1 CLASS METHODS
-
-These methods are not intended to be called by the user, but used or 
-over-ridden by a sub-class of C<Net::Cmd>
-
-=over 4
-
-=item debug_print ( DIR, TEXT )
-
-Print debugging information. C<DIR> denotes the direction I<true> being
-data being sent to the server. Calls C<debug_text> before printing to
-STDERR.
-
-=item debug_text ( TEXT )
-
-This method is called to print debugging information. TEXT is
-the text being sent. The method should return the text to be printed
-
-This is primarily meant for the use of modules such as FTP where passwords
-are sent, but we do not want to display them in the debugging information.
-
-=item command ( CMD [, ARGS, ... ])
-
-Send a command to the command server. All arguments a first joined with
-a space character and CRLF is appended, this string is then sent to the
-command server.
-
-Returns undef upon failure
-
-=item unsupported ()
-
-Sets the status code to 580 and the response text to 'Unsupported command'.
-Returns zero.
-
-=item responce ()
-
-Obtain a responce from the server. Upon success the most significant digit
-of the status code is returned. Upon failure, timeout etc., I<undef> is
-returned.
-
-=item parse_response ( TEXT )
-
-This method is called by C<response> as a method with one argument. It should
-return an array of 2 values, the 3-digit status code and a flag which is true
-when this is part of a multi-line response and this line is not the list.
-
-=item getline ()
-
-Retreive one line, delimited by CRLF, from the remote server. Returns I<undef>
-upon failure.
-
-B<NOTE>: If you do use this method for any reason, please remember to add
-some C<debug_print> calls into your method.
-
-=item ungetline ( TEXT )
-
-Unget a line of text from the server.
-
-=item read_until_dot ()
-
-Read data from the remote server until a line consisting of a single '.'.
-Any lines starting with '..' will have one of the '.'s removed.
-
-Returns a reference to a list containing the lines, or I<undef> upon failure.
-
-=back
-
-=head1 EXPORTS
-
-C<Net::Cmd> exports six subroutines, five of these, C<CMD_INFO>, C<CMD_OK>,
-C<CMD_MORE>, C<CMD_REJECT> and C<CMD_ERROR> ,correspond to possible results
-of C<response> and C<status>. The sixth is C<CMD_PENDING>.
-
-=head1 AUTHOR
-
-Graham Barr <Graham.Barr@tiuk.ti.com>
-
-=head1 REVISION
-
-$Revision: 2.2 $
-
-=head1 COPYRIGHT
-
-Copyright (c) 1995 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
-
-require 5.001;
-require Exporter;
-
-use strict;
-use vars qw(@ISA @EXPORT $VERSION);
-use Carp;
-
-$VERSION = sprintf("%d.%02d", q$Revision: 2.2 $ =~ /(\d+)\.(\d+)/);
-@ISA     = qw(Exporter);
-@EXPORT  = qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING);
-
-sub CMD_INFO   { 1 }
-sub CMD_OK     { 2 }
-sub CMD_MORE   { 3 }
-sub CMD_REJECT { 4 }
-sub CMD_ERROR  { 5 }
-sub CMD_PENDING { 0 }
-
-my %debug = ();
-
-sub _print_isa
-{
- no strict qw(refs);
-
- my $pkg = shift;
- my $cmd = $pkg;
-
- $debug{$pkg} ||= 0;
-
- my %done = ();
- my @do   = ($pkg);
- my %spc = ( $pkg , "");
-
- print STDERR "\n";
- while ($pkg = shift @do)
-  {
-   next if defined $done{$pkg};
-
-   $done{$pkg} = 1;
-
-   my $v = defined ${"${pkg}::VERSION"}
-                ? "(" . ${"${pkg}::VERSION"} . ")"
-                : "";
-
-   my $spc = $spc{$pkg};
-   print STDERR "$cmd: ${spc}${pkg}${v}\n";
-
-   if(defined @{"${pkg}::ISA"})
-    {
-     @spc{@{"${pkg}::ISA"}} = ("  " . $spc{$pkg}) x @{"${pkg}::ISA"};
-     unshift(@do, @{"${pkg}::ISA"});
-    }
-  }
-
- print STDERR "\n";
-}
-
-sub debug
-{
- @_ == 1 or @_ == 2 or croak 'usage: $obj->debug([LEVEL])';
-
- my($cmd,$level) = @_;
- my $pkg = ref($cmd) || $cmd;
- my $oldval = 0;
-
- if(ref($cmd))
-  {
-   $oldval = ${*$cmd}{'net_cmd_debug'} || 0;
-  }
- else
-  {
-   $oldval = $debug{$pkg} || 0;
-  }
-
- return $oldval
-    unless @_ == 2;
-
- $level = $debug{$pkg} || 0
-    unless defined $level;
-
- _print_isa($pkg)
-    if($level && !exists $debug{$pkg});
-
- if(ref($cmd))
-  {
-   ${*$cmd}{'net_cmd_debug'} = $level;
-  }
- else
-  {
-   $debug{$pkg} = $level;
-  }
-
- $oldval;
-}
-
-sub message
-{
- @_ == 1 or croak 'usage: $obj->message()';
-
- my $cmd = shift;
-
- wantarray ? @{${*$cmd}{'net_cmd_resp'}}
-          : join("", @{${*$cmd}{'net_cmd_resp'}});
-}
-
-sub debug_text { $_[2] }
-
-sub debug_print
-{
- my($cmd,$out,$text) = @_;
- print STDERR $cmd,($out ? '>>> ' : '<<< '), $cmd->debug_text($out,$text);
-}
-
-sub code
-{
- @_ == 1 or croak 'usage: $obj->code()';
-
- my $cmd = shift;
-
- ${*$cmd}{'net_cmd_code'};
-}
-
-sub status
-{
- @_ == 1 or croak 'usage: $obj->code()';
-
- my $cmd = shift;
-
- substr(${*$cmd}{'net_cmd_code'},0,1);
-}
-
-sub set_status
-{
- @_ == 3 or croak 'usage: $obj->set_status( CODE, MESSAGE)';
-
- my $cmd = shift;
-
- (${*$cmd}{'net_cmd_code'},${*$cmd}{'net_cmd_resp'}) = @_;
-
- 1;
-}
-
-sub command
-{
- my $cmd = shift;
-
- $cmd->dataend()
-    if(exists ${*$cmd}{'net_cmd_lastch'});
-
- if (scalar(@_))
-  {
-   my $str = join(" ", @_) . "\015\012";
-
-   syswrite($cmd,$str,length $str);
-
-   $cmd->debug_print(1,$str)
-       if($cmd->debug);
-
-   ${*$cmd}{'net_cmd_resp'} = [];      # the responce
-   ${*$cmd}{'net_cmd_code'} = "000";   # Made this one up :-)
-  }
-
- $cmd;
-}
-
-sub ok
-{
- @_ == 1 or croak 'usage: $obj->ok()';
-
- my $code = $_[0]->code;
- 0 < $code && $code < 400;
-}
-
-sub unsupported
-{
- my $cmd = shift;
-
- ${*$cmd}{'net_cmd_resp'} = [ 'Unsupported command' ];
- ${*$cmd}{'net_cmd_code'} = 580;
- 0;
-}
-
-sub getline
-{
- my $cmd = shift;
-
- ${*$cmd}{'net_cmd_lines'} ||= [];
-
- return shift @{${*$cmd}{'net_cmd_lines'}}
-    if scalar(@{${*$cmd}{'net_cmd_lines'}});
-
- my $partial = ${*$cmd}{'net_cmd_partial'} || "";
-
- my $rin = "";
- vec($rin,fileno($cmd),1) = 1;
-
- my $buf;
-
- until(scalar(@{${*$cmd}{'net_cmd_lines'}}))
-  {
-   my $timeout = $cmd->timeout || undef;
-   my $rout;
-   if (select($rout=$rin, undef, undef, $timeout))
-    {
-     unless (sysread($cmd, $buf="", 1024))
-      {
-       carp ref($cmd) . ": Unexpected EOF on command channel";
-       return undef;
-      } 
-
-     substr($buf,0,0) = $partial;      ## prepend from last sysread
-
-     my @buf = split(/\015?\012/, $buf);       ## break into lines
-
-     $partial = length($buf) == 0 || substr($buf, -1, 1) eq "\012"
-               ? ''
-               : pop(@buf);
-
-     map { $_ .= "\n" } @buf;
-
-     push(@{${*$cmd}{'net_cmd_lines'}},@buf);
-
-    }
-   else
-    {
-     carp "$cmd: Timeout" if($cmd->debug);
-     return undef;
-    }
-  }
-
- ${*$cmd}{'net_cmd_partial'} = $partial;
-
- shift @{${*$cmd}{'net_cmd_lines'}};
-}
-
-sub ungetline
-{
- my($cmd,$str) = @_;
-
- ${*$cmd}{'net_cmd_lines'} ||= [];
- unshift(@{${*$cmd}{'net_cmd_lines'}}, $str);
-}
-
-sub parse_response
-{
- return ()
-    unless $_[1] =~ s/^(\d\d\d)(.)//o;
- ($1, $2 eq "-");
-}
-
-sub response
-{
- my $cmd = shift;
- my($code,$more) = (undef) x 2;
-
- ${*$cmd}{'net_cmd_resp'} ||= [];
-
- while(1)
-  {
-   my $str = $cmd->getline();
-
-   $cmd->debug_print(0,$str)
-     if ($cmd->debug);
-   if($str =~ s/^(\d\d\d)(.?)//o)
-    {
-     ($code,$more) = ($1,$2 && $2 eq "-");
-    }
-   elsif(!$more)
-    {
-     $cmd->ungetline($str);
-     last;
-    }
-
-   push(@{${*$cmd}{'net_cmd_resp'}},$str);
-
-   last unless($more);
-  } 
-
- ${*$cmd}{'net_cmd_code'} = $code;
-
- substr($code,0,1);
-}
-
-sub read_until_dot
-{
- my $cmd = shift;
- my $arr = [];
-
- while(1)
-  {
-   my $str = $cmd->getline();
-
-   $cmd->debug_print(0,$str)
-     if ($cmd->debug & 4);
-
-   last if($str =~ /^\.\n/o);
-
-   $str =~ s/^\.\././o;
-
-   push(@$arr,$str);
-  }
-
- $arr;
-}
-
-sub datasend
-{
- my $cmd = shift;
- my $lch = exists ${*$cmd}{'net_cmd_lastch'} ? ${*$cmd}{'net_cmd_lastch'}
-                                             : " ";
- my $arr = @_ == 1 && ref($_[0]) ? $_[0] : \@_;
- my $line = $lch . join("" ,@$arr);
-
- ${*$cmd}{'net_cmd_lastch'} = substr($line,-1,1);
-
- return 1
-    unless length($line) > 1;
-
- if($cmd->debug)
-  {
-   my $ln = substr($line,1);
-   my $b = "$cmd>>> ";
-   print STDERR $b,join("\n$b",split(/\n/,$ln)),"\n";
-  }
-
- $line =~ s/\n/\015\012/sgo;
- $line =~ s/(?=\012\.)/./sgo;
- my $len = length($line) - 1;
-
- return $len < 1 ||
-       syswrite($cmd, $line, $len, 1) == $len;
-}
-
-sub dataend
-{
- my $cmd = shift;
-
- return 1
-    unless(exists ${*$cmd}{'net_cmd_lastch'});
-
- if(${*$cmd}{'net_cmd_lastch'} eq "\015")
-  {
-   syswrite($cmd,"\012",1);
-   print STDERR "\n"
-    if($cmd->debug);
-  }
- elsif(${*$cmd}{'net_cmd_lastch'} ne "\012")
-  {
-   syswrite($cmd,"\015\012",2);
-   print STDERR "\n"
-    if($cmd->debug);
-  }
-
- print STDERR "$cmd>>> .\n"
-    if($cmd->debug);
-
- syswrite($cmd,".\015\012",3);
-
- delete ${*$cmd}{'net_cmd_lastch'};
-
- $cmd->response() == CMD_OK;
-}
-
-1;
diff --git a/lib/Net/Domain.pm b/lib/Net/Domain.pm
deleted file mode 100644 (file)
index 558b7f3..0000000
+++ /dev/null
@@ -1,245 +0,0 @@
-# Net::Domain.pm
-#
-# Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.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::Domain;
-
-=head1 NAME
-
-Net::Domain - Attempt to evaluate the current host's internet name and domain
-
-=head1 SYNOPSIS
-
-    use Net::Domain qw(hostname hostfqdn hostdomain);
-
-=head1 DESCRIPTION
-
-Using various methods B<attempt> to find the Fully Qualified Domain Name (FQDN)
-of the current host. From this determine the host-name and the host-domain.
-
-Each of the functions will return I<undef> if the FQDN cannot be determined.
-
-=over 4
-
-=item hostfqdn ()
-
-Identify and return the FQDN of the current host.
-
-=item hostname ()
-
-Returns the smallest part of the FQDN which can be used to identify the host.
-
-=item hostdomain ()
-
-Returns the remainder of the FQDN after the I<hostname> has been removed.
-
-=back
-
-=head1 AUTHOR
-
-Graham Barr <bodg@tiuk.ti.com>.
-Adapted from Sys::Hostname by David Sundstrom <sunds@asictest.sc.ti.com>
-
-=head1 REVISION
-
-$Revision: 2.0 $
-
-=head1 COPYRIGHT
-
-Copyright (c) 1995 Graham Barr. All rights reserved.
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
-
-require Exporter;
-
-use Carp;
-use strict;
-use vars qw($VERSION @ISA @EXPORT_OK);
-
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(hostname hostdomain hostfqdn domainname);
-
-$VERSION = sprintf("%d.%02d", q$Revision: 2.0 $ =~ /(\d+)\.(\d+)/);
-
-my($host,$domain,$fqdn) = (undef,undef,undef);
-
-# Try every conceivable way to get hostname.
-
-sub _hostname {
-
-    # method 1 - we already know it
-    return $host
-       if(defined $host);
-
-    # method 2 - syscall is preferred since it avoids tainting problems
-    eval {
-       {
-           package main;
-           require "syscall.ph";
-       }
-       my $tmp = "\0" x 65; ## preload scalar
-       $host = (syscall(&main::SYS_gethostname, $tmp, 65) == 0) ? $tmp : undef;
-    }
-
-
-    # method 3 - trusty old hostname command
-    || eval {
-       chop($host = `(hostname) 2>/dev/null`); # BSD'ish
-    }
-
-    # method 4 - sysV/POSIX uname command (may truncate)
-    || eval {
-       chop($host = `uname -n 2>/dev/null`); ## SYSV'ish && POSIX'ish
-    }
-
-    # method 5 - Apollo pre-SR10
-    || eval {
-       $host = (split(/[:\. ]/,`/com/host`,6))[0];
-    }
-
-    || eval {
-       $host = "";
-    };
-    # remove garbage 
-    $host =~ s/[\0\r\n]+//go;
-    $host =~ s/(\A\.+|\.+\Z)//go;
-    $host =~ s/\.\.+/\./go;
-
-    $host;
-}
-
-sub _hostdomain {
-
-    # method 1 - we already know it
-    return $domain
-       if(defined $domain);
-
-    # method 2 - just try hostname and system calls
-
-    my $host = _hostname();
-    my($dom,$site,@hosts);
-    local($_);
-
-    @hosts = ($host,"localhost");
-
-    unless($host =~ /\./) {
-       chop($dom = `domainname 2>/dev/null`);
-       unshift(@hosts, "$host.$dom")
-           if (defined $dom && $dom ne "");
-    }
-
-    # Attempt to locate FQDN
-
-    foreach (@hosts) {
-       my @info = gethostbyname($_);
-
-       next unless @info;
-
-       # look at real name & aliases
-       foreach $site ($info[0], split(/ /,$info[1])) { 
-           if(rindex($site,".") > 0) {
-
-               # Extract domain from FQDN
-
-               ($domain = $site) =~ s/\A[^\.]+\.//; 
-               return $domain;
-           }
-       }
-    }
-
-    # try looking in /etc/resolv.conf
-
-    local *RES;
-
-    if(open(RES,"/etc/resolv.conf")) {
-       while(<RES>) {
-           $domain = $1
-               if(/\A\s*(?:domain|search)\s+(\S+)/);
-       }
-       close(RES);
-
-       return $domain
-           if(defined $domain);
-    }
-
-    # Look for environment variable
-
-    $domain ||= $ENV{DOMAIN} || undef;
-
-    if(defined $domain) {
-       $domain =~ s/[\r\n\0]+//g;
-       $domain =~ s/(\A\.+|\.+\Z)//g;
-       $domain =~ s/\.\.+/\./g;
-    }
-
-    $domain;
-}
-
-sub domainname {
-
-    return $fqdn
-       if(defined $fqdn);
-
-    _hostname();
-    _hostdomain();
-
-    my @host   = split(/\./, $host);
-    my @domain = split(/\./, $domain);
-    my @fqdn   = ();
-
-    # Determine from @host & @domain the FQDN
-
-    my @d = @domain;
-LOOP:
-    while(1) {
-       my @h = @host;
-       while(@h) {
-           my $tmp = join(".",@h,@d);
-           if((gethostbyname($tmp))[0]) {
-               @fqdn = (@h,@d);
-               $fqdn = $tmp;
-             last LOOP;
-           }
-           pop @h;
-       }
-       last unless shift @d;
-    }
-
-    if(@fqdn) {
-       $host = shift @fqdn;
-       until((gethostbyname($host))[0]) {
-           $host .= "." . shift @fqdn;
-       }
-       $domain = join(".", @fqdn);
-    }
-    else {
-       undef $host;
-       undef $domain;
-       undef $fqdn;
-    }
-
-    $fqdn;
-}
-
-sub hostfqdn { domainname() }
-
-sub hostname {
-    domainname()
-       unless(defined $host);
-    return $host;
-}
-
-sub hostdomain {
-    domainname()
-       unless(defined $domain);
-    return $domain;
-}
-
-1; # Keep require happy
diff --git a/lib/Net/DummyInetd.pm b/lib/Net/DummyInetd.pm
deleted file mode 100644 (file)
index 8dddc90..0000000
+++ /dev/null
@@ -1,156 +0,0 @@
-# Net::DummyInetd.pm
-#
-# Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.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::DummyInetd;
-
-=head1 NAME
-
-Net::DummyInetd - A dummy Inetd server
-
-=head1 SYNOPSIS
-
-    use Net::DummyInetd;
-    use Net::SMTP;
-    
-    $inetd = new Net::DummyInetd qw(/usr/lib/sendmail -ba -bs);
-    
-    $smtp  = Net::SMTP->new('localhost', Port => $inetd->port);
-
-=head1 DESCRIPTION
-
-C<Net::DummyInetd> is just what it's name says, it is a dummy inetd server.
-Creation of a C<Net::DummyInetd> will cause a child process to be spawned off
-which will listen to a socket. When a connection arrives on this socket
-the specified command is fork'd and exec'd with STDIN and STDOUT file
-descriptors duplicated to the new socket.
-
-This package was added as an example of how to use C<Net::SMTP> to connect
-to a C<sendmail> process, which is not the default, via SIDIN and STDOUT.
-A C<Net::Inetd> package will be avaliable in the next release of C<libnet>
-
-=head1 CONSTRUCTOR
-
-=over 4
-
-=item new ( CMD )
-
-Creates a new object and spawns a child process which listens to a socket.
-C<CMD> is a list, which will be passed to C<exec> when a new process needs
-to be created.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item port
-
-Returns the port number on which the I<DummyInet> object is listening
-
-=back
-
-=head1 AUTHOR
-
-Graham Barr <Graham.Barr@tiuk.ti.com>
-
-=head1 REVISION
-
-$Revision: 1.2 $
-
-The VERSION is derived from the revision by changing each number after the
-first dot into a 2 digit number so
-
-       Revision 1.8   => VERSION 1.08
-       Revision 1.2.3 => VERSION 1.0203
-
-=head1 COPYRIGHT
-
-Copyright (c) 1995 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
-
-require 5.002;
-
-use IO::Handle;
-use IO::Socket;
-use strict;
-use vars qw($VERSION);
-use Carp;
-
-$VERSION = do{my @r=(q$Revision: 1.2 $=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r};
-
-
-sub _process
-{
- my $listen = shift;
- my @cmd = @_;
- my $vec = '';
- my $r;
-
- vec($vec,fileno($listen),1) = 1;
-
- while(select($r=$vec,undef,undef,undef))
-  {
-   my $sock = $listen->accept;
-   my $pid;
-
-   if($pid = fork())
-    {
-     sleep 1;
-     close($sock);
-    }
-   elsif(defined $pid)
-    {
-     my $x =  IO::Handle->new_from_fd($sock,"r");
-     open(STDIN,"<&=".fileno($x)) || die "$! $@";
-     close($x);
-
-     my $y = IO::Handle->new_from_fd($sock,"w");
-     open(STDOUT,">&=".fileno($y)) || die "$! $@";
-     close($y);
-
-     close($sock);
-     exec(@cmd) || carp "$! $@";
-    }
-   else
-    {
-     close($sock);
-     carp $!;
-    }
-  }
- exit -1; 
-}
-
-sub new
-{
- my $self = shift;
- my $type = ref($self) || $self;
-
- my $listen = IO::Socket::INET->new(Listen => 5, Proto => 'tcp');
- my $pid;
-
- return bless [ $listen->sockport, $pid ]
-       if($pid = fork());
-
- _process($listen,@_);
-}
-
-sub port
-{
- my $self = shift;
- $self->[0];
-}
-
-sub DESTROY
-{
- my $self = shift;
- kill 9, $self->[1];
-}
-
-1;
diff --git a/lib/Net/FTP.pm b/lib/Net/FTP.pm
deleted file mode 100644 (file)
index d635f00..0000000
+++ /dev/null
@@ -1,1391 +0,0 @@
-# Net::FTP.pm
-#
-# Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.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::FTP;
-
-=head1 NAME
-
-Net::FTP - FTP Client class
-
-=head1 SYNOPSIS
-
-    use Net::FTP;
-    
-    $ftp = Net::FTP->new("some.host.name");
-    $ftp->login("anonymous","me@here.there");
-    $ftp->cwd("/pub");
-    $ftp->get("that.file");
-    $ftp->quit;
-
-=head1 DESCRIPTION
-
-C<Net::FTP> is a class implementing a simple FTP client in Perl as described
-in RFC959
-
-C<Net::FTP> provides methods that will perform various operations. These methods
-could be split into groups depending the level of interface the user requires.
-
-=head1 CONSTRUCTOR
-
-=over 4
-
-=item new (HOST [,OPTIONS])
-
-This is the constructor for a new Net::SMTP object. C<HOST> is the
-name of the remote host to which a FTP connection is required.
-
-C<OPTIONS> are passed in a hash like fasion, using key and value pairs.
-Possible options are:
-
-B<Firewall> - The name of a machine which acts as a FTP firewall. This can be
-overridden by an environment variable C<FTP_FIREWALL>. If specified, and the
-given host cannot be directly connected to, then the
-connection is made to the firwall machine and the string C<@hostname> is
-appended to the login identifier.
-
-B<Port> - The port number to connect to on the remote machine for the
-FTP connection
-
-B<Timeout> - Set a timeout value (defaults to 120)
-
-B<Debug> - Debug level
-
-B<Passive> - If set to I<true> then all data transfers will be done using 
-passive mode. This is required for some I<dumb> servers.
-
-=back
-
-=head1 METHODS
-
-Unless otherwise stated all methods return either a I<true> or I<false>
-value, with I<true> meaning that the operation was a success. When a method
-states that it returns a value, falure will be returned as I<undef> or an
-empty list.
-
-=over 4
-
-=item login ([LOGIN [,PASSWORD [, ACCOUNT] ] ])
-
-Log into the remote FTP server with the given login information. If
-no arguments are given then the C<Net::FTP> uses the C<Net::Netrc>
-package to lookup the login information for the connected host.
-If no information is found then a login of I<anonymous> is used.
-If no password is given and the login is I<anonymous> then the users
-Email address will be used for a password.
-
-If the connection is via a firewall then the C<authorize> method will
-be called with no arguments.
-
-=item authorize ( [AUTH [, RESP]])
-
-This is a protocol used by some firewall ftp proxies. It is used
-to authorise the user to send data out.  If both arguments are not specified
-then C<authorize> uses C<Net::Netrc> to do a lookup.
-
-=item type (TYPE [, ARGS])
-
-This method will send the TYPE command to the remote FTP server
-to change the type of data transfer. The return value is the previous
-value.
-
-=item ascii ([ARGS]) binary([ARGS]) ebcdic([ARGS]) byte([ARGS])
-
-Synonyms for C<type> with the first arguments set correctly
-
-B<NOTE> ebcdic and byte are not fully supported.
-
-=item rename ( OLDNAME, NEWNAME )
-
-Rename a file on the remote FTP server from C<OLDNAME> to C<NEWNAME>. This
-is done by sending the RNFR and RNTO commands.
-
-=item delete ( FILENAME )
-
-Send a request to the server to delete C<FILENAME>.
-
-=item cwd ( [ DIR ] )
-
-Change the current working directory to C<DIR>, or / if not given.
-
-=item cdup ()
-
-Change directory to the parent of the current directory.
-
-=item pwd ()
-
-Returns the full pathname of the current directory.
-
-=item rmdir ( DIR )
-
-Remove the directory with the name C<DIR>.
-
-=item mkdir ( DIR [, RECURSE ])
-
-Create a new directory with the name C<DIR>. If C<RECURSE> is I<true> then
-C<mkdir> will attempt to create all the directories in the given path.
-
-Returns the full pathname to the new directory.
-
-=item ls ( [ DIR ] )
-
-Get a directory listing of C<DIR>, or the current directory.
-
-Returns a reference to a list of lines returned from the server.
-
-=item dir ( [ DIR ] )
-
-Get a directory listing of C<DIR>, or the current directory in long format.
-
-Returns a reference to a list of lines returned from the server.
-
-=item get ( REMOTE_FILE [, LOCAL_FILE ] )
-
-Get C<REMOTE_FILE> from the server and store locally. C<LOCAL_FILE> may be
-a filename or a filehandle. If not specified the the file will be stored in
-the current directory with the same leafname as the remote file.
-
-Returns C<LOCAL_FILE>, or the generated local file name if C<LOCAL_FILE>
-is not given.
-
-=item put ( LOCAL_FILE [, REMOTE_FILE ] )
-
-Put a file on the remote server. C<LOCAL_FILE> may be a name or a filehandle.
-If C<LOCAL_FILE> is a filehandle then C<REMOTE_FILE> must be specified. If
-C<REMOTE_FILE> is not specified then the file will be stored in the current
-directory with the same leafname as C<LOCAL_FILE>.
-
-Returns C<REMOTE_FILE>, or the generated remote filename if C<REMOTE_FILE>
-is not given.
-
-=item put_unique ( LOCAL_FILE [, REMOTE_FILE ] )
-
-Same as put but uses the C<STOU> command.
-
-Returns the name of the file on the server.
-
-=item append ( LOCAL_FILE [, REMOTE_FILE ] )
-
-Same as put but appends to the file on the remote server.
-
-Returns C<REMOTE_FILE>, or the generated remote filename if C<REMOTE_FILE>
-is not given.
-
-=item unique_name ()
-
-Returns the name of the last file stored on the server using the
-C<STOU> command.
-
-=item mdtm ( FILE )
-
-Returns the I<modification time> of the given file
-
-=item size ( FILE )
-
-Returns the size in bytes for the given file.
-
-=back
-
-The following methods can return different results depending on
-how they are called. If the user explicitly calls either
-of the C<pasv> or C<port> methods then these methods will
-return a I<true> or I<false> value. If the user does not
-call either of these methods then the result will be a
-reference to a C<Net::FTP::dataconn> based object.
-
-=over 4
-
-=item nlst ( [ DIR ] )
-
-Send a C<NLST> command to the server, with an optional parameter.
-
-=item list ( [ DIR ] )
-
-Same as C<nlst> but using the C<LIST> command
-
-=item retr ( FILE )
-
-Begin the retrieval of a file called C<FILE> from the remote server.
-
-=item stor ( FILE )
-
-Tell the server that you wish to store a file. C<FILE> is the
-name of the new file that should be created.
-
-=item stou ( FILE )
-
-Same as C<stor> but using the C<STOU> command. The name of the unique
-file which was created on the server will be avalaliable via the C<unique_name>
-method after the data connection has been closed.
-
-=item appe ( FILE )
-
-Tell the server that we want to append some data to the end of a file
-called C<FILE>. If this file does not exist then create it.
-
-=back
-
-If for some reason you want to have complete control over the data connection,
-this includes generating it and calling the C<response> method when required,
-then the user can use these methods to do so.
-
-However calling these methods only affects the use of the methods above that
-can return a data connection. They have no effect on methods C<get>, C<put>,
-C<put_unique> and those that do not require data connections.
-
-=over 4
-
-=item port ( [ PORT ] )
-
-Send a C<PORT> command to the server. If C<PORT> is specified then it is sent
-to the server. If not the a listen socket is created and the correct information
-sent to the server.
-
-=item pasv ()
-
-Tell the server to go into passive mode. Returns the text that represents the
-port on which the server is listening, this text is in a suitable form to
-sent to another ftp server using the C<port> method.
-
-=back
-
-The following methods can be used to transfer files between two remote
-servers, providing that these two servers can connect directly to each other.
-
-=over 4
-
-=item pasv_xfer ( SRC_FILE, DEST_SERVER [, DEST_FILE ] )
-
-This method will do a file transfer between two remote ftp servers. If
-C<DEST_FILE> is omitted then the leaf name of C<SRC_FILE> will be used.
-
-=item pasv_wait ( NON_PASV_SERVER )
-
-This method can be used to wait for a transfer to complete between a passive
-server and a non-passive server. The method should be called on the passive
-server with the C<Net::FTP> object for the non-passive server passed as an
-argument.
-
-=item abort ()
-
-Abort the current data transfer.
-
-=item quit ()
-
-Send the QUIT command to the remote FTP server and close the socket connection.
-
-=back
-
-=head2 Methods for the adventurous
-
-C<Net::FTP> inherits from C<Net::Cmd> so methods defined in C<Net::Cmd> may
-be used to send commands to the remote FTP server.
-
-=over 4
-
-=item quot (CMD [,ARGS])
-
-Send a command, that Net::FTP does not directly support, to the remote
-server and wait for a response.
-
-Returns most significant digit of the response code.
-
-B<WARNING> This call should only be used on commands that do not require
-data connections. Misuse of this method can hang the connection.
-
-=back
-
-=head1 THE dataconn CLASS
-
-Some of the methods defined in C<Net::FTP> return an object which will
-be derived from this class.The dataconn class itself is derived from
-the C<IO::Socket::INET> class, so any normal IO operations can be performed.
-However the following methods are defined in the dataconn class and IO should
-be performed using these.
-
-=over 4
-
-=item read ( BUFFER, SIZE [, TIMEOUT ] )
-
-Read C<SIZE> bytes of data from the server and place it into C<BUFFER>, also
-performing any <CRLF> translation necessary. C<TIMEOUT> is optional, if not
-given the the timeout value from the command connection will be used.
-
-Returns the number of bytes read before any <CRLF> translation.
-
-=item write ( BUFFER, SIZE [, TIMEOUT ] )
-
-Write C<SIZE> bytes of data from C<BUFFER> to the server, also
-performing any <CRLF> translation necessary. C<TIMEOUT> is optional, if not
-given the the timeout value from the command connection will be used.
-
-Returns the number of bytes written before any <CRLF> translation.
-
-=item abort ()
-
-Abort the current data transfer.
-
-=item close ()
-
-Close the data connection and get a response from the FTP server. Returns
-I<true> if the connection was closed sucessfully and the first digit of
-the response from the server was a '2'.
-
-=back
-
-=head1 AUTHOR
-
-Graham Barr <Graham.Barr@tiuk.ti.com>
-
-=head1 REVISION
-
-$Revision: 2.8 $
-$Date: 1996/09/05 06:53:58 $
-
-The VERSION is derived from the revision by changing each number after the
-first dot into a 2 digit number so
-
-       Revision 1.8   => VERSION 1.08
-       Revision 1.2.3 => VERSION 1.0203
-
-=head1 SEE ALSO
-
-L<Net::Netrc>
-L<Net::Cmd>
-
-=head1 CREDITS
-
-Henry Gabryjelski <henryg@WPI.EDU> - for the suggestion of creating directories
-recursively.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1995 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
-
-require 5.001;
-
-use strict;
-use vars qw(@ISA $VERSION);
-use Carp;
-
-use Socket 1.3;
-use IO::Socket;
-use Time::Local;
-use Net::Cmd;
-use Net::Telnet qw(TELNET_IAC TELNET_IP TELNET_DM);
-
-$VERSION = do{my @r=(q$Revision: 2.8 $=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r};
-@ISA     = qw(Exporter Net::Cmd IO::Socket::INET);
-
-sub new
-{
- my $pkg  = shift;
- my $peer = shift;
- my %arg  = @_; 
-
- my $host = $peer;
- my $fire = undef;
-
- unless(defined inet_aton($peer))
-  {
-   $fire = $ENV{FTP_FIREWALL} || $arg{Firewall} || undef;
-   if(defined $fire)
-    {
-     $peer = $fire;
-     delete $arg{Port};
-    }
-  }
-
- my $ftp = $pkg->SUPER::new(PeerAddr => $peer, 
-                           PeerPort => $arg{Port} || 'ftp(21)',
-                           Proto    => 'tcp',
-                           Timeout  => defined $arg{Timeout}
-                                               ? $arg{Timeout}
-                                               : 120
-                          ) or return undef;
-
- ${*$ftp}{'net_ftp_passive'} = $arg{Passive} || 0;  # Always use pasv mode
- ${*$ftp}{'net_ftp_host'}    = $host;               # Remote hostname
- ${*$ftp}{'net_ftp_type'}    = 'A';                # ASCII/binary/etc mode
-
- ${*$ftp}{'net_ftp_firewall'} = $fire
-    if defined $fire;
-
- $ftp->autoflush(1);
-
- $ftp->debug(exists $arg{Debug} ? $arg{Debug} : undef);
-
- unless ($ftp->response() == CMD_OK)
-  {
-   $ftp->SUPER::close();
-   undef $ftp;
-  }
-
- $ftp;
-}
-
-##
-## User interface methods
-##
-
-sub quit
-{
- my $ftp = shift;
-
- $ftp->_QUIT
-    && $ftp->SUPER::close;
-}
-
-sub close
-{
- my $ftp = shift;
-
- ref($ftp) 
-    && defined fileno($ftp)
-    && $ftp->quit;
-}
-
-sub DESTROY { shift->close }
-
-sub ascii  { shift->type('A',@_); }
-sub binary { shift->type('I',@_); }
-
-sub ebcdic
-{
- carp "TYPE E is unsupported, shall default to I";
- shift->type('E',@_);
-}
-
-sub byte
-{
- carp "TYPE L is unsupported, shall default to I";
- shift->type('L',@_);
-}
-
-# Allow the user to send a command directly, BE CAREFUL !!
-
-sub quot
-{ 
- my $ftp = shift;
- my $cmd = shift;
-
- $ftp->command( uc $cmd, @_);
- $ftp->response();
-}
-
-sub mdtm
-{
- my $ftp  = shift;
- my $file = shift;
-
- return undef
-       unless $ftp->_MDTM($file);
-
- my @gt = reverse ($ftp->message =~ /(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/);
- $gt[5] -= 1;
- timegm(@gt);
-}
-
-sub size
-{
- my $ftp  = shift;
- my $file = shift;
-
- $ftp->_SIZE($file)
-       ? ($ftp->message =~ /(\d+)/)[0]
-       : undef;
-}
-
-sub login
-{
- my($ftp,$user,$pass,$acct) = @_;
- my($ok,$ruser);
-
- unless (defined $user)
-  {
-   require Net::Netrc;
-
-   my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'});
-
-   ($user,$pass,$acct) = $rc->lpa()
-       if ($rc);
-  }
-
- $user ||= "anonymous";
- $ruser = $user;
-
- if(defined ${*$ftp}{'net_ftp_firewall'})
-  {
-   $user .= "@" . ${*$ftp}{'net_ftp_host'};
-  }
-
- $ok = $ftp->_USER($user);
-
- # Some dumb firewall's don't prefix the connection messages
- $ok = $ftp->response()
-       if($ok == CMD_OK && $ftp->code == 220 && $user =~ /\@/);
-
- if ($ok == CMD_MORE)
-  {
-   unless(defined $pass)
-    {
-     require Net::Netrc;
-
-     my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'}, $ruser);
-
-     ($ruser,$pass,$acct) = $rc->lpa()
-       if ($rc);
-
-     $pass = "-" . (getpwuid($>))[0] . "@" 
-        if (!defined $pass && $ruser =~ /^anonymous/o);
-    }
-
-   $ok = $ftp->_PASS($pass || "");
-  }
-
- $ok = $ftp->_ACCT($acct || "")
-       if ($ok == CMD_MORE);
-
- $ftp->authorize()
-    if($ok == CMD_OK && defined ${*$ftp}{'net_ftp_firewall'});
-
- $ok == CMD_OK;
-}
-
-sub authorize
-{
- @_ >= 1 || @_ <= 3 or croak 'usage: $ftp->authorize( [AUTH [, RESP]])';
-
- my($ftp,$auth,$resp) = @_;
-
- unless(defined $resp)
-  {
-   require Net::Netrc;
-
-   $auth ||= (getpwuid($>))[0];
-
-   my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'}, $auth)
-        || Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'});
-
-   ($auth,$resp) = $rc->lpa()
-     if($rc);
-  }
-
- my $ok = $ftp->_AUTH($auth || "");
-
- $ok = $ftp->_RESP($resp || "")
-       if ($ok == CMD_MORE);
-
- $ok == CMD_OK;
-}
-
-sub rename
-{
- @_ == 3 or croak 'usage: $ftp->rename(FROM, TO)';
-
- my($ftp,$from,$to) = @_;
-
- $ftp->_RNFR($from)
-    && $ftp->_RNTO($to);
-}
-
-sub type
-{
- my $ftp = shift;
- my $type = shift;
- my $oldval = ${*$ftp}{'net_ftp_type'};
-
- return $oldval
-       unless (defined $type);
-
- return undef
-       unless ($ftp->_TYPE($type,@_));
-
- ${*$ftp}{'net_ftp_type'} = join(" ",$type,@_);
-
- $oldval;
-}
-
-sub abort
-{
- my $ftp = shift;
-
- send($ftp,pack("CC",TELNET_IAC,TELNET_IP),0);
- send($ftp,pack("C", TELNET_IAC),MSG_OOB);
- send($ftp,pack("C", TELNET_DM),0);
-
- $ftp->command("ABOR");
-
- defined ${*$ftp}{'net_ftp_dataconn'}
-    ? ${*$ftp}{'net_ftp_dataconn'}->close()
-    : $ftp->response();
-
- $ftp->response()
-    if $ftp->status == CMD_REJECT;
-
- $ftp->status == CMD_OK;
-}
-
-sub get
-{
- my($ftp,$remote,$local,$where) = @_;
-
- my($loc,$len,$buf,$resp,$localfd,$data);
- local *FD;
-
- $localfd = ref($local) ? fileno($local)
-                       : undef;
-
- ($local = $remote) =~ s#^.*/##
-       unless(defined $local);
-
- ${*$ftp}{'net_ftp_rest'} = $where
-       if ($where);
-
- delete ${*$ftp}{'net_ftp_port'};
- delete ${*$ftp}{'net_ftp_pasv'};
-
- $data = $ftp->retr($remote) or
-       return undef;
-
- if(defined $localfd)
-  {
-   $loc = $local;
-  }
- else
-  {
-   $loc = \*FD;
-
-   unless(($where) ? open($loc,">>$local") : open($loc,">$local"))
-    {
-     carp "Cannot open Local file $local: $!\n";
-     $data->abort;
-     return undef;
-    }
-  }
-  if ($ftp->binary && !binmode($loc))
-   {
-    carp "Cannot binmode Local file $local: $!\n";
-    return undef;
-   }
-
- $buf = '';
-
- do
-  {
-   $len = $data->read($buf,1024);
-  }
- while($len > 0 && syswrite($loc,$buf,$len) == $len);
-
- close($loc)
-       unless defined $localfd;
- $data->close(); # implied $ftp->response
-
- return $local;
-}
-
-sub cwd
-{
- @_ == 2 || @_ == 3 or croak 'usage: $ftp->cwd( [ DIR ] )';
-
- my($ftp,$dir) = @_;
-
- $dir ||= "/";
-
- $dir eq ".."
-    ? $ftp->_CDUP()
-    : $ftp->_CWD($dir);
-}
-
-sub cdup
-{
- @_ == 1 or croak 'usage: $ftp->cdup()';
- $_[0]->_CDUP;
-}
-
-sub pwd
-{
- @_ == 1 || croak 'usage: $ftp->pwd()';
- my $ftp = shift;
-
- $ftp->_PWD();
- $ftp->_extract_path;
-}
-
-sub rmdir
-{
- @_ == 2 || croak 'usage: $ftp->rmdir( DIR )';
-
- $_[0]->_RMD($_[1]);
-}
-
-sub mkdir
-{
- @_ == 2 || @_ == 3 or croak 'usage: $ftp->mkdir( DIR [, RECURSE ] )';
-
- my($ftp,$dir,$recurse) = @_;
-
- $ftp->_MKD($dir) || $recurse or
-    return undef;
-
- my $path = undef;
- unless($ftp->ok)
-  {
-   my @path = split(m#(?=/+)#, $dir);
-
-   $path = "";
-
-   while(@path)
-    {
-     $path .= shift @path;
-
-     $ftp->_MKD($path);
-     $path = $ftp->_extract_path($path);
-
-     # 521 means directory already exists
-     last
-        unless $ftp->ok || $ftp->code == 521;
-    }
-  }
-
- $ftp->_extract_path($path);
-}
-
-sub delete
-{
- @_ == 2 || croak 'usage: $ftp->delete( FILENAME )';
-
- $_[0]->_DELE($_[1]);
-}
-
-sub put        { shift->_store_cmd("stor",@_) }
-sub put_unique { shift->_store_cmd("stou",@_) }
-sub append     { shift->_store_cmd("appe",@_) }
-
-sub nlst { shift->_data_cmd("NLST",@_) }
-sub list { shift->_data_cmd("LIST",@_) }
-sub retr { shift->_data_cmd("RETR",@_) }
-sub stor { shift->_data_cmd("STOR",@_) }
-sub stou { shift->_data_cmd("STOU",@_) }
-sub appe { shift->_data_cmd("APPE",@_) }
-
-sub _store_cmd 
-{
- my($ftp,$cmd,$local,$remote) = @_;
- my($loc,$sock,$len,$buf,$localfd);
- local *FD;
-
- $localfd = ref($local) ? fileno($local)
-                       : undef;
-
- unless(defined $remote)
-  {
-   croak 'Must specify remote filename with stream input'
-       if defined $localfd;
-
-   ($remote = $local) =~ s%.*/%%;
-  }
-
- if(defined $localfd)
-  {
-   $loc = $local;
-  }
- else
-  {
-   $loc = \*FD;
-
-   unless(open($loc,"<$local"))
-    {
-     carp "Cannot open Local file $local: $!\n";
-     return undef;
-    }
-   if ($ftp->binary && !binmode($loc))
-    {
-     carp "Cannot binmode Local file $local: $!\n";
-     return undef;
-    }
-  }
-
- delete ${*$ftp}{'net_ftp_port'};
- delete ${*$ftp}{'net_ftp_pasv'};
-
- $sock = $ftp->_data_cmd($cmd, $remote) or 
-       return undef;
-
- do
-  {
-   $len = sysread($loc,$buf="",1024);
-  }
- while($len && $sock->write($buf,$len) == $len);
-
- close($loc)
-       unless defined $localfd;
-
- $sock->close();
-
- ($remote) = $ftp->message =~ /unique file name:\s*(\S*)\s*\)/
-       if ('STOU' eq uc $cmd);
-
- return $remote;
-}
-
-sub port
-{
- @_ == 1 || @_ == 2 or croak 'usage: $ftp->port([PORT])';
-
- my($ftp,$port) = @_;
- my $ok;
-
- delete ${*$ftp}{'net_ftp_intern_port'};
-
- unless(defined $port)
-  {
-   # create a Listen socket at same address as the command socket
-
-   ${*$ftp}{'net_ftp_listen'} ||= IO::Socket::INET->new(Listen    => 5,
-                                                       Proto     => 'tcp',
-                                                       LocalAddr => $ftp->sockhost, 
-                                                      );
-  
-   my $listen = ${*$ftp}{'net_ftp_listen'};
-
-   my($myport, @myaddr) = ($listen->sockport, split(/\./,$listen->sockhost));
-
-   $port = join(',', @myaddr, $myport >> 8, $myport & 0xff);
-
-   ${*$ftp}{'net_ftp_intern_port'} = 1;
-  }
-
- $ok = $ftp->_PORT($port);
-
- ${*$ftp}{'net_ftp_port'} = $port;
-
- $ok;
-}
-
-sub ls  { shift->_list_cmd("NLST",@_); }
-sub dir { shift->_list_cmd("LIST",@_); }
-
-sub pasv
-{
- @_ == 1 or croak 'usage: $ftp->pasv()';
-
- my $ftp = shift;
-
- delete ${*$ftp}{'net_ftp_intern_port'};
-
- $ftp->_PASV && $ftp->message =~ /(\d+(,\d+)+)/
-    ? ${*$ftp}{'net_ftp_pasv'} = $1
-    : undef;    
-}
-
-sub unique_name
-{
- my $ftp = shift;
- ${*$ftp}{'net_ftp_unique'} || undef;
-}
-
-##
-## Depreciated methods
-##
-
-sub lsl
-{
- carp "Use of Net::FTP::lsl depreciated, use 'dir'"
-    if $^W;
- goto &dir;
-}
-
-sub authorise
-{
- carp "Use of Net::FTP::authorise depreciated, use 'authorize'"
-    if $^W;
- goto &authorize;
-}
-
-
-##
-## Private methods
-##
-
-sub _extract_path
-{
- my($ftp, $path) = @_;
-
- $ftp->ok &&
-    $ftp->message =~ /\s\"(.*)\"\s/o &&
-    ($path = $1) =~ s/\"\"/\"/g;
-
- $path;
-}
-
-##
-## Communication methods
-##
-
-sub _dataconn
-{
- my $ftp = shift;
- my $data = undef;
- my $pkg = "Net::FTP::" . $ftp->type;
-
- $pkg =~ s/ /_/g;
-
- delete ${*$ftp}{'net_ftp_dataconn'};
-
- if(defined ${*$ftp}{'net_ftp_pasv'})
-  {
-   my @port = split(/,/,${*$ftp}{'net_ftp_pasv'});
-
-   $data = $pkg->new(PeerAddr => join(".",@port[0..3]),
-                    PeerPort => $port[4] * 256 + $port[5],
-                    Proto    => 'tcp'
-                   );
-  }
- elsif(defined ${*$ftp}{'net_ftp_listen'})
-  {
-   $data = ${*$ftp}{'net_ftp_listen'}->accept($pkg);
-   close(delete ${*$ftp}{'net_ftp_listen'});
-  }
-
- if($data)
-  {
-   ${*$data} = "";
-   $data->timeout($ftp->timeout);
-   ${*$ftp}{'net_ftp_dataconn'} = $data;
-   ${*$data}{'net_ftp_cmd'} = $ftp;
-  }
-
- $data;
-}
-
-sub _list_cmd
-{
- my $ftp = shift;
- my $cmd = uc shift;
-
- delete ${*$ftp}{'net_ftp_port'};
- delete ${*$ftp}{'net_ftp_pasv'};
-
- my $data = $ftp->_data_cmd($cmd,@_);
-
- return undef
-       unless(defined $data);
-
- bless $data, "Net::FTP::A"; # Force ASCII mode
-
- my $databuf = '';
- my $buf = '';
-
- while($data->read($databuf,1024))
-  {
-   $buf .= $databuf;
-  }
-
- my $list = [ split(/\n/,$buf) ];
-
- $data->close();
-
- wantarray ? @{$list}
-           : $list;
-}
-
-sub _data_cmd
-{
- my $ftp = shift;
- my $cmd = uc shift;
- my $ok = 1;
- my $where = delete ${*$ftp}{'net_ftp_rest'} || 0;
-
- if(${*$ftp}{'net_ftp_passive'} &&
-     !defined ${*$ftp}{'net_ftp_pasv'} &&
-     !defined ${*$ftp}{'net_ftp_port'})
-  {
-   my $data = undef;
-
-   $ok = defined $ftp->pasv;
-   $ok = $ftp->_REST($where)
-       if $ok && $where;
-
-   if($ok)
-    {
-     $ftp->command($cmd,@_);
-     $data = $ftp->_dataconn();
-     $ok = CMD_INFO == $ftp->response();
-    }
-   return $ok ? $data
-             : undef;
-  }
-
- $ok = $ftp->port
-    unless (defined ${*$ftp}{'net_ftp_port'} ||
-            defined ${*$ftp}{'net_ftp_pasv'});
-
- $ok = $ftp->_REST($where)
-    if $ok && $where;
-
- return undef
-    unless $ok;
-
- $ftp->command($cmd,@_);
-
- return 1
-    if(defined ${*$ftp}{'net_ftp_pasv'});
-
- $ok = CMD_INFO == $ftp->response();
-
- return $ok 
-    unless exists ${*$ftp}{'net_ftp_intern_port'};
-
- $ok ? $ftp->_dataconn()
-     : undef;
-}
-
-##
-## Over-ride methods (Net::Cmd)
-##
-
-sub debug_text { $_[2] =~ /^(pass|resp)/i ? "$1 ....\n" : $_[2]; }
-
-sub command
-{
- my $ftp = shift;
-
- delete ${*$ftp}{'net_ftp_port'};
- $ftp->SUPER::command(@_);
-}
-
-sub response
-{
- my $ftp = shift;
- my $code = $ftp->SUPER::response();
-
- delete ${*$ftp}{'net_ftp_pasv'}
-    if ($code != CMD_MORE && $code != CMD_INFO);
-
- $code;
-}
-
-##
-## Allow 2 servers to talk directly
-##
-
-sub pasv_xfer
-{
- my($sftp,$sfile,$dftp,$dfile) = @_;
-
- ($dfile = $sfile) =~ s#.*/##
-    unless(defined $dfile);
-
- my $port = $sftp->pasv or
-    return undef;
-
- unless($dftp->port($port) && $sftp->retr($sfile) && $dftp->stou($dfile))
-  {
-   $sftp->abort;
-   $dftp->abort;
-   return undef;
-  }
-
- $dftp->pasv_wait($sftp);
-}
-
-sub pasv_wait
-{
- @_ == 2 or croak 'usage: $ftp->pasv_wait(NON_PASV_FTP)';
-
- my($ftp, $non_pasv) = @_;
- my($file,$rin,$rout);
-
- vec($rin,fileno($ftp),1) = 1;
- select($rout=$rin, undef, undef, undef);
-
- $ftp->response();
- $non_pasv->response();
-
- return undef
-       unless $ftp->ok() && $non_pasv->ok();
-
- return $1
-       if $ftp->message =~ /unique file name:\s*(\S*)\s*\)/;
-
- return $1
-       if $non_pasv->message =~ /unique file name:\s*(\S*)\s*\)/;
-
- return 1;
-}
-
-sub cmd { shift->command(@_)->responce() }
-
-########################################
-#
-# RFC959 commands
-#
-
-sub _ABOR { shift->command("ABOR")->response()  == CMD_OK }
-sub _CDUP { shift->command("CDUP")->response()  == CMD_OK }
-sub _NOOP { shift->command("NOOP")->response()  == CMD_OK }
-sub _PASV { shift->command("PASV")->response()  == CMD_OK }
-sub _QUIT { shift->command("QUIT")->response()  == CMD_OK }
-sub _DELE { shift->command("DELE",@_)->response() == CMD_OK }
-sub _CWD  { shift->command("CWD", @_)->response() == CMD_OK }
-sub _PORT { shift->command("PORT",@_)->response() == CMD_OK }
-sub _RMD  { shift->command("RMD", @_)->response() == CMD_OK }
-sub _MKD  { shift->command("MKD", @_)->response() == CMD_OK }
-sub _PWD  { shift->command("PWD", @_)->response() == CMD_OK }
-sub _TYPE { shift->command("TYPE",@_)->response() == CMD_OK }
-sub _RNTO { shift->command("RNTO",@_)->response() == CMD_OK }
-sub _ACCT { shift->command("ACCT",@_)->response() == CMD_OK }
-sub _RESP { shift->command("RESP",@_)->response() == CMD_OK }
-sub _MDTM { shift->command("MDTM",@_)->response() == CMD_OK }
-sub _SIZE { shift->command("SIZE",@_)->response() == CMD_OK }
-sub _APPE { shift->command("APPE",@_)->response() == CMD_INFO }
-sub _LIST { shift->command("LIST",@_)->response() == CMD_INFO }
-sub _NLST { shift->command("NLST",@_)->response() == CMD_INFO }
-sub _RETR { shift->command("RETR",@_)->response() == CMD_INFO }
-sub _STOR { shift->command("STOR",@_)->response() == CMD_INFO }
-sub _STOU { shift->command("STOU",@_)->response() == CMD_INFO }
-sub _RNFR { shift->command("RNFR",@_)->response() == CMD_MORE }
-sub _REST { shift->command("REST",@_)->response() == CMD_MORE }
-sub _USER { shift->command("user",@_)->response() } # A certain brain dead firewall :-)
-sub _PASS { shift->command("PASS",@_)->response() }
-sub _AUTH { shift->command("AUTH",@_)->response() }
-
-sub _ALLO { shift->unsupported(@_) }
-sub _SMNT { shift->unsupported(@_) }
-sub _HELP { shift->unsupported(@_) }
-sub _MODE { shift->unsupported(@_) }
-sub _SITE { shift->unsupported(@_) }
-sub _SYST { shift->unsupported(@_) }
-sub _STAT { shift->unsupported(@_) }
-sub _STRU { shift->unsupported(@_) }
-sub _REIN { shift->unsupported(@_) }
-
-##
-## Generic data connection package
-##
-
-package Net::FTP::dataconn;
-
-use Carp;
-use vars qw(@ISA $timeout);
-use Net::Cmd;
-
-@ISA = qw(IO::Socket::INET);
-
-sub abort
-{
- my $data = shift;
- my $ftp  = ${*$data}{'net_ftp_cmd'};
-
- $ftp->abort; # this will close me
-}
-
-sub close
-{
- my $data = shift;
- my $ftp  = ${*$data}{'net_ftp_cmd'};
-
- $data->SUPER::close();
-
- delete ${*$ftp}{'net_ftp_dataconn'}
-    if exists ${*$ftp}{'net_ftp_dataconn'} &&
-        $data == ${*$ftp}{'net_ftp_dataconn'};
-
- $ftp->response() == CMD_OK &&
-    $ftp->message =~ /unique file name:\s*(\S*)\s*\)/ &&
-    (${*$ftp}{'net_ftp_unique'} = $1);
-
- $ftp->status == CMD_OK;
-}
-
-sub _select
-{
- my    $data   = shift;
- local *timeout = \$_[0]; shift;
- my    $rw     = shift;
-
- my($rin,$win);
-
- return 1 unless $timeout;
-
- $rin = '';
- vec($rin,fileno($data),1) = 1;
-
- $win = $rw ? undef : $rin;
- $rin = undef unless $rw;
-
- my $nfound = select($rin, $win, undef, $timeout);
-
- croak "select: $!"
-       if $nfound < 0;
-
- return $nfound;
-}
-
-sub can_read
-{
- my    $data    = shift;
- local *timeout = \$_[0];
-
- $data->_select($timeout,1);
-}
-
-sub can_write
-{
- my    $data    = shift;
- local *timeout = \$_[0];
-
- $data->_select($timeout,0);
-}
-
-sub cmd
-{
- my $ftp = shift;
-
- ${*$ftp}{'net_ftp_cmd'};
-}
-
-
-@Net::FTP::L::ISA = qw(Net::FTP::I);
-@Net::FTP::E::ISA = qw(Net::FTP::I);
-
-##
-## Package to read/write on ASCII data connections
-##
-
-package Net::FTP::A;
-
-use vars qw(@ISA $buf);
-use Carp;
-
-@ISA = qw(Net::FTP::dataconn);
-
-sub read
-{
- my    $data   = shift;
- local *buf    = \$_[0]; shift;
- my    $size   = shift || croak 'read($buf,$size,[$offset])';
- my    $offset         = shift || 0;
- my    $timeout = $data->timeout;
-
- croak "Bad offset"
-       if($offset < 0);
-
- $offset = length $buf
-       if($offset > length $buf);
-
- ${*$data} ||= "";
- my $l = 0;
-
- READ:
-  {
-   $data->can_read($timeout) or
-       croak "Timeout";
-
-   my $n = sysread($data, ${*$data}, $size, length ${*$data});
-
-   return $n
-       unless($n >= 0);
-
-   ${*$data} =~ s/(\015)?(?!\012)\Z//so;
-   my $lf = $1 || "";
-
-   ${*$data} =~ s/\015\012/\n/sgo;
-
-   substr($buf,$offset) = ${*$data};
-
-   $l += length(${*$data});
-   $offset += length(${*$data});
-
-   ${*$data} = $lf;
-   
-   redo READ
-     if($l == 0 && $n > 0);
-
-   if($n == 0 && $l == 0)
-    {
-     substr($buf,$offset) = ${*$data};
-     ${*$data} = "";
-    }
-  }
-
- return $l;
-}
-
-sub write
-{
- my    $data   = shift;
- local *buf    = \$_[0]; shift;
- my    $size   = shift || croak 'write($buf,$size,[$timeout])';
- my    $timeout = @_ ? shift : $data->timeout;
-
- $data->can_write($timeout) or
-       croak "Timeout";
-
- # What is previous pkt ended in \015 or not ??
-
- my $tmp;
- ($tmp = $buf) =~ s/(?!\015)\012/\015\012/sg;
-
- my $len = $size + length($tmp) - length($buf);
- my $wrote = syswrite($data, $tmp, $len);
-
- if($wrote >= 0)
-  {
-   $wrote = $wrote == $len ? $size
-                          : $len - $wrote
-  }
-
- return $wrote;
-}
-
-##
-## Package to read/write on BINARY data connections
-##
-
-package Net::FTP::I;
-
-use vars qw(@ISA $buf);
-use Carp;
-
-@ISA = qw(Net::FTP::dataconn);
-
-sub read
-{
- my    $data   = shift;
- local *buf    = \$_[0]; shift;
- my    $size    = shift || croak 'read($buf,$size,[$timeout])';
- my    $timeout = @_ ? shift : $data->timeout;
-
- $data->can_read($timeout) or
-       croak "Timeout";
-
- my $n = sysread($data, $buf, $size);
-
- $n;
-}
-
-sub write
-{
- my    $data    = shift;
- local *buf     = \$_[0]; shift;
- my    $size    = shift || croak 'write($buf,$size,[$timeout])';
- my    $timeout = @_ ? shift : $data->timeout;
-
- $data->can_write($timeout) or
-       croak "Timeout";
-
- syswrite($data, $buf, $size);
-}
-
-
-1;
-
diff --git a/lib/Net/NNTP.pm b/lib/Net/NNTP.pm
deleted file mode 100644 (file)
index a23b9bb..0000000
+++ /dev/null
@@ -1,996 +0,0 @@
-# Net::NNTP.pm
-#
-# Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.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::NNTP;
-
-=head1 NAME
-
-Net::NNTP - NNTP Client class
-
-=head1 SYNOPSIS
-
-    use Net::NNTP;
-    
-    $nntp = Net::NNTP->new("some.host.name");
-    $nntp->quit;
-
-=head1 DESCRIPTION
-
-C<Net::NNTP> is a class implementing a simple NNTP client in Perl as described
-in RFC977. C<Net::NNTP> inherits its communication methods from C<Net::Cmd>
-
-=head1 CONSTRUCTOR
-
-=over 4
-
-=item new ( [ HOST ] [, OPTIONS ])
-
-This is the constructor for a new Net::NNTP object. C<HOST> is the
-name of the remote host to which a NNTP connection is required. If not
-given two environment variables are checked, first C<NNTPSERVER> then
-C<NEWSHOST>, if neither are set C<news> is used.
-
-C<OPTIONS> are passed in a hash like fasion, using key and value pairs.
-Possible options are:
-
-B<Timeout> - Maximum time, in seconds, to wait for a response from the
-NNTP server, a value of zero will cause all IO operations to block.
-(default: 120)
-
-B<Debug> - Enable the printing of debugging information to STDERR
-
-=back
-
-=head1 METHODS
-
-Unless otherwise stated all methods return either a I<true> or I<false>
-value, with I<true> meaning that the operation was a success. When a method
-states that it returns a value, falure will be returned as I<undef> or an
-empty list.
-
-=over 4
-
-=item article ( [ MSGID|MSGNUM ] )
-
-Retreive the header, a blank line, then the body (text) of the
-specified article. 
-
-If no arguments are passed then the current aricle in the current
-newsgroup is returned.
-
-C<MSGNUM> is a numeric id of an article in the
-current newsgroup, and will change the current article pointer.
-C<MSGID> is the message id of an article as
-shown in that article's header.  It is anticipated that the client
-will obtain the C<MSGID> from a list provided by the C<newnews>
-command, from references contained within another article, or from
-the message-id provided in the response to some other commands.
-
-Returns a reference to an array containing the article.
-
-=item body ( [ MSGID|MSGNUM ] )
-
-Retreive the body (text) of the specified article. 
-
-Takes the same arguments as C<article>
-
-Returns a reference to an array containing the body of the article.
-
-=item head ( [ MSGID|MSGNUM ] )
-
-Retreive the header of the specified article. 
-
-Takes the same arguments as C<article>
-
-Returns a reference to an array containing the header of the article.
-
-=item nntpstat ( [ MSGID|MSGNUM ] )
-
-The C<nntpstat> command is similar to the C<article> command except that no
-text is returned.  When selecting by message number within a group,
-the C<nntpstat> command serves to set the "current article pointer" without
-sending text.
-
-Using the C<nntpstat> command to
-select by message-id is valid but of questionable value, since a
-selection by message-id does B<not> alter the "current article pointer".
-
-Returns the message-id of the "current article".
-
-=item group ( [ GROUP ] )
-
-Set and/or get the current group. If C<GROUP> is not given then information
-is returned on the current group.
-
-In a scalar context it returns the group name.
-
-In an array context the return value is a list containing, the number
-of articles in the group, the number of the first article, the number
-of the last article and the group name.
-
-=item ihave ( MSGID [, MESSAGE ])
-
-The C<ihave> command informs the server that the client has an article
-whose id is C<MSGID>.  If the server desires a copy of that
-article, and C<MESSAGE> has been given the it will be sent.
-
-Returns I<true> if the server desires the article and C<MESSAGE> was
-successfully sent,if specified.
-
-If C<MESSAGE> is not specified then the message must be sent using the
-C<datasend> and C<dataend> methods from L<Net::Cmd>
-
-C<MESSAGE> can be either an array of lines or a reference to an array.
-
-=item last ()
-
-Set the "current article pointer" to the previous article in the current
-newsgroup.
-
-Returns the message-id of the article.
-
-=item date ()
-
-Returns the date on the remote server. This date will be in a UNIX time
-format (seconds since 1970)
-
-=item postok ()
-
-C<postok> will return I<true> if the servers initial response indicated
-that it will allow posting.
-
-=item authinfo ( USER, PASS )
-
-=item list ()
-
-Obtain information about all the active newsgroups. The results is a reference
-to a hash where the key is a group name and each value is a reference to an
-array. The elements in this array are:- the first article number in the group,
-the last article number in the group and any information flags about the group.
-
-=item newgroups ( SINCE [, DISTRIBUTIONS ])
-
-C<SINCE> is a time value and C<DISTRIBUTIONS> is either a distribution
-pattern or a reference to a list of distribution patterns.
-The result is the same as C<list>, but the
-groups return will be limited to those created after C<SINCE> and, if
-specified, in one of the distribution areas in C<DISTRIBUTIONS>. 
-
-=item newnews ( SINCE [, GROUPS [, DISTRIBUTIONS ]])
-
-C<SINCE> is a time value. C<GROUPS> is either a group pattern or a reference
-to a list of group patterns. C<DISTRIBUTIONS> is either a distribution
-pattern or a reference to a list of distribution patterns.
-
-Returns a reference to a list which contains the message-ids of all news posted
-after C<SINCE>, that are in a groups which matched C<GROUPS> and a
-distribution which matches C<DISTRIBUTIONS>.
-
-=item next ()
-
-Set the "current article pointer" to the next article in the current
-newsgroup.
-
-Returns the message-id of the article.
-
-=item post ( [ MESSAGE ] )
-
-Post a new article to the news server. If C<MESSAGE> is specified and posting
-is allowed then the message will be sent.
-
-If C<MESSAGE> is not specified then the message must be sent using the
-C<datasend> and C<dataend> methods from L<Net::Cmd>
-
-C<MESSAGE> can be either an array of lines or a reference to an array.
-
-=item slave ()
-
-Tell the remote server that I am not a user client, but probably another
-news server.
-
-=item quit ()
-
-Quit the remote server and close the socket connection.
-
-=back
-
-=head2 Extension methods
-
-These methods use commands that are not part of the RFC977 documentation. Some
-servers may not support all of them.
-
-=over 4
-
-=item newsgroups ( [ PATTERN ] )
-
-Returns a reference to a hash where the keys are all the group names which
-match C<PATTERN>, or all of the groups if no pattern is specified, and
-each value contains the description text for the group.
-
-=item distributions ()
-
-Returns a reference to a hash where the keys are all the possible
-distribution names and the values are the distribution descriptions.
-
-=item subscriptions ()
-
-Returns a reference to a list which contains a list of groups which
-are reccomended for a new user to subscribe to.
-
-=item overview_fmt ()
-
-Returns a reference to an array which contain the names of the fields returnd
-by C<xover>.
-
-=item active_times ()
-
-Returns a reference to a hash where the keys are the group names and each
-value is a reference to an array containg the time the groups was created
-and an identifier, possibly an Email address, of the creator.
-
-=item active ( [ PATTERN ] )
-
-Similar to C<list> but only active groups that match the pattern are returned.
-C<PATTERN> can be a group pattern.
-
-=item xgtitle ( PATTERN )
-
-Returns a reference to a hash where the keys are all the group names which
-match C<PATTERN> and each value is the description text for the group.
-
-=item xhdr ( HEADER, MESSAGE-RANGE )
-
-Obtain the header field C<HEADER> for all the messages specified. 
-
-Returns a reference to a hash where the keys are the message numbers and
-each value contains the header for that message.
-
-=item xover ( MESSAGE-RANGE )
-
-Returns a reference to a hash where the keys are the message numbers and each
-value is a reference to an array which contains the overview fields for that
-message. The names of these fields can be obtained by calling C<overview_fmt>.
-
-=item xpath ( MESSAGE-ID )
-
-Returns the path name to the file on the server which contains the specified
-message.
-
-=item xpat ( HEADER, PATTERN, MESSAGE-RANGE)
-
-The result is the same as C<xhdr> except the is will be restricted to
-headers that match C<PATTERN>
-
-=item xrover
-
-=item listgroup
-
-=item reader
-
-=back
-
-=head1 UNSUPPORTED
-
-The following NNTP command are unsupported by the package, and there are
-no plans to do so.
-
-    AUTHINFO GENERIC
-    XTHREAD
-    XSEARCH
-    XINDEX
-
-=head1 DEFINITIONS
-
-=over 4
-
-=item MESSAGE-RANGE
-
-C<MESSAGE-RANGE> is either a single message-id, a single mesage number, or
-two message numbers.
-
-If C<MESSAGE-RANGE> is two message numbers and the second number in a
-range is less than or equal to the first then the range represents all
-messages in the group after the first message number.
-
-=item PATTERN
-
-The C<NNTP> protocol uses the C<WILDMAT> format for patterns.
-The WILDMAT format was first developed by Rich Salz based on
-the format used in the UNIX "find" command to articulate
-file names. It was developed to provide a uniform mechanism
-for matching patterns in the same manner that the UNIX shell
-matches filenames.
-
-Patterns are implicitly anchored at the
-beginning and end of each string when testing for a match.
-
-There are five pattern matching operations other than a strict
-one-to-one match between the pattern and the source to be
-checked for a match.
-
-The first is an asterisk C<*> to match any sequence of zero or more
-characters.
-
-The second is a question mark C<?> to match any single character. The
-third specifies a specific set of characters.
-
-The set is specified as a list of characters, or as a range of characters
-where the beginning and end of the range are separated by a minus (or dash)
-character, or as any combination of lists and ranges. The dash can
-also be included in the set as a character it if is the beginning
-or end of the set. This set is enclosed in square brackets. The
-close square bracket C<]> may be used in a set if it is the first
-character in the set.
-
-The fourth operation is the same as the
-logical not of the third operation and is specified the same
-way as the third with the addition of a caret character C<^> at
-the beginning of the test string just inside the open square
-bracket.
-
-The final operation uses the backslash character to
-invalidate the special meaning of the a open square bracket C<[>,
-the asterisk, backslash or the question mark. Two backslashes in
-sequence will result in the evaluation of the backslash as a
-character with no special meaning.
-
-=over 4
-
-=item Examples
-
-=item C<[^]-]>
-
-matches any single character other than a close square
-bracket or a minus sign/dash.
-
-=item C<*bdc>
-
-matches any string that ends with the string "bdc"
-including the string "bdc" (without quotes).
-
-=item C<[0-9a-zA-Z]>
-
-matches any single printable alphanumeric ASCII character.
-
-=item C<a??d>
-
-matches any four character string which begins
-with a and ends with d.
-
-=back
-
-=back
-
-=head1 SEE ALSO
-
-L<Net::Cmd>
-
-=head1 AUTHOR
-
-Graham Barr <Graham.Barr@tiuk.ti.com>
-
-=head1 REVISION
-
-$Revision: 2.5 $
-
-=head1 COPYRIGHT
-
-Copyright (c) 1995 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
-
-use strict;
-use vars qw(@ISA $VERSION $debug);
-use IO::Socket;
-use Net::Cmd;
-use Carp;
-
-$VERSION = sprintf("%d.%02d", q$Revision: 2.5 $ =~ /(\d+)\.(\d+)/);
-@ISA     = qw(Net::Cmd IO::Socket::INET);
-
-sub new
-{
- my $self = shift;
- my $type = ref($self) || $self;
- my $host = shift if @_ % 2;
- my %arg  = @_;
-
- $host ||= $ENV{NNTPSERVER} || $ENV{NEWSHOST} || "news";
-
- my $obj = $type->SUPER::new(PeerAddr => $host, 
-                            PeerPort => $arg{Port} || 'nntp(119)',
-                            Proto    => 'tcp',
-                            Timeout  => defined $arg{Timeout}
-                                               ? $arg{Timeout}
-                                               : 120
-                           ) or return undef;
-
- ${*$obj}{'net_nntp_host'} = $host;
-
- $obj->autoflush(1);
- $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
-
- unless ($obj->response() == CMD_OK)
-  {
-   $obj->close();
-   return undef;
-  }
-
- my $c = $obj->code;
- ${*$obj}{'net_nntp_post'} = $c >= 200 && $c <= 209 ? 1 : 0;
-
- $obj;
-}
-
-sub debug_text
-{
- my $nntp = shift;
- my $inout = shift;
- my $text = shift;
-
- if(($nntp->code == 350 && $text =~ /^(\S+)/)
-    || ($text =~ /^(authinfo\s+pass)/io)) 
-  {
-   $text = "$1 ....\n"
-  }
-
- $text;
-}
-
-sub postok
-{
- @_ == 1 or croak 'usage: $nntp->postok()';
- my $nntp = shift;
- ${*$nntp}{'net_nntp_post'} || 0;
-}
-
-sub article
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->article( MSGID )';
- my $nntp = shift;
-
- $nntp->_ARTICLE(@_)
-    ? $nntp->read_until_dot()
-    : undef;
-}
-
-sub authinfo
-{
- @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
- my($nntp,$user,$pass) = @_;
-
- $nntp->_AUTHINFO("USER",$user) == CMD_MORE 
-    && $nntp->_AUTHINFO("PASS",$pass) == CMD_OK;
-}
-
-sub authinfo_simple
-{
- @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
- my($nntp,$user,$pass) = @_;
-
- $nntp->_AUTHINFO('SIMPLE') == CMD_MORE 
-    && $nntp->command($user,$pass)->response == CMD_OK;
-}
-
-sub body
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->body( [ MSGID ] )';
- my $nntp = shift;
-
- $nntp->_BODY(@_)
-    ? $nntp->read_until_dot()
-    : undef;
-}
-
-sub head
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->head( [ MSGID ] )';
- my $nntp = shift;
-
- $nntp->_HEAD(@_)
-    ? $nntp->read_until_dot()
-    : undef;
-}
-
-sub nntpstat
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->nntpstat( [ MSGID ] )';
- my $nntp = shift;
-
- $nntp->_STAT(@_) && $nntp->message =~ /(<[^>]+>)/o
-    ? $1
-    : undef;
-}
-
-
-sub group
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->group( [ GROUP ] )';
- my $nntp = shift;
- my $grp = ${*$nntp}{'net_nntp_group'} || undef;
-
- return $grp
-    unless(@_ || wantarray);
-
- my $newgrp = shift;
-
- return wantarray ? () : undef
-       unless $nntp->_GROUP($newgrp || $grp || "")
-               && $nntp->message =~ /(\d+)\s+(\d+)\s+(\d+)\s+(\S+)/;
-
- my($count,$first,$last,$group) = ($1,$2,$3,$4);
-
- # group may be replied as '(current group)'
- $group = ${*$nntp}{'net_nntp_group'}
-    if $group =~ /\(/;
-
- ${*$nntp}{'net_nntp_group'} = $group;
-
- wantarray
-    ? ($count,$first,$last,$group)
-    : $group;
-}
-
-sub help
-{
- @_ == 1 or croak 'usage: $nntp->help()';
- my $nntp = shift;
-
- $nntp->_HELP
-    ? $nntp->read_until_dot
-    : undef;
-}
-
-sub ihave
-{
- @_ >= 2 or croak 'usage: $nntp->ihave( MESSAGE-ID [, MESSAGE ])';
- my $nntp = shift;
- my $mid = shift;
-
- $nntp->_IHAVE($mid) && $nntp->datasend(@_)
-    ? @_ == 0 || $nntp->dataend
-    : undef;
-}
-
-sub last
-{
- @_ == 1 or croak 'usage: $nntp->last()';
- my $nntp = shift;
-
- $nntp->_LAST && $nntp->message =~ /(<[^>]+>)/o
-    ? $1
-    : undef;
-}
-
-sub list
-{
- @_ == 1 or croak 'usage: $nntp->list()';
- my $nntp = shift;
-
- $nntp->_LIST
-    ? $nntp->_grouplist
-    : undef;
-}
-
-sub newgroups
-{
- @_ >= 2 or croak 'usage: $nntp->newgroups( SINCE [, DISTRIBUTIONS ])';
- my $nntp = shift;
- my $time = _timestr(shift);
- my $dist = shift || "";
-
- $dist = join(",", @{$dist})
-    if ref($dist);
-
- $nntp->_NEWGROUPS($time,$dist)
-    ? $nntp->_grouplist
-    : undef;
-}
-
-sub newnews
-{
- @_ >= 3 or croak 'usage: $nntp->newnews( SINCE [, GROUPS [, DISTRIBUTIONS ]])';
- my $nntp = shift;
- my $time = _timestr(shift);
- my $grp  = @_ ? shift : $nntp->group;
- my $dist = shift || "";
-
- $grp ||= "*";
- $grp = join(",", @{$grp})
-    if ref($grp);
-
- $dist = join(",", @{$dist})
-    if ref($dist);
-
- $nntp->_NEWNEWS($grp,$time,$dist)
-    ? $nntp->_articlelist
-    : undef;
-}
-
-sub next
-{
- @_ == 1 or croak 'usage: $nntp->next()';
- my $nntp = shift;
-
- $nntp->_NEXT && $nntp->message =~ /(<[^>]+>)/o
-    ? $1
-    : undef;
-}
-
-sub post
-{
- @_ >= 1 or croak 'usage: $nntp->post( [ MESSAGE ] )';
- my $nntp = shift;
-
- $nntp->_POST() && $nntp->datasend(@_)
-    ? @_ == 0 || $nntp->dataend
-    : undef;
-}
-
-sub quit
-{
- @_ == 1 or croak 'usage: $nntp->quit()';
- my $nntp = shift;
-
- $nntp->_QUIT && $nntp->SUPER::close;
-}
-
-sub slave
-{
- @_ == 1 or croak 'usage: $nntp->slave()';
- my $nntp = shift;
-
- $nntp->_SLAVE;
-}
-
-##
-## The following methods are not implemented by all servers
-##
-
-sub active
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->active( [ PATTERN ] )';
- my $nntp = shift;
-
- $nntp->_LIST('ACTIVE',@_)
-    ? $nntp->_grouplist
-    : undef;
-}
-
-sub active_times
-{
- @_ == 1 or croak 'usage: $nntp->active_times()';
- my $nntp = shift;
-
- $nntp->_LIST('ACTIVE.TIMES')
-    ? $nntp->_grouplist
-    : undef;
-}
-
-sub distributions
-{
- @_ == 1 or croak 'usage: $nntp->distributions()';
- my $nntp = shift;
-
- $nntp->_LIST('DISTRIBUTIONS')
-    ? $nntp->_description
-    : undef;
-}
-
-sub distribution_patterns
-{
- @_ == 1 or croak 'usage: $nntp->distributions()';
- my $nntp = shift;
-
- my $arr;
- local $_;
-
- $nntp->_LIST('DISTRIB.PATS') && ($arr = $nntp->read_until_dot)
-    ? [grep { /^\d/ && (chomp, $_ = [ split /:/ ]) } @$arr]
-    : undef;
-}
-
-sub newsgroups
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->newsgroups( [ PATTERN ] )';
- my $nntp = shift;
-
- $nntp->_LIST('NEWSGROUPS',@_)
-    ? $nntp->_description
-    : undef;
-}
-
-sub overview_fmt
-{
- @_ == 1 or croak 'usage: $nntp->overview_fmt()';
- my $nntp = shift;
-
- $nntp->_LIST('OVERVIEW.FMT')
-     ? $nntp->_articlelist
-     : undef;
-}
-
-sub subscriptions
-{
- @_ == 1 or croak 'usage: $nntp->subscriptions()';
- my $nntp = shift;
-
- $nntp->_LIST('SUBSCRIPTIONS')
-    ? $nntp->_articlelist
-    : undef;
-}
-
-sub listgroup
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->listgroup( [ GROUP ] )';
- my $nntp = shift;
-
- $nntp->_LISTGROUP(@_)
-    ? $nntp->_articlelist
-    : undef;
-}
-
-sub reader
-{
- @_ == 1 or croak 'usage: $nntp->reader()';
- my $nntp = shift;
-
- $nntp->_MODE('READER');
-}
-
-sub xgtitle
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->xgtitle( [ PATTERN ] )';
- my $nntp = shift;
-
- $nntp->_XGTITLE(@_)
-    ? $nntp->_description
-    : undef;
-}
-
-sub xhdr
-{
- @_ >= 2 && @_ <= 4 or croak 'usage: $nntp->xhdr( HEADER, [ MESSAGE-ID | MESSAGE_NUM [, MESSAGE-NUM ]] )';
- my($nntp,$hdr,$first) = splice(@_,0,3);
-
- my $arg = "$first";
-
- if(@_)
-  {
-   my $last = shift;
-
-   $arg .= "-";
-   $arg .= "$last"
-       if(defined $last && $last > $first);
-  }
-
- $nntp->_XHDR($hdr, $arg)
-    ? $nntp->_description
-    : undef;
-}
-
-sub xover
-{
- @_ == 2 || @_ == 3 or croak 'usage: $nntp->xover( RANGE )';
- my($nntp,$first) = splice(@_,0,2);
-
- my $arg = "$first";
-
- if(@_)
-  {
-   my $last = shift;
-   $arg .= "-";
-   $arg .= "$last"
-       if(defined $last && $last > $first);
-  }
-
- $nntp->_XOVER($arg)
-    ? $nntp->_fieldlist
-    : undef;
-}
-
-sub xpat
-{
- @_ == 4 || @_ == 5 or croak '$nntp->xpat( HEADER, PATTERN, RANGE )';
- my($nntp,$hdr,$pat,$first) = splice(@_,0,4);
-
- my $arg = "$first";
-
- if(@_)
-  {
-   my $last = shift;
-   $arg .= "-";
-   $arg .= "$last"
-       if(defined $last && $last > $first);
-  }
-
- $pat = join(" ", @$pat)
-    if ref($pat);
-
- $nntp->_XPAT($hdr,$arg,$pat)
-    ? $nntp->_description
-    : undef;
-}
-
-sub xpath
-{
- @_ == 2 or croak 'usage: $nntp->xpath( MESSAGE-ID )';
- my($nntp,$mid) = @_;
-
- return undef
-       unless $nntp->_XPATH($mid);
-
- my $m; ($m = $nntp->message) =~ s/^\d+\s+//o;
- my @p = split /\s+/, $m;
-
- wantarray ? @p : $p[0];
-}
-
-sub xrover
-{
- @_ == 2 || @_ == 3 or croak 'usage: $nntp->xrover( RANGE )';
- my($nntp,$first) = splice(@_,0,2);
-
- my $arg = "$first";
-
- if(@_)
-  {
-   my $last = shift;
-
-   $arg .= "-";
-   $arg .= "$last"
-       if(defined $last && $last > $first);
-  }
-
- $nntp->_XROVER($arg)
-    ? $nntp->_fieldlist
-    : undef;
-}
-
-sub date
-{
- @_ == 1 or croak 'usage: $nntp->date()';
- my $nntp = shift;
-
- $nntp->_DATE && $nntp->message =~ /(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/
-    ? timegm($6,$5,$4,$3,$2-1,$1)
-    : undef;
-}
-
-
-##
-## Private subroutines
-##
-
-sub _timestr
-{
- my $time = shift;
- my @g = reverse((gmtime($time))[0..5]);
- $g[1] += 1;
- $g[0] %= 100;
- sprintf "%02d%02d%02d %02d%02d%02d GMT", @g;
-}
-
-sub _grouplist
-{
- my $nntp = shift;
- my $arr = $nntp->read_until_dot or
-    return undef;
-
- my $hash = {};
- my $ln;
-
- foreach $ln (@$arr)
-  {
-   my @a = split(/[\s\n]+/,$ln);
-   $hash->{$a[0]} = [ @a[1,2,3] ];
-  }
-
- $hash;
-}
-
-sub _fieldlist
-{
- my $nntp = shift;
- my $arr = $nntp->read_until_dot or
-    return undef;
-
- my $hash = {};
- my $ln;
-
- foreach $ln (@$arr)
-  {
-   my @a = split(/[\t\n]/,$ln);
-   $hash->{$a[0]} = @a[1,2,3];
-  }
-
- $hash;
-}
-
-sub _articlelist
-{
- my $nntp = shift;
- my $arr = $nntp->read_until_dot;
-
- chomp(@$arr)
-    if $arr;
-
- $arr;
-}
-
-sub _description
-{
- my $nntp = shift;
- my $arr = $nntp->read_until_dot or
-    return undef;
-
- my $hash = {};
- my $ln;
-
- foreach $ln (@$arr)
-  {
-   chomp($ln);
-
-   $hash->{$1} = $ln
-    if $ln =~ s/^\s*(\S+)\s*//o;
-  }
-
- $hash;
-
-}
-
-##
-## The commands
-##
-
-sub _ARTICLE   { shift->command('ARTICLE',@_)->response == CMD_OK }
-sub _AUTHINFO  { shift->command('AUTHINFO',@_)->response }
-sub _BODY      { shift->command('BODY',@_)->response == CMD_OK }
-sub _DATE      { shift->command('DATE')->response == CMD_INFO }
-sub _GROUP     { shift->command('GROUP',@_)->response == CMD_OK }
-sub _HEAD      { shift->command('HEAD',@_)->response == CMD_OK }
-sub _HELP      { shift->command('HELP',@_)->response == CMD_INFO }
-sub _IHAVE     { shift->command('IHAVE',@_)->response == CMD_MORE }
-sub _LAST      { shift->command('LAST')->response == CMD_OK }
-sub _LIST      { shift->command('LIST',@_)->response == CMD_OK }
-sub _LISTGROUP { shift->command('LISTGROUP',@_)->response == CMD_OK }
-sub _NEWGROUPS { shift->command('NEWGROUPS',@_)->response == CMD_OK }
-sub _NEWNEWS   { shift->command('NEWNEWS',@_)->response == CMD_OK }
-sub _NEXT      { shift->command('NEXT')->response == CMD_OK }
-sub _POST      { shift->command('POST',@_)->response == CMD_OK }
-sub _QUIT      { shift->command('QUIT',@_)->response == CMD_OK }
-sub _SLAVE     { shift->command('SLAVE',@_)->response == CMD_OK }
-sub _STAT      { shift->command('STAT',@_)->response == CMD_OK }
-sub _MODE      { shift->command('MODE',@_)->response == CMD_OK }
-sub _XGTITLE   { shift->command('XGTITLE',@_)->response == CMD_OK }
-sub _XHDR      { shift->command('XHDR',@_)->response == CMD_OK }
-sub _XPAT      { shift->command('XPAT',@_)->response == CMD_OK }
-sub _XPATH     { shift->command('XPATH',@_)->response == CMD_OK }
-sub _XOVER     { shift->command('XOVER',@_)->response == CMD_OK }
-sub _XROVER    { shift->command('XROVER',@_)->response == CMD_OK }
-sub _XTHREAD   { shift->unsupported }
-sub _XSEARCH   { shift->unsupported }
-sub _XINDEX    { shift->unsupported }
-
-##
-## IO/perl methods
-##
-
-sub close
-{
- my $nntp = shift;
-
- ref($nntp) 
-    && defined fileno($nntp)
-    && $nntp->quit;
-}
-
-sub DESTROY { shift->close }
-
-
-1;
diff --git a/lib/Net/Netrc.pm b/lib/Net/Netrc.pm
deleted file mode 100644 (file)
index 4299821..0000000
+++ /dev/null
@@ -1,316 +0,0 @@
-# Net::Netrc.pm
-#
-# Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.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::Netrc;
-
-=head1 NAME
-
-Net::Netrc - OO interface to users netrc file
-
-=head1 SYNOPSIS
-
-    use Net::Netrc;
-    
-    $mach = Net::Netrc->lookup('some.machine');
-    $login = $mach->login;
-    ($login, $password, $account) = $mach->lpa;
-
-=head1 DESCRIPTION
-
-C<Net::Netrc> is a class implementing a simple interface to the .netrc file
-used as by the ftp program.
-
-C<Net::Netrc> also implements security checks just like the ftp program,
-these checks are, first that the .netrc file must be owned by the user and 
-second the ownership permissions should be such that only the owner has
-read and write access. If these conditions are not met then a warning is
-output and the .netrc file is not read.
-
-=head1 THE .netrc FILE
-
-The .netrc file contains login and initialization information used by the
-auto-login process.  It resides in the user's home directory.  The following
-tokens are recognized; they may be separated by spaces, tabs, or new-lines:
-
-=over 4
-
-=item machine name
-
-Identify a remote machine name. The auto-login process searches
-the .netrc file for a machine token that matches the remote machine
-specified.  Once a match is made, the subsequent .netrc tokens
-are processed, stopping when the end of file is reached or an-
-other machine or a default token is encountered.
-
-=item default
-
-This is the same as machine name except that default matches
-any name.  There can be only one default token, and it must be
-after all machine tokens.  This is normally used as:
-
-    default login anonymous password user@site
-
-thereby giving the user automatic anonymous login to machines
-not specified in .netrc.
-
-=item login name
-
-Identify a user on the remote machine.  If this token is present,
-the auto-login process will initiate a login using the
-specified name.
-
-=item password string
-
-Supply a password.  If this token is present, the auto-login
-process will supply the specified string if the remote server
-requires a password as part of the login process.
-
-=item account string
-
-Supply an additional account password.  If this token is present,
-the auto-login process will supply the specified string
-if the remote server requires an additional account password.
-
-=item macdef name
-
-Define a macro. C<Net::Netrc> only parses this field to be compatible
-with I<ftp>.
-
-=back
-
-=head1 CONSTRUCTOR
-
-The constructor for a C<Net::Netrc> object is not called new as it does not
-really create a new object. But instead is called C<lookup> as this is
-essentially what it deos.
-
-=over 4
-
-=item lookup ( MACHINE [, LOGIN ])
-
-Lookup and return a reference to the entry for C<MACHINE>. If C<LOGIN> is given
-then the entry returned will have the given login. If C<LOGIN> is not given then
-the first entry in the .netrc file for C<MACHINE> will be returned.
-
-If a matching entry cannot be found, and a default entry exists, then a
-reference to the default entry is returned.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item login ()
-
-Return the login id for the netrc entry
-
-=item password ()
-
-Return the password for the netrc entry
-
-=item account ()
-
-Return the account information for the netrc entry
-
-=item lpa ()
-
-Return a list of login, password and account information fir the netrc entry
-
-=back
-
-=head1 AUTHOR
-
-Graham Barr <Graham.Barr@tiuk.ti.com>
-
-=head1 REVISION
-
-$Revision: 2.1 $
-
-=head1 SEE ALSO
-
-L<Net::Netrc>
-L<Net::Cmd>
-
-=head1 COPYRIGHT
-
-Copyright (c) 1995 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
-
-use Carp;
-use strict;
-use FileHandle;
-use vars qw($VERSION);
-
-$VERSION = sprintf("%d.%02d", q$Revision: 2.1 $ =~ /(\d+)\.(\d+)/);
-
-my %netrc = ();
-
-sub _readrc
-{
- my $host = shift;
-
- # Some OS's don't have `getpwuid', so we default to $ENV{HOME}
- my $home = eval { (getpwuid($>))[7] } || $ENV{HOME};
- my $file = $home . "/.netrc";
-
- my($login,$pass,$acct) = (undef,undef,undef);
- my $fh;
- local $_;
-
- $netrc{default} = undef;
-
- # OS/2 does not handle stat in a way compatable with this check :-(
- unless($^O eq 'os2')
-  { 
-   my @stat = stat($file);
-
-   if(@stat)
-    {
-     if($stat[2] & 077)
-      {
-       carp "Bad permissions: $file";
-       return;
-      }
-     if($stat[4] != $<)
-      {
-       carp "Not owner: $file";
-       return;
-      }
-    }
-  }
-
- if($fh = FileHandle->new($file,"r"))
-  {
-   my($mach,$macdef,$tok,@tok) = (0,0);
-
-   while(<$fh>)
-    {
-     undef $macdef if /\A\n\Z/;
-
-     if($macdef)
-      {
-       push(@$macdef,$_);
-       next;
-      }
-
-     push(@tok, split(/[\s\n]+/, $_));
-
-TOKEN:
-     while(@tok)
-      {
-       if($tok[0] eq "default")
-        {
-         shift(@tok);
-         $mach = bless {};
-        $netrc{default} = [$mach];
-
-         next TOKEN;
-        }
-
-       last TOKEN
-            unless @tok > 1;
-
-       $tok = shift(@tok);
-
-       if($tok eq "machine")
-        {
-         my $host = shift @tok;
-         $mach = bless {machine => $mach};
-
-         $netrc{$host} = []
-            unless exists($netrc{$host});
-         push(@{$netrc{$host}}, $mach);
-        }
-       elsif($tok =~ /^(login|password|account)$/)
-        {
-         next TOKEN unless $mach;
-         my $value = shift @tok;
-         $mach->{$1} = $value;
-        }
-       elsif($tok eq "macdef")
-        {
-         next TOKEN unless $mach;
-         my $value = shift @tok;
-         $mach->{macdef} = {}
-            unless exists $mach->{macdef};
-         $macdef = $mach->{machdef}{$value} = [];
-        }
-      }
-    }
-   $fh->close();
-  }
-}
-
-sub lookup
-{
- my($pkg,$mach,$login) = @_;
-
- _readrc()
-    unless exists $netrc{default};
-
- $mach ||= 'default';
- undef $login
-    if $mach eq 'default';
-
- if(exists $netrc{$mach})
-  {
-   if(defined $login)
-    {
-     my $m;
-     foreach $m (@{$netrc{$mach}})
-      {
-       return $m
-            if(exists $m->{login} && $m->{login} eq $login);
-      }
-     return undef;
-    }
-   return $netrc{$mach}->[0]
-  }
-
- return $netrc{default}
-    if defined $netrc{default};
-
- return undef;
-}
-
-sub login
-{
- my $me = shift;
-
- exists $me->{login}
-    ? $me->{login}
-    : undef;
-}
-
-sub account
-{
- my $me = shift;
-
- exists $me->{account}
-    ? $me->{account}
-    : undef;
-}
-
-sub password
-{
- my $me = shift;
-
- exists $me->{password}
-    ? $me->{password}
-    : undef;
-}
-
-sub lpa
-{
- my $me = shift;
- ($me->login, $me->password, $me->account);
-}
-
-1;
diff --git a/lib/Net/POP3.pm b/lib/Net/POP3.pm
deleted file mode 100644 (file)
index 538039e..0000000
+++ /dev/null
@@ -1,402 +0,0 @@
-# Net::POP3.pm
-#
-# Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.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::POP3;
-
-=head1 NAME
-
-Net::POP3 - Post Office Protocol 3 Client class (RFC1081)
-
-=head1 SYNOPSIS
-
-    use Net::POP3;
-    
-    # Constructors
-    $pop = Net::POP3->new('pop3host');
-    $pop = Net::POP3->new('pop3host', Timeout => 60);
-
-=head1 DESCRIPTION
-
-This module implements a client interface to the POP3 protocol, enabling
-a perl5 application to talk to POP3 servers. This documentation assumes
-that you are familiar with the POP3 protocol described in RFC1081.
-
-A new Net::POP3 object must be created with the I<new> method. Once
-this has been done, all POP3 commands are accessed via method calls
-on the object.
-
-=head1 EXAMPLES
-
-    Need some small examples in here :-)
-
-=head1 CONSTRUCTOR
-
-=over 4
-
-=item new ( HOST, [ OPTIONS ] )
-
-This is the constructor for a new Net::POP3 object. C<HOST> is the
-name of the remote host to which a POP3 connection is required.
-
-C<OPTIONS> are passed in a hash like fasion, using key and value pairs.
-Possible options are:
-
-B<Timeout> - Maximum time, in seconds, to wait for a response from the
-POP3 server (default: 120)
-
-B<Debug> - Enable debugging information
-
-=back
-
-=head1 METHODS
-
-Unless otherwise stated all methods return either a I<true> or I<false>
-value, with I<true> meaning that the operation was a success. When a method
-states that it returns a value, falure will be returned as I<undef> or an
-empty list.
-
-=over 4
-
-=item user ( USER )
-
-Send the USER command.
-
-=item pass ( PASS )
-
-Send the PASS command. Returns the number of messages in the mailbox.
-
-=item login ( [ USER [, PASS ]] )
-
-Send both the the USER and PASS commands. If C<PASS> is not given the
-C<Net::POP3> uses C<Net::Netrc> to lookup the password using the host
-and username. If the username is not specified then the current user name
-will be used.
-
-Returns the number of messages in the mailbox.
-
-=item top ( MSGNUM [, NUMLINES ] )
-
-Get the header and the first C<NUMLINES> of the body for the message
-C<MSGNUM>. Returns a reference to an array which contains the lines of text
-read from the server.
-
-=item list ( [ MSGNUM ] )
-
-If called with an argument the C<list> returns the size of the messsage
-in octets.
-
-If called without arguments the a refererence to a hash is returned. The
-keys will be the C<MSGNUM>'s of all undeleted messages and the values will
-be their size in octets.
-
-=item get ( MSGNUM )
-
-Get the message C<MSGNUM> from the remote mailbox. Returns a reference to an
-array which contains the lines of text read from the server.
-
-=item last ()
-
-Returns the highest C<MSGNUM> of all the messages accessed.
-
-=item popstat ()
-
-Returns an array of two elements. These are the number of undeleted
-elements and the size of the mbox in octets.
-
-=item delete ( MSGNUM )
-
-Mark message C<MSGNUM> to be deleted from the remote mailbox. All messages
-that are marked to be deleted will be removed from the remote mailbox
-when the server connection closed.
-
-=item reset ()
-
-Reset the status of the remote POP3 server. This includes reseting the
-status of all messages to not be deleted.
-
-=item quit ()
-
-Quit and close the connection to the remote POP3 server. Any messages marked
-as deleted will be deleted from the remote mailbox.
-
-=back
-
-=head1 NOTES
-
-If a C<Net::POP3> object goes out of scope before C<quit> method is called
-then the C<reset> method will called before the connection is closed. This
-means that any messages marked to be deleted will not be.
-
-=head1 SEE ALSO
-
-L<Net::Netrc>
-L<Net::Cmd>
-
-=head1 AUTHOR
-
-Graham Barr <Graham.Barr@tiuk.ti.com>
-
-=head1 REVISION
-
-$Revision: 2.1 $
-$Date: 1996/07/26 06:44:44 $
-
-The VERSION is derived from the revision by changing each number after the
-first dot into a 2 digit number so
-
-       Revision 1.8   => VERSION 1.08
-       Revision 1.2.3 => VERSION 1.0203
-
-=head1 COPYRIGHT
-
-Copyright (c) 1995 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
-
-use strict;
-use IO::Socket;
-use vars qw(@ISA $VERSION $debug);
-use Net::Cmd;
-use Carp;
-
-$VERSION = do{my @r=(q$Revision: 2.1 $=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r};
-
-@ISA = qw(Net::Cmd IO::Socket::INET);
-
-sub new
-{
- my $self = shift;
- my $type = ref($self) || $self;
- my $host = shift;
- my %arg  = @_; 
- my $obj = $type->SUPER::new(PeerAddr => $host, 
-                            PeerPort => $arg{Port} || 'pop3(110)',
-                            Proto    => 'tcp',
-                            Timeout  => defined $arg{Timeout}
-                                               ? $arg{Timeout}
-                                               : 120
-                           ) or return undef;
-
- ${*$obj}{'net_pop3_host'} = $host;
-
- $obj->autoflush(1);
- $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
-
- unless ($obj->response() == CMD_OK)
-  {
-   $obj->close();
-   return undef;
-  }
-
- $obj;
-}
-
-##
-## We don't want people sending me their passwords when they report problems
-## now do we :-)
-##
-
-sub debug_text { $_[2] =~ /^(pass|rpop)/i ? "$1 ....\n" : $_[2]; }
-
-sub login
-{
- @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login( USER, PASS )';
- my($me,$user,$pass) = @_;
-
- if(@_ < 2)
-  {
-   require Net::Netrc;
-
-   $user ||= (getpwuid($>))[0];
-
-   my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user);
-
-   $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'});
-
-   $pass = $m ? $m->password || ""
-              : "";
-  }
-
- $me->user($user) and
-    $me->pass($pass);
-}
-
-sub user
-{
- @_ == 2 or croak 'usage: $pop3->user( USER )';
- $_[0]->_USER($_[1]);
-}
-
-sub pass
-{
- @_ == 2 or croak 'usage: $pop3->pass( PASS )';
-
- my($me,$pass) = @_;
-
- return undef
-   unless($me->_PASS($pass));
-
- $me->message =~ /(\d+)\s+message/io;
-
- ${*$me}{'net_pop3_count'} = $1 || 0;
-}
-
-sub reset
-{
- @_ == 1 or croak 'usage: $obj->reset()';
-
- my $me = shift;
-
- return 0 
-   unless($me->_RSET);
-  
- if(defined ${*$me}{'net_pop3_mail'})
-  {
-   local $_;
-   foreach (@{${*$me}{'net_pop3_mail'}})
-    {
-     delete $_->{'net_pop3_deleted'};
-    }
-  }
-}
-
-sub last
-{
- @_ == 1 or croak 'usage: $obj->last()';
-
- return undef
-    unless $_[0]->_LAST && $_[0]->message =~ /(\d+)/;
-
- return $1;
-}
-
-sub top
-{
- @_ == 2 || @_ == 3 or croak 'usage: $pop3->top( MSGNUM [, NUMLINES ])';
- my $me = shift;
-
- return undef
-    unless $me->_TOP($_[0], $_[1] || 0);
-
- $me->read_until_dot;
-}
-
-sub popstat
-{
- @_ == 1 or croak 'usage: $pop3->popstat()';
- my $me = shift;
-
- return ()
-    unless $me->_STAT && $me->message =~ /(\d+)\D+(\d+)/;
-
- ($1 || 0, $2 || 0);
-}
-
-sub list
-{
- @_ == 1 || @_ == 2 or croak 'usage: $pop3->list( [ MSGNUM ] )';
- my $me = shift;
-
- return undef
-    unless $me->_LIST(@_);
-
- if(@_)
-  {
-   $me->message =~ /\d+\D+(\d+)/;
-   return $1 || undef;
-  }
- my $info = $me->read_until_dot;
- my %hash = ();
- map { /(\d+)\D+(\d+)/; $hash{$1} = $2; } @$info;
-
- return \%hash;
-}
-
-sub get
-{
- @_ == 2 or croak 'usage: $pop3->get( MSGNUM )';
- my $me = shift;
-
- return undef
-    unless $me->_RETR(@_);
-
- $me->read_until_dot;
-}
-
-sub delete
-{
- @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )';
- $_[0]->_DELE($_[1]);
-}
-
-sub _USER { shift->command('USER',$_[0])->response() == CMD_OK }
-sub _PASS { shift->command('PASS',$_[0])->response() == CMD_OK }
-sub _RPOP { shift->command('RPOP',$_[0])->response() == CMD_OK }
-sub _RETR { shift->command('RETR',$_[0])->response() == CMD_OK }
-sub _DELE { shift->command('DELE',$_[0])->response() == CMD_OK }
-sub _TOP  { shift->command('TOP', @_)->response() == CMD_OK }
-sub _LIST { shift->command('LIST',@_)->response() == CMD_OK }
-sub _NOOP { shift->command('NOOP')->response() == CMD_OK }
-sub _RSET { shift->command('RSET')->response() == CMD_OK }
-sub _LAST { shift->command('LAST')->response() == CMD_OK }
-sub _QUIT { shift->command('QUIT')->response() == CMD_OK }
-sub _STAT { shift->command('STAT')->response() == CMD_OK }
-
-sub close
-{
- my $me = shift;
-
- return 1
-   unless (ref($me) && defined fileno($me));
-
- $me->_QUIT && $me->SUPER::close;
-}
-
-sub quit    { shift->close }
-
-sub DESTROY
-{
- my $me = shift;
-
- if(fileno($me))
-  {
-   $me->reset;
-   $me->quit;
-  }
-}
-
-##
-## POP3 has weird responses, so we emulate them to look the same :-)
-##
-
-sub response
-{
- my $cmd = shift;
- my $str = $cmd->getline() || return undef;
- my $code = "500";
-
- $cmd->debug_print(0,$str)
-   if ($cmd->debug);
-
- if($str =~ s/^\+OK\s+//io)
-  {
-   $code = "200"
-  }
- else
-  {
-   $str =~ s/^\+ERR\s+//io;
-  }
-
- ${*$cmd}{'net_cmd_resp'} = [ $str ];
- ${*$cmd}{'net_cmd_code'} = $code;
-
- substr($code,0,1);
-}
-
-1;
diff --git a/lib/Net/SMTP.pm b/lib/Net/SMTP.pm
deleted file mode 100644 (file)
index 8d56523..0000000
+++ /dev/null
@@ -1,526 +0,0 @@
-# Net::SMTP.pm
-#
-# Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.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::SMTP;
-
-=head1 NAME
-
-Net::SMTP - Simple Mail transfer Protocol Client
-
-=head1 SYNOPSIS
-
-    use Net::SMTP;
-    
-    # Constructors
-    $smtp = Net::SMTP->new('mailhost');
-    $smtp = Net::SMTP->new('mailhost', Timeout => 60);
-
-=head1 DESCRIPTION
-
-This module implements a client interface to the SMTP protocol, enabling
-a perl5 application to talk to SMTP servers. This documentation assumes
-that you are familiar with the SMTP protocol described in RFC821.
-
-A new Net::SMTP object must be created with the I<new> method. Once
-this has been done, all SMTP commands are accessed through this object.
-
-=head1 EXAMPLES
-
-This example prints the mail domain name of the SMTP server known as mailhost:
-
-    #!/usr/local/bin/perl -w
-    
-    use Net::SMTP;
-    
-    $smtp = Net::SMTP->new('mailhost');
-    
-    print $smtp->domain,"\n";
-    
-    $smtp->quit;
-
-This example sends a small message to the postmaster at the SMTP server
-known as mailhost:
-
-    #!/usr/local/bin/perl -w
-    
-    use Net::SMTP;
-    
-    $smtp = Net::SMTP->new('mailhost');
-    
-    $smtp->mail($ENV{USER});
-    
-    $smtp->to('postmaster');
-    
-    $smtp->data();
-    
-    $smtp->datasend("To: postmaster\n");
-    $smtp->datasend("\n");
-    $smtp->datasend("A simple test message\n");
-    
-    $smtp->dataend();
-    
-    $smtp->quit;
-
-=head1 CONSTRUCTOR
-
-=over 4
-
-=item new ( HOST, [ OPTIONS ] )
-
-This is the constructor for a new Net::SMTP object. C<HOST> is the
-name of the remote host to which a SMTP connection is required.
-
-C<OPTIONS> are passed in a hash like fasion, using key and value pairs.
-Possible options are:
-
-B<Hello> - SMTP requires that you identify yourself. This option
-specifies a string to pass as your mail domain. If not
-given a guess will be taken.
-
-B<Timeout> - Maximum time, in seconds, to wait for a response from the
-SMTP server (default: 120)
-
-B<Debug> - Enable debugging information
-
-
-Example:
-
-
-    $smtp = Net::SMTP->new('mailhost',
-                          Hello => 'my.mail.domain'
-                         );
-
-=head1 METHODS
-
-Unless otherwise stated all methods return either a I<true> or I<false>
-value, with I<true> meaning that the operation was a success. When a method
-states that it returns a value, falure will be returned as I<undef> or an
-empty list.
-
-=over 4
-
-=item domain ()
-
-Returns the domain that the remote SMTP server identified itself as during
-connection.
-
-=item hello ( DOMAIN )
-
-Tell the remote server the mail domain which you are in using the HELO
-command.
-
-=item mail ( ADDRESS )
-
-=item send ( ADDRESS )
-
-=item send_or_mail ( ADDRESS )
-
-=item send_and_mail ( ADDRESS )
-
-Send the appropriate command to the server MAIL, SEND, SOML or SAML. C<ADDRESS>
-is the address of the sender. This initiates the sending of a message. The
-method C<recipient> should be called for each address that the message is to
-be sent to.
-
-=item reset ()
-
-Reset the status of the server. This may be called after a message has been 
-initiated, but before any data has been sent, to cancel the sending of the
-message.
-
-=item recipient ( ADDRESS [, ADDRESS [ ...]] )
-
-Notify the server that the current message should be sent to all of the
-addresses given. Each address is sent as a separate command to the server.
-Should the sending of any address result in a failure then the
-process is aborted and a I<false> value is returned. It is up to the
-user to call C<reset> if they so desire.
-
-=item to ()
-
-A synonym for recipient
-
-=item data ( [ DATA ] )
-
-Initiate the sending of the data fro the current message. 
-
-C<DATA> may be a reference to a list or a list. If specified the contents
-of C<DATA> and a termination string C<".\r\n"> is sent to the server. And the
-result will be true if the data was accepted.
-
-If C<DATA> is not specified then the result will indicate that the server
-wishes the data to be sent. The data must then be sent using the C<datasend>
-and C<dataend> methods defined in C<Net::Cmd>.
-
-=item expand ( ADDRESS )
-
-Request the server to expand the given address Returns a reference to an array
-which contains the text read from the server.
-
-=item verify ( ADDRESS )
-
-Verify that C<ADDRESS> is a legitimate mailing address.
-
-=item help ( [ $subject ] )
-
-Request help text from the server. Returns the text or undef upon failure
-
-=item quit ()
-
-Send the QUIT command to the remote SMTP server and close the socket connection.
-
-=back
-
-=head1 SEE ALSO
-
-L<Net::Cmd>
-
-=head1 AUTHOR
-
-Graham Barr <Graham.Barr@tiuk.ti.com>
-
-=head1 REVISION
-
-$Revision: 2.1 $
-$Date: 1996/08/20 20:23:56 $
-
-The VERSION is derived from the revision by changing each number after the
-first dot into a 2 digit number so
-
-       Revision 1.8   => VERSION 1.08
-       Revision 1.2.3 => VERSION 1.0203
-
-=head1 COPYRIGHT
-
-Copyright (c) 1995 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
-
-require 5.001;
-
-use strict;
-use vars qw($VERSION @ISA);
-use Socket 1.3;
-use Carp;
-use IO::Socket;
-use Net::Cmd;
-
-$VERSION = do{my @r=(q$Revision: 2.1 $=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r};
-
-@ISA = qw(Net::Cmd IO::Socket::INET);
-
-sub new
-{
- my $self = shift;
- my $type = ref($self) || $self;
- my $host = shift;
- my %arg  = @_; 
- my $obj = $type->SUPER::new(PeerAddr => $host, 
-                            PeerPort => $arg{Port} || 'smtp(25)',
-                            Proto    => 'tcp',
-                            Timeout  => defined $arg{Timeout}
-                                               ? $arg{Timeout}
-                                               : 120
-                           ) or return undef;
-
- $obj->autoflush(1);
-
- $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
-
- unless ($obj->response() == CMD_OK)
-  {
-   $obj->SUPER::close();
-   return undef;
-  }
-
- ${*$obj}{'net_smtp_host'} = $host;
-
- (${*$obj}{'net_smtp_domain'}) = $obj->message =~ /\A\s*(\S+)/;
-
- $obj->hello($arg{Hello} || "");
-
- $obj;
-}
-
-##
-## User interface methods
-##
-
-sub domain
-{
- my $me = shift;
-
- return ${*$me}{'net_smtp_domain'} || undef;
-}
-
-sub hello
-{
- my $me = shift;
- my $domain = shift ||
-             eval {
-                   require Net::Domain;
-                   Net::Domain::hostdomain();
-                  } ||
-               "";
- my $ok = $me->_EHLO($domain);
- my $msg;
-
- if($ok)
-  {
-   $msg = $me->message;
-
-   my $h = ${*$me}{'net_smtp_esmtp'} = {};
-   my $ext;
-   foreach $ext (qw(8BITMIME CHECKPOINT DSN SIZE))
-    {
-     $h->{$ext} = 1
-       if $msg =~ /\b${ext}\b/;
-    }
-  }
- else
-  {
-   $msg = $me->message
-       if $me->_HELO($domain);
-  }
-
- $ok && $msg =~ /\A(\S+)/
-       ? $1
-       : undef;
-}
-
-sub _addr
-{
- my $addr = shift || "";
-
- return $1
-    if $addr =~ /(<[^>]+>)/so;
-
- $addr =~ s/\n/ /sog;
- $addr =~ s/(\A\s+|\s+\Z)//sog;
-
- return "<" . $addr . ">";
-}
-
-
-sub mail
-{
- my $me = shift;
- my $addr = _addr(shift);
- my $opts = "";
-
- if(@_)
-  {
-   my %opt = @_;
-   my($k,$v);
-
-   if(exists ${*$me}{'net_smtp_esmtp'})
-    {
-     my $esmtp = ${*$me}{'net_smtp_esmtp'};
-
-     if(defined($v = delete $opt{Size}))
-      {
-       if(exists $esmtp->{SIZE})
-        {
-         $opts .= sprintf " SIZE=%d", $v + 0
-        }
-       else
-        {
-        carp 'Net::SMTP::mail: SIZE option not supported by host';
-        }
-      }
-
-     if(defined($v = delete $opt{Return}))
-      {
-       if(exists $esmtp->{DSN})
-        {
-        $opts .= " RET=" . uc $v
-        }
-       else
-        {
-        carp 'Net::SMTP::mail: DSN option not supported by host';
-        }
-      }
-
-     if(defined($v = delete $opt{Bits}))
-      {
-       if(exists $esmtp->{'8BITMIME'})
-        {
-        $opts .= $v == 8 ? " BODY=8BITMIME" : " BODY=7BIT"
-        }
-       else
-        {
-        carp 'Net::SMTP::mail: 8BITMIME option not supported by host';
-        }
-      }
-
-     if(defined($v = delete $opt{Transaction}))
-      {
-       if(exists $esmtp->{CHECKPOINT})
-        {
-        $opts .= " TRANSID=" . _addr($v);
-        }
-       else
-        {
-        carp 'Net::SMTP::mail: CHECKPOINT option not supported by host';
-        }
-      }
-
-     if(defined($v = delete $opt{Envelope}))
-      {
-       if(exists $esmtp->{DSN})
-        {
-        $v =~ s/([^\041-\176]|=|\+)/sprintf "+%02x", ord($1)/sge;
-        $opts .= " ENVID=$v"
-        }
-       else
-        {
-        carp 'Net::SMTP::mail: DSN option not supported by host';
-        }
-      }
-
-     carp 'Net::SMTP::recipient: unknown option(s) '
-               . join(" ", keys %opt)
-               . ' - ignored'
-       if scalar keys %opt;
-    }
-   else
-    {
-     carp 'Net::SMTP::mail: ESMTP not supported by host - options discarded :-(';
-    }
-  }
-
- $me->_MAIL("FROM:".$addr.$opts);
-}
-
-sub send         { shift->_SEND("FROM:" . _addr($_[0])) }
-sub send_or_mail  { shift->_SOML("FROM:" . _addr($_[0])) }
-sub send_and_mail { shift->_SAML("FROM:" . _addr($_[0])) }
-
-sub reset
-{
- my $me = shift;
-
- $me->dataend()
-       if(exists ${*$me}{'net_smtp_lastch'});
-
- $me->_RSET();
-}
-
-
-sub recipient
-{
- my $smtp = shift;
- my $ok = 1;
- my $opts = "";
-
- if(@_ && ref($_[-1]))
-  {
-   my %opt = %{pop(@_)};
-   my $v;
-
-   if(exists ${*$smtp}{'net_smtp_esmtp'})
-    {
-     my $esmtp = ${*$smtp}{'net_smtp_esmtp'};
-
-     if(defined($v = delete $opt{Notify}))
-      {
-       if(exists $esmtp->{DSN})
-        {
-        $opts .= " NOTIFY=" . join(",",map { uc $_ } @$v)
-        }
-       else
-        {
-        carp 'Net::SMTP::recipient: DSN option not supported by host';
-        }
-      }
-
-     carp 'Net::SMTP::recipient: unknown option(s) '
-               . join(" ", keys %opt)
-               . ' - ignored'
-       if scalar keys %opt;
-    }
-   else
-    {
-     carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-(';
-    }
-  }
-
- while($ok && scalar(@_))
-  {
-   $ok = $smtp->_RCPT("TO:" . _addr(shift) . $opts);
-  }
-
- return $ok;
-}
-
-*to = \&recipient;
-
-sub data
-{
- my $me = shift;
-
- my $ok = $me->_DATA() && $me->datasend(@_);
-
- $ok && @_ ? $me->dataend
-          : $ok;
-}
-
-sub expand
-{
- my $me = shift;
-
- $me->_EXPN(@_) ? ($me->message)
-               : ();
-}
-
-
-sub verify { shift->_VRFY(@_) }
-
-sub help
-{
- my $me = shift;
-
- $me->_HELP(@_) ? scalar $me->message
-               : undef;
-}
-
-sub close
-{
- my $me = shift;
-
- return 1
-   unless (ref($me) && defined fileno($me));
-
- $me->_QUIT && $me->SUPER::close;
-}
-
-sub DESTROY { shift->close }
-sub quit    { shift->close }
-
-##
-## RFC821 commands
-##
-
-sub _EHLO { shift->command("EHLO", @_)->response()  == CMD_OK }   
-sub _HELO { shift->command("HELO", @_)->response()  == CMD_OK }   
-sub _MAIL { shift->command("MAIL", @_)->response()  == CMD_OK }   
-sub _RCPT { shift->command("RCPT", @_)->response()  == CMD_OK }   
-sub _SEND { shift->command("SEND", @_)->response()  == CMD_OK }   
-sub _SAML { shift->command("SAML", @_)->response()  == CMD_OK }   
-sub _SOML { shift->command("SOML", @_)->response()  == CMD_OK }   
-sub _VRFY { shift->command("VRFY", @_)->response()  == CMD_OK }   
-sub _EXPN { shift->command("EXPN", @_)->response()  == CMD_OK }   
-sub _HELP { shift->command("HELP", @_)->response()  == CMD_OK }   
-sub _RSET { shift->command("RSET")->response()     == CMD_OK }   
-sub _NOOP { shift->command("NOOP")->response()     == CMD_OK }   
-sub _QUIT { shift->command("QUIT")->response()     == CMD_OK }   
-sub _DATA { shift->command("DATA")->response()     == CMD_MORE } 
-sub _TURN { shift->unsupported(@_); }                            
-
-1;
-
diff --git a/lib/Net/SNPP.pm b/lib/Net/SNPP.pm
deleted file mode 100644 (file)
index d869188..0000000
+++ /dev/null
@@ -1,389 +0,0 @@
-# Net::SNPP.pm
-#
-# Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.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::SNPP;
-
-=head1 NAME
-
-Net::SNPP - Simple Network Pager Protocol Client
-
-=head1 SYNOPSIS
-
-    use Net::SNPP;
-    
-    # Constructors
-    $snpp = Net::SNPP->new('snpphost');
-    $snpp = Net::SNPP->new('snpphost', Timeout => 60);
-
-=head1 NOTE
-
-This module is not complete, yet !
-
-=head1 DESCRIPTION
-
-This module implements a client interface to the SNPP protocol, enabling
-a perl5 application to talk to SNPP servers. This documentation assumes
-that you are familiar with the SNPP protocol described in RFC1861.
-
-A new Net::SNPP object must be created with the I<new> method. Once
-this has been done, all SNPP commands are accessed through this object.
-
-=head1 EXAMPLES
-
-This example will send a pager message in one hour saying "Your lunch is ready"
-
-    #!/usr/local/bin/perl -w
-    
-    use Net::SNPP;
-    
-    $snpp = Net::SNPP->new('snpphost');
-    
-    $snpp->send( Pager   => $some_pager_number,
-                Message => "Your lunch is ready",
-                Alert   => 1,
-                Hold    => time + 3600, # lunch ready in 1 hour :-)
-              ) || die $snpp->message;
-    
-    $snpp->quit;
-
-=head1 CONSTRUCTOR
-
-=over 4
-
-=item new ( HOST, [ OPTIONS ] )
-
-This is the constructor for a new Net::SNPP object. C<HOST> is the
-name of the remote host to which a SNPP connection is required.
-
-C<OPTIONS> are passed in a hash like fasion, using key and value pairs.
-Possible options are:
-
-B<Timeout> - Maximum time, in seconds, to wait for a response from the
-SNPP server (default: 120)
-
-B<Debug> - Enable debugging information
-
-
-Example:
-
-
-    $snpp = Net::SNPP->new('snpphost',
-                          Debug => 1,
-                         );
-
-=head1 METHODS
-
-Unless otherwise stated all methods return either a I<true> or I<false>
-value, with I<true> meaning that the operation was a success. When a method
-states that it returns a value, falure will be returned as I<undef> or an
-empty list.
-
-=over 4
-
-=item reset ()
-
-=item help ()
-
-Request help text from the server. Returns the text or undef upon failure
-
-=item quit ()
-
-Send the QUIT command to the remote SNPP server and close the socket connection.
-
-=back
-
-=head1 EXPORTS
-
-C<Net::SNPP> exports all that C<Net::CMD> exports, plus three more subroutines
-that can bu used to compare against the result of C<status>. These are :-
-C<CMD_2WAYERROR>, C<CMD_2WAYOK>, and C<CMD_2WAYQUEUED>.
-
-=head1 SEE ALSO
-
-L<Net::Cmd>
-RFC1861
-
-=head1 AUTHOR
-
-Graham Barr <Graham.Barr@tiuk.ti.com>
-
-=head1 REVISION
-
-$Revision: 1.1 $
-$Date: 1996/07/26 06:49:13 $
-
-The VERSION is derived from the revision by changing each number after the
-first dot into a 2 digit number so
-
-       Revision 1.8   => VERSION 1.08
-       Revision 1.2.3 => VERSION 1.0203
-
-=head1 COPYRIGHT
-
-Copyright (c) 1995 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
-
-require 5.001;
-
-use strict;
-use vars qw($VERSION @ISA @EXPORT);
-use Socket 1.3;
-use Carp;
-use IO::Socket;
-use Net::Cmd;
-
-$VERSION = do{my @r=(q$Revision: 1.1 $=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r};
-@ISA     = qw(Net::Cmd IO::Socket::INET);
-@EXPORT  = qw(CMD_2WAYERROR CMD_2WAYOK CMD_2WAYQUEUED);
-
-sub CMD_2WAYERROR  { 7 }
-sub CMD_2WAYOK     { 8 }
-sub CMD_2WAYQUEUED { 9 }
-
-sub import
-{
- my $pkg = shift;
- my $callpkg = caller;
- my @export = ();
- my %export;
- my $export;
-
- @export{@_} = (1) x @_;
-
- foreach $export (@EXPORT)
-  {
-   if(exists $export{$export})
-    {
-     push(@export,$export);
-     delete $export{$export};
-    }
-  }
-
- Exporter::export 'Net::SNPP', $callpkg, @export
-       if(@_ == 0 || @export);
-
- @export = keys %export;
- Exporter::export 'Net::Cmd',  $callpkg, @export
-       if(@_ == 0 || @export);
-}
-
-sub new
-{
- my $self = shift;
- my $type = ref($self) || $self;
- my $host = shift;
- my %arg  = @_; 
- my $obj = $type->SUPER::new(PeerAddr => $host, 
-                            PeerPort => $arg{Port} || 'snpp(444)',
-                            Proto    => 'tcp',
-                            Timeout  => defined $arg{Timeout}
-                                               ? $arg{Timeout}
-                                               : 120
-                           ) or return undef;
-
- $obj->autoflush(1);
-
- $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
-
- unless ($obj->response() == CMD_OK)
-  {
-   $obj->SUPER::close();
-   return undef;
-  }
-
- $obj;
-}
-
-##
-## User interface methods
-##
-
-sub pager_id
-{
- @_ == 2 or croak 'usage: $snpp->pager_id( PAGER_ID )';
- shift->_PAGE(@_);
-}
-
-sub content
-{
- @_ == 2 or croak 'usage: $snpp->content( MESSAGE )';
- shift->_MESS(@_);
-}
-
-sub send
-{
- my $me = shift;
-
- if(@_)
-  {
-   my %arg = @_;
-
-   $me->_PAGE($arg{Pager}) || return 0
-       if(exists $arg{Pager});
-
-   $me->_MESS($arg{Message}) || return 0
-       if(exists $arg{Message});
-
-   $me->hold($arg{Hold}) || return 0
-       if(exists $arg{Hold});
-
-   $me->hold($arg{HoldLocal},1) || return 0
-       if(exists $arg{HoldLocal});
-
-   $me->_COVE($arg{Coverage}) || return 0
-       if(exists $arg{Coverage});
-
-   $me->_ALER($arg{Alert} ? 1 : 0) || return 0
-       if(exists $arg{Alert});
-
-   $me->service_level($arg{ServiceLevel}) || return 0
-       if(exists $arg{ServiceLevel});
-  }
-
- $me->_SEND();
-}
-
-sub data
-{
- my $me = shift;
-
- my $ok = $me->_DATA() && $me->datasend(@_);
-
- return $ok
-       unless($ok && @_);
-
- $me->dataend;
-}
-
-sub login
-{
- @_ == 2 || @_ == 3 or croak 'usage: $snpp->login( USER [, PASSWORD ])';
- shift->_LOGI(@_);
-}
-
-sub help
-{
- @_ == 1 or croak 'usage: $snpp->help()';
- my $me = shift;
-
- return $me->_HELP() ? $me->message
-                    : undef;
-}
-
-sub service_level
-{
- @_ == 2 or croak 'usage: $snpp->service_level( LEVEL )';
- my $me = shift;
- my $levl = int(shift);
- my($me,$level) = @_;
-
- if($level < 0 || $level > 11)
-  {
-   $me->set_status(550,"Invalid Service Level");
-   return 0;
-  }
-
- $me->_LEVE($levl);
-}
-
-sub alert
-{
- @_ == 1 || @_ == 2 or croak 'usage: $snpp->alert( VALUE )';
- my $me = shift;
- my $value  = (@_ == 1 || shift) ? 1 : 0;
-
- $me->_ALER($value);
-}
-
-sub coverage
-{
- @_ == 1 or croak 'usage: $snpp->coverage( AREA )';
- shift->_COVE(@_);
-}
-
-sub hold
-{
- @_ == 2 || @_ == 3 or croak 'usage: $snpp->hold( TIME [, LOCAL ] )';
- my $me = shift;
- my $until = shift;
- my $local = shift ? "" : " +0000";
-
- my @g = reverse((gmtime($time))[0..5]);
- $g[1] += 1;
- $g[0] %= 100;
-
- $me->_HOLD( sprintf("%02d%02d%02d%02d%02d%02d%s",@g,$local));
-}
-
-sub caller_id
-{
- @_ == 2 or croak 'usage: $snpp->caller_id( CALLER_ID )';
- shift->_CALL(@_);
-}
-
-sub subject
-{
- @_ == 2 or croak 'usage: $snpp->subject( SUBJECT )';
- shift->_SUBJ(@_);
-}
-
-sub two_way
-{
- @_ == 1 or croak 'usage: $snpp->two_way()';
- shift->_2WAY();
-}
-
-sub close
-{
- my $me = shift;
-
- return 1
-   unless (ref($me) && defined fileno($me));
-
- $me->_QUIT && $me->SUPER::close;
-}
-
-sub DESTROY { shift->close }
-sub quit    { shift->close }
-
-##
-## Over-ride methods (Net::Cmd)
-##
-
-sub debug_text
-{
- $_[2] =~ s/^((logi|page)\s+\S+\s+)\S*/$1 xxxx/io;
-}
-
-##
-## RFC1861 commands
-##
-
-# Level 1
-
-sub _PAGE { shift->command("PAGE", @_)->response()  == CMD_OK }   
-sub _MESS { shift->command("MESS", @_)->response()  == CMD_OK }   
-sub _RESE { shift->command("RESE")->response()  == CMD_OK }   
-sub _SEND { shift->command("SEND")->response()  == CMD_OK }   
-sub _QUIT { shift->command("QUIT")->response()  == CMD_OK }   
-sub _HELP { shift->command("HELP")->response()  == CMD_OK }   
-sub _DATA { shift->command("DATA")->response()  == CMD_MORE }   
-
-# Level 2
-
-sub _LOGI { shift->command("LOGI", @_)->response()  == CMD_OK }   
-sub _LEVE { shift->command("LEVE", @_)->response()  == CMD_OK }   
-sub _ALER { shift->command("ALER", @_)->response()  == CMD_OK }   
-sub _COVE { shift->command("COVE", @_)->response()  == CMD_OK }   
-sub _HOLD { shift->command("HOLD", @_)->response()  == CMD_OK }   
-sub _CALL { shift->command("CALL", @_)->response()  == CMD_OK }   
-sub _SUBJ { shift->command("SUBJ", @_)->response()  == CMD_OK }   
-
-
-1;
diff --git a/lib/Net/Telnet.pm b/lib/Net/Telnet.pm
deleted file mode 100644 (file)
index 397502e..0000000
+++ /dev/null
@@ -1,250 +0,0 @@
-
-package        Net::Telnet;
-
-=head1 NAME
-
-Net::Telnet - Defines constants for the telnet protocol
-
-=head1 SYNOPSIS
-
-    use Telnet qw(TELNET_IAC TELNET_DO TELNET_DONT);
-
-=head1 DESCRIPTION
-
-This module is B<VERY> preliminary as I am not 100% sure how it should
-be implemented.
-
-Currently it just exports constants used in the telnet protocol.
-
-Should it contain sub's for packing and unpacking commands ?
-
-Please feel free to send me any suggestions
-
-=head1 NOTE
-
-This is not an implementation of the 'telnet' command but of the telnet
-protocol as defined in RFC854
-
-=head1 AUTHOR
-
-Graham Barr <Graham.Barr@tiuk.ti.com>
-
-=head1 REVISION
-
-$Revision: 2.0 $
-
-=head1 COPYRIGHT
-
-Copyright (c) 1995 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
-
-use     vars qw(@ISA $VERSION);
-require        Exporter;
-@ISA = qw(Exporter);
-
-$VERSION = sprintf("%d.%02d", q$Revision: 2.0 $ =~ /(\d+)\.(\d+)/);
-
-my %telnet = (
-       TELNET_IAC      => 255,         # interpret as command:
-       TELNET_DONT     => 254,         # you are not to use option
-       TELNET_DO       => 253,         # please, you use option
-       TELNET_WONT     => 252,         # I won't use option
-       TELNET_WILL     => 251,         # I will use option
-       TELNET_SB       => 250,         # interpret as subnegotiation
-       TELNET_GA       => 249,         # you may reverse the line
-       TELNET_EL       => 248,         # erase the current line
-       TELNET_EC       => 247,         # erase the current character
-       TELNET_AYT      => 246,         # are you there
-       TELNET_AO       => 245,         # abort output--but let prog finish
-       TELNET_IP       => 244,         # interrupt process--permanently
-       TELNET_BREAK    => 243,         # break
-       TELNET_DM       => 242,         # data mark--for connect. cleaning
-       TELNET_NOP      => 241,         # nop
-       TELNET_SE       => 240,         # end sub negotiation
-       TELNET_EOR      => 239,         # end of record (transparent mode)
-       TELNET_ABORT    => 238,         # Abort process
-       TELNET_SUSP     => 237,         # Suspend process
-       TELNET_EOF      => 236,         # End of file: EOF is already used...
-
-       TELNET_SYNCH    => 242,         # for telfunc calls
-);
-
-while(($n,$v) =        each %telnet) { eval "sub $n {$v}"; }
-
-sub telnet_command {
-    my $cmd = shift;
-    my($n,$v);
-
-    while(($n,$v) = each %telnet) {
-       return $n
-           if($v == $cmd);
-    }
-
-    return undef;
-}
-
-# telnet options
-my %telopt = (
-       TELOPT_BINARY           => 0,   # 8-bit data path
-       TELOPT_ECHO             => 1,   # echo
-       TELOPT_RCP              => 2,   # prepare to reconnect
-       TELOPT_SGA              => 3,   # suppress go ahead
-       TELOPT_NAMS             => 4,   # approximate message size
-       TELOPT_STATUS           => 5,   # give status
-       TELOPT_TM               => 6,   # timing mark
-       TELOPT_RCTE             => 7,   # remote controlled transmission and echo
-       TELOPT_NAOL             => 8,   # negotiate about output line width
-       TELOPT_NAOP             => 9,   # negotiate about output page size
-       TELOPT_NAOCRD           => 10,  # negotiate about CR disposition
-       TELOPT_NAOHTS           => 11,  # negotiate about horizontal tabstops
-       TELOPT_NAOHTD           => 12,  # negotiate about horizontal tab disposition
-       TELOPT_NAOFFD           => 13,  # negotiate about formfeed disposition
-       TELOPT_NAOVTS           => 14,  # negotiate about vertical tab stops
-       TELOPT_NAOVTD           => 15,  # negotiate about vertical tab disposition
-       TELOPT_NAOLFD           => 16,  # negotiate about output LF disposition
-       TELOPT_XASCII           => 17,  # extended ascic character set
-       TELOPT_LOGOUT           => 18,  # force logout
-       TELOPT_BM               => 19,  # byte macro
-       TELOPT_DET              => 20,  # data entry terminal
-       TELOPT_SUPDUP           => 21,  # supdup protocol
-       TELOPT_SUPDUPOUTPUT     => 22,  # supdup output
-       TELOPT_SNDLOC           => 23,  # send location
-       TELOPT_TTYPE            => 24,  # terminal type
-       TELOPT_EOR              => 25,  # end or record
-       TELOPT_TUID             => 26,  # TACACS user identification
-       TELOPT_OUTMRK           => 27,  # output marking
-       TELOPT_TTYLOC           => 28,  # terminal location number
-       TELOPT_3270REGIME       => 29,  # 3270 regime
-       TELOPT_X3PAD            => 30,  # X.3 PAD
-       TELOPT_NAWS             => 31,  # window size
-       TELOPT_TSPEED           => 32,  # terminal speed
-       TELOPT_LFLOW            => 33,  # remote flow control
-       TELOPT_LINEMODE         => 34,  # Linemode option
-       TELOPT_XDISPLOC         => 35,  # X Display Location
-       TELOPT_OLD_ENVIRON      => 36,  # Old - Environment variables
-       TELOPT_AUTHENTICATION   => 37,  # Authenticate
-       TELOPT_ENCRYPT          => 38,  # Encryption option
-       TELOPT_NEW_ENVIRON      => 39,  # New - Environment variables
-       TELOPT_EXOPL            => 255, # extended-options-list
-);
-
-while(($n,$v) =        each %telopt) { eval "sub $n {$v}"; }
-
-sub telnet_option {
-    my $cmd = shift;
-    my($n,$v);
-
-    while(($n,$v) = each %telopt) {
-       return $n
-           if($v == $cmd);
-    }
-
-    return undef;
-}
-
-# sub-option qualifiers
-
-sub TELQUAL_IS         {0}     # option is...
-sub TELQUAL_SEND       {1}     # send option
-sub TELQUAL_INFO       {2}     # ENVIRON: informational version of IS
-sub TELQUAL_REPLY      {2}     # AUTHENTICATION: client version of IS
-sub TELQUAL_NAME       {3}     # AUTHENTICATION: client version of IS
-
-sub LFLOW_OFF          {0}     # Disable remote flow control
-sub LFLOW_ON           {1}     # Enable remote flow control
-sub LFLOW_RESTART_ANY  {2}     # Restart output on any char
-sub LFLOW_RESTART_XON  {3}     # Restart output only on XON
-
-# LINEMODE suboptions
-
-sub LM_MODE            {1}
-sub LM_FORWARDMASK     {2}
-sub LM_SLC             {3}
-
-sub MODE_EDIT          {0x01}
-sub MODE_TRAPSIG       {0x02}
-sub MODE_ACK           {0x04}
-sub MODE_SOFT_TAB      {0x08}
-sub MODE_LIT_ECHO      {0x10}
-
-sub MODE_MASK          {0x1f}
-
-# Not part of protocol,        but needed to simplify things...
-sub MODE_FLOW          {0x0100}
-sub MODE_ECHO          {0x0200}
-sub MODE_INBIN         {0x0400}
-sub MODE_OUTBIN                {0x0800}
-sub MODE_FORCE         {0x1000}
-
-my %slc        = (
-       SLC_SYNCH       =>  1,
-       SLC_BRK         =>  2,
-       SLC_IP          =>  3,
-       SLC_AO          =>  4,
-       SLC_AYT         =>  5,
-       SLC_EOR         =>  6,
-       SLC_ABORT       =>  7,
-       SLC_EOF         =>  8,
-       SLC_SUSP        =>  9,
-       SLC_EC          => 10,
-       SLC_EL          => 11,
-       SLC_EW          => 12,
-       SLC_RP          => 13,
-       SLC_LNEXT       => 14,
-       SLC_XON         => 15,
-       SLC_XOFF        => 16,
-       SLC_FORW1       => 17,
-       SLC_FORW2       => 18,
-);
-
-
-while(($n,$v) =        each %slc) { eval "sub $n {$v}"; }
-
-sub telnet_slc {
-    my $cmd = shift;
-    my($n,$v);
-
-    while(($n,$v) = each %slc) {
-       return $n
-           if($v == $cmd);
-    }
-
-    return undef;
-}
-
-sub NSLC               {18}
-
-sub SLC_NOSUPPORT      {0}
-sub SLC_CANTCHANGE     {1}
-sub SLC_VARIABLE       {2}
-sub SLC_DEFAULT                {3}
-sub SLC_LEVELBITS      {0x03}
-
-sub SLC_FUNC           {0}
-sub SLC_FLAGS          {1}
-sub SLC_VALUE          {2}
-
-sub SLC_ACK            {0x80}
-sub SLC_FLUSHIN                {0x40}
-sub SLC_FLUSHOUT       {0x20}
-
-sub OLD_ENV_VAR                {1}
-sub OLD_ENV_VALUE      {0}
-sub NEW_ENV_VAR                {0}
-sub NEW_ENV_VALUE      {1}
-sub ENV_ESC            {2}
-sub ENV_USERVAR                {3}
-
-@EXPORT_OK = (keys %telnet, keys %telopt, keys %slc);
-
-sub telnet_pack {
-    my $r = '';
-
-
-    $r;
-}
-
-1;
diff --git a/lib/Net/Time.pm b/lib/Net/Time.pm
deleted file mode 100644 (file)
index a6b0b59..0000000
+++ /dev/null
@@ -1,112 +0,0 @@
-# Net::Time.pm
-#
-# Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.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;
-
-=head1 NAME
-
-Net::Time - time and daytime network client interface
-
-=head1 SYNOPSIS
-
-    use Net::Time qw(inet_time inet_daytime);
-    
-    print inet_time('localhost');
-    print inet_time('localhost', 'tcp');
-    
-    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])
-
-Obtain the time on C<HOST> 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])
-
-Obtain the time on C<HOST> 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 <Graham.Barr@tiuk.ti.com>
-
-=head1 REVISION
-
-$Revision: 2.0 $
-
-=head1 COPYRIGHT
-
-Copyright (c) 1995 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
-
-use strict;
-use vars qw($VERSION @ISA @EXPORT_OK);
-use Carp;
-use IO::Socket;
-require Exporter;
-
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(inet_time inet_daytime);
-
-$VERSION = sprintf("%d.%02d", q$Revision: 2.0 $ =~ /(\d+)\.(\d+)/);
-
-sub _socket
-{
- my($pname,$pnum,$host,$proto) = @_;
-
- $proto ||= 'udp';
-
- my $port = (getservbyname($pname, $proto))[2] || $pnum;
-
- my $me = IO::Socket::INET->new(PeerAddr => $host,
-                               PeerPort => $port,
-                               Proto    => $proto
-                              );
-
- $me->send("\n")
-    if(defined $me && $proto eq 'udp');
-
- $me;
-}
-
-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;