Net::Cmd, Net::NNTP, Net::POP3, Net::SMTP

- Add support for returning tied filehandles from some operations

4 files changed, 156 insertions, 9 deletions

diff --git a/Net/Cmd.pm b/Net/Cmd.pm
index e6bdd2a..9093fcd 100644
--- a/Net/Cmd.pm
+++ b/Net/Cmd.pm
@@ -1,4 +1,4 @@
-# Net::Cmd.pm $Id: //depot/libnet/Net/Cmd.pm#27 $
+# Net::Cmd.pm $Id: //depot/libnet/Net/Cmd.pm#28 $
 #
 # Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
 # This program is free software; you can redistribute it and/or
@@ -12,6 +12,7 @@ require Exporter;
 use strict;
 use vars qw(@ISA @EXPORT $VERSION);
 use Carp;
+use Symbol 'gensym';
 
 BEGIN {
   if ($^O eq 'os390') {
@@ -20,7 +21,7 @@ BEGIN {
   }
 }
 
-$VERSION = "2.20";
+$VERSION = "2.21";
 @ISA     = qw(Exporter);
 @EXPORT  = qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING);
 
@@ -476,6 +477,70 @@ sub dataend
  $cmd->response() == CMD_OK;
 }
 
+# read and write to tied filehandle
+sub tied_fh {
+  my $cmd = shift;
+  ${*$cmd}{'net_cmd_readbuf'} = '';
+  my $fh = gensym();
+  tie *$fh,ref($cmd),$cmd;
+  return $fh;
+}
+
+# tie to myself
+sub TIEHANDLE {
+  my $class = shift;
+  my $cmd = shift;
+  return $cmd;
+}
+
+# Tied filehandle read.  Reads requested data length, returning
+# end-of-file when the dot is encountered.
+sub READ {
+  my $cmd = shift;
+  my (undef,$len,$offset) = @_;
+  return unless exists ${*$cmd}{'net_cmd_readbuf'};
+  my $done = 0;
+  while (!$done and length(${*$cmd}{'net_cmd_readbuf'}) < $len) {
+     ${*$cmd}{'net_cmd_readbuf'} .= $cmd->getline() or return;
+     $done++ if ${*$cmd}{'net_cmd_readbuf'} =~ s/^\.\r?\n\Z//m;
+  }
+
+  $_[0] = '';
+  substr($_[0],$offset+0) = substr(${*$cmd}{'net_cmd_readbuf'},0,$len);
+  substr(${*$cmd}{'net_cmd_readbuf'},0,$len) = '';
+  delete ${*$cmd}{'net_cmd_readbuf'} if $done;
+
+  return length $_[0];
+}
+
+sub READLINE {
+  my $cmd = shift;
+  # in this context, we use the presence of readbuf to
+  # indicate that we have not yet reached the eof
+  return unless exists ${*$cmd}{'net_cmd_readbuf'};
+  my $line = $cmd->getline;
+  return if $line =~ /^\.\r?\n/;
+  $line;
+}
+
+sub PRINT {
+  my $cmd = shift;
+  my ($buf,$len,$offset) = @_;
+  $len    ||= length ($buf);
+  $offset += 0;
+  return unless $cmd->datasend(substr($buf,$offset,$len));
+  ${*$cmd}{'net_cmd_sending'}++;  # flag that we should call dataend()
+  return $len;
+}
+
+sub CLOSE {
+  my $cmd = shift;
+  my $r = exists(${*$cmd}{'net_cmd_sending'}) ? $cmd->dataend : 1; 
+  delete ${*$cmd}{'net_cmd_readbuf'};
+  delete ${*$cmd}{'net_cmd_sending'};
+  $r;
+}
+
 1;
 
 __END__
@@ -619,6 +684,16 @@ 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.
 
+=item tied_fh ()
+
+Returns a filehandle tied to the Net::Cmd object.  After issuing a
+command, you may read from this filehandle using read() or <>.  The
+filehandle will return EOF when the final dot is encountered.
+Similarly, you may write to the filehandle in order to send data to
+the server after issuing a commmand that expects data to be written.
+
+See the Net::POP3 and Net::SMTP modules for examples of this.
+
 =back
 
 =head1 EXPORTS
@@ -639,6 +714,6 @@ it under the same terms as Perl itself.
 
 =for html <hr>
 
-I<$Id: //depot/libnet/Net/Cmd.pm#27 $>
+I<$Id: //depot/libnet/Net/Cmd.pm#28 $>
 
 =cut
diff --git a/Net/NNTP.pm b/Net/NNTP.pm
index 0078cf4..521ccf1 100644
--- a/Net/NNTP.pm
+++ b/Net/NNTP.pm
@@ -14,7 +14,7 @@ use Carp;
 use Time::Local;
 use Net::Config;
 
-$VERSION = "2.20"; # $Id: //depot/libnet/Net/NNTP.pm#14 $
+$VERSION = "2.21"; # $Id: //depot/libnet/Net/NNTP.pm#15 $
 @ISA     = qw(Net::Cmd IO::Socket::INET);
 
 sub new
@@ -116,6 +116,14 @@ sub article
     : undef;
 }
 
+sub articlefh {
+ @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->articlefh( [ MSGID ] )';
+ my $nntp = shift;
+
+ return unless $nntp->_ARTICLE(@_);
+ return $nntp->tied_fh;
+}
+
 sub authinfo
 {
  @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
@@ -147,6 +155,14 @@ sub body
     : undef;
 }
 
+sub bodyfh
+{
+ @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->bodyfh( [ MSGID ] )';
+ my $nntp = shift;
+ return unless $nntp->_BODY(@_);
+ return $nntp->tied_fh;
+}
+
 sub head
 {
  @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->head( [ MSGID ], [ FH ] )';
@@ -160,6 +176,14 @@ sub head
     : undef;
 }
 
+sub headfh
+{
+ @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->headfh( [ MSGID ] )';
+ my $nntp = shift;
+ return unless $nntp->_HEAD(@_);
+ return $nntp->tied_fh;
+}
+
 sub nntpstat
 {
  @_ == 1 || @_ == 2 or croak 'usage: $nntp->nntpstat( [ MSGID ] )';
@@ -296,6 +320,12 @@ sub post
     : undef;
 }
 
+sub postfh {
+  my $nntp = shift;
+  return unless $nntp->_POST();
+  return $nntp->tied_fh;
+}
+
 sub quit
 {
  @_ == 1 or croak 'usage: $nntp->quit()';
@@ -743,6 +773,16 @@ Like C<article> but only fetches the body of the article.
 
 Like C<article> but only fetches the headers for the article.
 
+=item articlefh ( [ MSGID|MSGNUM ] )
+
+=item bodyfh ( [ MSGID|MSGNUM ] )
+
+=item headfh ( [ MSGID|MSGNUM ] )
+
+These are similar to article(), body() and head(), but rather than
+returning the requested data directly, they return a tied filehandle
+from which to read the article.
+
 =item nntpstat ( [ MSGID|MSGNUM ] )
 
 The C<nntpstat> command is similar to the C<article> command except that no
@@ -842,6 +882,15 @@ 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 postfh ()
+
+Post a new article to the news server using a tied filehandle.  If
+posting is allowed, this method will return a tied filehandle that you
+can print() the contents of the article to be posted.  You must
+explicitly close() the filehandle when you are finished posting the
+article, and the return value from the close() call will indicate
+whether the message was successfully posted.
+
 =item slave ()
 
 Tell the remote server that I am not a user client, but probably another
@@ -1064,6 +1113,6 @@ it under the same terms as Perl itself.
 
 =for html <hr>
 
-I<$Id: //depot/libnet/Net/NNTP.pm#14 $>
+I<$Id: //depot/libnet/Net/NNTP.pm#15 $>
 
 =cut
diff --git a/Net/POP3.pm b/Net/POP3.pm
index 89f0313..5a75010 100644
--- a/Net/POP3.pm
+++ b/Net/POP3.pm
@@ -13,7 +13,7 @@ use Net::Cmd;
 use Carp;
 use Net::Config;
 
-$VERSION = "2.22"; # $Id: //depot/libnet/Net/POP3.pm#20 $
+$VERSION = "2.23"; # $Id: //depot/libnet/Net/POP3.pm#21 $
 
 @ISA = qw(Net::Cmd IO::Socket::INET);
 
@@ -235,6 +235,17 @@ sub get
  $me->read_until_dot(@_);
 }
 
+sub getfh
+{
+ @_ == 2 or croak 'usage: $pop3->getfh( MSGNUM )';
+ my $me = shift;
+
+ return unless $me->_RETR(shift);
+ return        $me->tied_fh;
+}
+
+
+
 sub delete
 {
  @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )';
@@ -459,6 +470,12 @@ then get returns a reference to an array which contains the lines of
 text read from the server. If C<FH> is given then the lines returned
 from the server are printed to the filehandle C<FH>.
 
+=item getfh ( MSGNUM )
+
+As per get(), but returns a tied filehandle.  Reading from this
+filehandle returns the requested message.  The filehandle will return
+EOF at the end of the message and should not be reused.
+
 =item last ()
 
 Returns the highest C<MSGNUM> of all the messages accessed.
@@ -520,6 +537,6 @@ it under the same terms as Perl itself.
 
 =for html <hr>
 
-I<$Id: //depot/libnet/Net/POP3.pm#20 $>
+I<$Id: //depot/libnet/Net/POP3.pm#21 $>
 
 =cut
diff --git a/Net/SMTP.pm b/Net/SMTP.pm
index e5d2d4c..e76863d 100644
--- a/Net/SMTP.pm
+++ b/Net/SMTP.pm
@@ -16,7 +16,7 @@ use IO::Socket;
 use Net::Cmd;
 use Net::Config;
 
-$VERSION = "2.20"; # $Id: //depot/libnet/Net/SMTP.pm#21 $
+$VERSION = "2.21"; # $Id: //depot/libnet/Net/SMTP.pm#22 $
 
 @ISA = qw(Net::Cmd IO::Socket::INET);
 
@@ -346,6 +346,12 @@ sub data
            : $ok;
 }
 
+sub datafh {
+  my $me = shift;
+  return unless $me->_DATA();
+  return $me->tied_fh;
+}
+
 sub expand
 {
  my $me = shift;
@@ -641,6 +647,6 @@ it under the same terms as Perl itself.
 
 =for html <hr>
 
-I<$Id: //depot/libnet/Net/SMTP.pm#21 $>
+I<$Id: //depot/libnet/Net/SMTP.pm#22 $>
 
 =cut