cpan/libnet/lib/Net/Cmd.pm

   1 # Net::Cmd.pm
   2 #
   3 # Versions up to 2.29_1 Copyright (c) 1995-2006 Graham Barr <gbarr@pobox.com>.
   4 # All rights reserved.
   5 # Changes in Version 2.29_2 onwards Copyright (C) 2013-2015 Steve Hay.  All
   6 # rights reserved.
   7 # This module is free software; you can redistribute it and/or modify it under
   8 # the same terms as Perl itself, i.e. under the terms of either the GNU General
   9 # Public License or the Artistic License, as specified in the F<LICENCE> file.
  10
  11 package Net::Cmd;
  12
  13 use 5.008001;
  14
  15 use strict;
  16 use warnings;
  17
  18 use Carp;
  19 use Exporter;
  20 use Symbol 'gensym';
  21
  22 BEGIN {
  23   if ($^O eq 'os390') {
  24     require Convert::EBCDIC;
  25
  26     #    Convert::EBCDIC->import;
  27   }
  28 }
  29
  30 our $VERSION = "3.07";
  31 our @ISA     = qw(Exporter);
  32 our @EXPORT  = qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING);
  33
  34 use constant CMD_INFO    => 1;
  35 use constant CMD_OK      => 2;
  36 use constant CMD_MORE    => 3;
  37 use constant CMD_REJECT  => 4;
  38 use constant CMD_ERROR   => 5;
  39 use constant CMD_PENDING => 0;
  40
  41 use constant DEF_REPLY_CODE => 421;
  42
  43 my %debug = ();
  44
  45 my $tr = $^O eq 'os390' ? Convert::EBCDIC->new() : undef;
  46
  47 sub toebcdic {
  48   my $cmd = shift;
  49
  50   unless (exists ${*$cmd}{'net_cmd_asciipeer'}) {
  51     my $string    = $_[0];
  52     my $ebcdicstr = $tr->toebcdic($string);
  53     ${*$cmd}{'net_cmd_asciipeer'} = $string !~ /^\d+/ && $ebcdicstr =~ /^\d+/;
  54   }
  55
  56   ${*$cmd}{'net_cmd_asciipeer'}
  57     ? $tr->toebcdic($_[0])
  58     : $_[0];
  59 }
  60
  61
  62 sub toascii {
  63   my $cmd = shift;
  64   ${*$cmd}{'net_cmd_asciipeer'}
  65     ? $tr->toascii($_[0])
  66     : $_[0];
  67 }
  68
  69
  70 sub _print_isa {
  71   no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitNoStrict)
  72
  73   my $pkg = shift;
  74   my $cmd = $pkg;
  75
  76   $debug{$pkg} ||= 0;
  77
  78   my %done = ();
  79   my @do   = ($pkg);
  80   my %spc  = ($pkg, "");
  81
  82   while ($pkg = shift @do) {
  83     next if defined $done{$pkg};
  84
  85     $done{$pkg} = 1;
  86
  87     my $v =
  88       defined ${"${pkg}::VERSION"}
  89       ? "(" . ${"${pkg}::VERSION"} . ")"
  90       : "";
  91
  92     my $spc = $spc{$pkg};
  93     $cmd->debug_print(1, "${spc}${pkg}${v}\n");
  94
  95     if (@{"${pkg}::ISA"}) {
  96       @spc{@{"${pkg}::ISA"}} = ("  " . $spc{$pkg}) x @{"${pkg}::ISA"};
  97       unshift(@do, @{"${pkg}::ISA"});
  98     }
  99   }
 100 }
 101
 102
 103 sub debug {
 104   @_ == 1 or @_ == 2 or croak 'usage: $obj->debug([LEVEL])';
 105
 106   my ($cmd, $level) = @_;
 107   my $pkg    = ref($cmd) || $cmd;
 108   my $oldval = 0;
 109
 110   if (ref($cmd)) {
 111     $oldval = ${*$cmd}{'net_cmd_debug'} || 0;
 112   }
 113   else {
 114     $oldval = $debug{$pkg} || 0;
 115   }
 116
 117   return $oldval
 118     unless @_ == 2;
 119
 120   $level = $debug{$pkg} || 0
 121     unless defined $level;
 122
 123   _print_isa($pkg)
 124     if ($level && !exists $debug{$pkg});
 125
 126   if (ref($cmd)) {
 127     ${*$cmd}{'net_cmd_debug'} = $level;
 128   }
 129   else {
 130     $debug{$pkg} = $level;
 131   }
 132
 133   $oldval;
 134 }
 135
 136
 137 sub message {
 138   @_ == 1 or croak 'usage: $obj->message()';
 139
 140   my $cmd = shift;
 141
 142   wantarray
 143     ? @{${*$cmd}{'net_cmd_resp'}}
 144     : join("", @{${*$cmd}{'net_cmd_resp'}});
 145 }
 146
 147
 148 sub debug_text { $_[2] }
 149
 150
 151 sub debug_print {
 152   my ($cmd, $out, $text) = @_;
 153   print STDERR $cmd, ($out ? '>>> ' : '<<< '), $cmd->debug_text($out, $text);
 154 }
 155
 156
 157 sub code {
 158   @_ == 1 or croak 'usage: $obj->code()';
 159
 160   my $cmd = shift;
 161
 162   ${*$cmd}{'net_cmd_code'} = $cmd->DEF_REPLY_CODE
 163     unless exists ${*$cmd}{'net_cmd_code'};
 164
 165   ${*$cmd}{'net_cmd_code'};
 166 }
 167
 168
 169 sub status {
 170   @_ == 1 or croak 'usage: $obj->status()';
 171
 172   my $cmd = shift;
 173
 174   substr(${*$cmd}{'net_cmd_code'}, 0, 1);
 175 }
 176
 177
 178 sub set_status {
 179   @_ == 3 or croak 'usage: $obj->set_status(CODE, MESSAGE)';
 180
 181   my $cmd = shift;
 182   my ($code, $resp) = @_;
 183
 184   $resp = defined $resp ? [$resp] : []
 185     unless ref($resp);
 186
 187   (${*$cmd}{'net_cmd_code'}, ${*$cmd}{'net_cmd_resp'}) = ($code, $resp);
 188
 189   1;
 190 }
 191
 192
 193
 194 sub _set_status_timeout {
 195   my $cmd = shift;
 196   my $pkg = ref($cmd) || $cmd;
 197
 198   $cmd->set_status($cmd->DEF_REPLY_CODE, "[$pkg] Timeout");
 199   carp(ref($cmd) . ": " . (caller(1))[3] . "(): timeout") if $cmd->debug;
 200 }
 201
 202 sub _set_status_closed {
 203   my $cmd = shift;
 204   my $pkg = ref($cmd) || $cmd;
 205
 206   $cmd->set_status($cmd->DEF_REPLY_CODE, "[$pkg] Connection closed");
 207   carp(ref($cmd) . ": " . (caller(1))[3]
 208     . "(): unexpected EOF on command channel: $!") if $cmd->debug;
 209 }
 210
 211 sub _is_closed {
 212   my $cmd = shift;
 213   if (!defined fileno($cmd)) {
 214      $cmd->_set_status_closed;
 215      return 1;
 216   }
 217   return 0;
 218 }
 219
 220 sub command {
 221   my $cmd = shift;
 222
 223   return $cmd
 224     if $cmd->_is_closed;
 225
 226   $cmd->dataend()
 227     if (exists ${*$cmd}{'net_cmd_last_ch'});
 228
 229   if (scalar(@_)) {
 230     local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS';
 231
 232     my $str = join(
 233       " ",
 234       map {
 235         /\n/
 236           ? do { my $n = $_; $n =~ tr/\n/ /; $n }
 237           : $_;
 238         } @_
 239     );
 240     $str = $cmd->toascii($str) if $tr;
 241     $str .= "\015\012";
 242
 243     my $len = length $str;
 244     my $swlen;
 245
 246     $cmd->debug_print(1, $str)
 247       if ($cmd->debug);
 248
 249     unless (defined($swlen = syswrite($cmd,$str,$len)) && $swlen == $len) {
 250       $cmd->close;
 251       $cmd->_set_status_closed;
 252       return $cmd;
 253     }
 254   }
 255
 256   $cmd;
 257 }
 258
 259
 260 sub ok {
 261   @_ == 1 or croak 'usage: $obj->ok()';
 262
 263   my $code = $_[0]->code;
 264   0 < $code && $code < 400;
 265 }
 266
 267
 268 sub unsupported {
 269   my $cmd = shift;
 270
 271   $cmd->set_status(580, 'Unsupported command');
 272
 273   0;
 274 }
 275
 276
 277 sub getline {
 278   my $cmd = shift;
 279
 280   ${*$cmd}{'net_cmd_lines'} ||= [];
 281
 282   return shift @{${*$cmd}{'net_cmd_lines'}}
 283     if scalar(@{${*$cmd}{'net_cmd_lines'}});
 284
 285   my $partial = defined(${*$cmd}{'net_cmd_partial'}) ? ${*$cmd}{'net_cmd_partial'} : "";
 286
 287   return
 288     if $cmd->_is_closed;
 289
 290   my $fd = fileno($cmd);
 291   my $rin = "";
 292   vec($rin, $fd, 1) = 1;
 293
 294   my $buf;
 295
 296   until (scalar(@{${*$cmd}{'net_cmd_lines'}})) {
 297     my $timeout = $cmd->timeout || undef;
 298     my $rout;
 299
 300     my $select_ret = select($rout = $rin, undef, undef, $timeout);
 301     if ($select_ret > 0) {
 302       unless (sysread($cmd, $buf = "", 1024)) {
 303         $cmd->close;
 304         $cmd->_set_status_closed;
 305         return;
 306       }
 307
 308       substr($buf, 0, 0) = $partial;    ## prepend from last sysread
 309
 310       my @buf = split(/\015?\012/, $buf, -1);    ## break into lines
 311
 312       $partial = pop @buf;
 313
 314       push(@{${*$cmd}{'net_cmd_lines'}}, map {"$_\n"} @buf);
 315
 316     }
 317     else {
 318       $cmd->_set_status_timeout;
 319       return;
 320     }
 321   }
 322
 323   ${*$cmd}{'net_cmd_partial'} = $partial;
 324
 325   if ($tr) {
 326     foreach my $ln (@{${*$cmd}{'net_cmd_lines'}}) {
 327       $ln = $cmd->toebcdic($ln);
 328     }
 329   }
 330
 331   shift @{${*$cmd}{'net_cmd_lines'}};
 332 }
 333
 334
 335 sub ungetline {
 336   my ($cmd, $str) = @_;
 337
 338   ${*$cmd}{'net_cmd_lines'} ||= [];
 339   unshift(@{${*$cmd}{'net_cmd_lines'}}, $str);
 340 }
 341
 342
 343 sub parse_response {
 344   return ()
 345     unless $_[1] =~ s/^(\d\d\d)(.?)//o;
 346   ($1, $2 eq "-");
 347 }
 348
 349
 350 sub response {
 351   my $cmd = shift;
 352   my ($code, $more) = (undef) x 2;
 353
 354   $cmd->set_status($cmd->DEF_REPLY_CODE, undef); # initialize the response
 355
 356   while (1) {
 357     my $str = $cmd->getline();
 358
 359     return CMD_ERROR
 360       unless defined($str);
 361
 362     $cmd->debug_print(0, $str)
 363       if ($cmd->debug);
 364
 365     ($code, $more) = $cmd->parse_response($str);
 366     unless (defined $code) {
 367       carp("$cmd: response(): parse error in '$str'") if ($cmd->debug);
 368       $cmd->ungetline($str);
 369       $@ = $str;   # $@ used as tunneling hack
 370       return CMD_ERROR;
 371     }
 372
 373     ${*$cmd}{'net_cmd_code'} = $code;
 374
 375     push(@{${*$cmd}{'net_cmd_resp'}}, $str);
 376
 377     last unless ($more);
 378   }
 379
 380   return unless defined $code;
 381   substr($code, 0, 1);
 382 }
 383
 384
 385 sub read_until_dot {
 386   my $cmd = shift;
 387   my $fh  = shift;
 388   my $arr = [];
 389
 390   while (1) {
 391     my $str = $cmd->getline() or return;
 392
 393     $cmd->debug_print(0, $str)
 394       if ($cmd->debug & 4);
 395
 396     last if ($str =~ /^\.\r?\n/o);
 397
 398     $str =~ s/^\.\././o;
 399
 400     if (defined $fh) {
 401       print $fh $str;
 402     }
 403     else {
 404       push(@$arr, $str);
 405     }
 406   }
 407
 408   $arr;
 409 }
 410
 411
 412 sub datasend {
 413   my $cmd  = shift;
 414   my $arr  = @_ == 1 && ref($_[0]) ? $_[0] : \@_;
 415   my $line = join("", @$arr);
 416
 417   # Perls < 5.10.1 (with the exception of 5.8.9) have a performance problem with
 418   # the substitutions below when dealing with strings stored internally in
 419   # UTF-8, so downgrade them (if possible).
 420   # Data passed to datasend() should be encoded to octets upstream already so
 421   # shouldn't even have the UTF-8 flag on to start with, but if it so happens
 422   # that the octets are stored in an upgraded string (as can sometimes occur)
 423   # then they would still downgrade without fail anyway.
 424   # Only Unicode codepoints > 0xFF stored in an upgraded string will fail to
 425   # downgrade. We fail silently in that case, and a "Wide character in print"
 426   # warning will be emitted later by syswrite().
 427   utf8::downgrade($line, 1) if $] < 5.010001 && $] != 5.008009;
 428
 429   return 0
 430     if $cmd->_is_closed;
 431
 432   my $last_ch = ${*$cmd}{'net_cmd_last_ch'};
 433
 434   # We have not send anything yet, so last_ch = "\012" means we are at the start of a line
 435   $last_ch = ${*$cmd}{'net_cmd_last_ch'} = "\012" unless defined $last_ch;
 436
 437   return 1 unless length $line;
 438
 439   if ($cmd->debug) {
 440     foreach my $b (split(/\n/, $line)) {
 441       $cmd->debug_print(1, "$b\n");
 442     }
 443   }
 444
 445   $line =~ tr/\r\n/\015\012/ unless "\r" eq "\015";
 446
 447   my $first_ch = '';
 448
 449   if ($last_ch eq "\015") {
 450     # Remove \012 so it does not get prefixed with another \015 below
 451     # and escape the . if there is one following it because the fixup
 452     # below will not find it
 453     $first_ch = "\012" if $line =~ s/^\012(\.?)/$1$1/;
 454   }
 455   elsif ($last_ch eq "\012") {
 456     # Fixup below will not find the . as the first character of the buffer
 457     $first_ch = "." if $line =~ /^\./;
 458   }
 459
 460   $line =~ s/\015?\012(\.?)/\015\012$1$1/sg;
 461
 462   substr($line, 0, 0) = $first_ch;
 463
 464   ${*$cmd}{'net_cmd_last_ch'} = substr($line, -1, 1);
 465
 466   my $len    = length($line);
 467   my $offset = 0;
 468   my $win    = "";
 469   vec($win, fileno($cmd), 1) = 1;
 470   my $timeout = $cmd->timeout || undef;
 471
 472   local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS';
 473
 474   while ($len) {
 475     my $wout;
 476     my $s = select(undef, $wout = $win, undef, $timeout);
 477     if ((defined $s and $s > 0) or -f $cmd)    # -f for testing on win32
 478     {
 479       my $w = syswrite($cmd, $line, $len, $offset);
 480       unless (defined($w) && $w == $len) {
 481         $cmd->close;
 482         $cmd->_set_status_closed;
 483         return;
 484       }
 485       $len -= $w;
 486       $offset += $w;
 487     }
 488     else {
 489       $cmd->_set_status_timeout;
 490       return;
 491     }
 492   }
 493
 494   1;
 495 }
 496
 497
 498 sub rawdatasend {
 499   my $cmd  = shift;
 500   my $arr  = @_ == 1 && ref($_[0]) ? $_[0] : \@_;
 501   my $line = join("", @$arr);
 502
 503   return 0
 504     if $cmd->_is_closed;
 505
 506   return 1
 507     unless length($line);
 508
 509   if ($cmd->debug) {
 510     my $b = "$cmd>>> ";
 511     print STDERR $b, join("\n$b", split(/\n/, $line)), "\n";
 512   }
 513
 514   my $len    = length($line);
 515   my $offset = 0;
 516   my $win    = "";
 517   vec($win, fileno($cmd), 1) = 1;
 518   my $timeout = $cmd->timeout || undef;
 519
 520   local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS';
 521   while ($len) {
 522     my $wout;
 523     if (select(undef, $wout = $win, undef, $timeout) > 0) {
 524       my $w = syswrite($cmd, $line, $len, $offset);
 525       unless (defined($w) && $w == $len) {
 526         $cmd->close;
 527         $cmd->_set_status_closed;
 528         return;
 529       }
 530       $len -= $w;
 531       $offset += $w;
 532     }
 533     else {
 534       $cmd->_set_status_timeout;
 535       return;
 536     }
 537   }
 538
 539   1;
 540 }
 541
 542
 543 sub dataend {
 544   my $cmd = shift;
 545
 546   return 0
 547     if $cmd->_is_closed;
 548
 549   my $ch = ${*$cmd}{'net_cmd_last_ch'};
 550   my $tosend;
 551
 552   if (!defined $ch) {
 553     return 1;
 554   }
 555   elsif ($ch ne "\012") {
 556     $tosend = "\015\012";
 557   }
 558
 559   $tosend .= ".\015\012";
 560
 561   local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS';
 562
 563   $cmd->debug_print(1, ".\n")
 564     if ($cmd->debug);
 565
 566   my $len = length $tosend;
 567   my $w = syswrite($cmd, $tosend, $len);
 568   unless (defined($w) && $w == $len)
 569   {
 570     $cmd->close;
 571     $cmd->_set_status_closed;
 572     return 0;
 573   }
 574
 575   delete ${*$cmd}{'net_cmd_last_ch'};
 576
 577   $cmd->response() == CMD_OK;
 578 }
 579
 580 # read and write to tied filehandle
 581 sub tied_fh {
 582   my $cmd = shift;
 583   ${*$cmd}{'net_cmd_readbuf'} = '';
 584   my $fh = gensym();
 585   tie *$fh, ref($cmd), $cmd;
 586   return $fh;
 587 }
 588
 589 # tie to myself
 590 sub TIEHANDLE {
 591   my $class = shift;
 592   my $cmd   = shift;
 593   return $cmd;
 594 }
 595
 596 # Tied filehandle read.  Reads requested data length, returning
 597 # end-of-file when the dot is encountered.
 598 sub READ {
 599   my $cmd = shift;
 600   my ($len, $offset) = @_[1, 2];
 601   return unless exists ${*$cmd}{'net_cmd_readbuf'};
 602   my $done = 0;
 603   while (!$done and length(${*$cmd}{'net_cmd_readbuf'}) < $len) {
 604     ${*$cmd}{'net_cmd_readbuf'} .= $cmd->getline() or return;
 605     $done++ if ${*$cmd}{'net_cmd_readbuf'} =~ s/^\.\r?\n\Z//m;
 606   }
 607
 608   $_[0] = '';
 609   substr($_[0], $offset + 0) = substr(${*$cmd}{'net_cmd_readbuf'}, 0, $len);
 610   substr(${*$cmd}{'net_cmd_readbuf'}, 0, $len) = '';
 611   delete ${*$cmd}{'net_cmd_readbuf'} if $done;
 612
 613   return length $_[0];
 614 }
 615
 616
 617 sub READLINE {
 618   my $cmd = shift;
 619
 620   # in this context, we use the presence of readbuf to
 621   # indicate that we have not yet reached the eof
 622   return unless exists ${*$cmd}{'net_cmd_readbuf'};
 623   my $line = $cmd->getline;
 624   return if $line =~ /^\.\r?\n/;
 625   $line;
 626 }
 627
 628
 629 sub PRINT {
 630   my $cmd = shift;
 631   my ($buf, $len, $offset) = @_;
 632   $len ||= length($buf);
 633   $offset += 0;
 634   return unless $cmd->datasend(substr($buf, $offset, $len));
 635   ${*$cmd}{'net_cmd_sending'}++;    # flag that we should call dataend()
 636   return $len;
 637 }
 638
 639
 640 sub CLOSE {
 641   my $cmd = shift;
 642   my $r = exists(${*$cmd}{'net_cmd_sending'}) ? $cmd->dataend : 1;
 643   delete ${*$cmd}{'net_cmd_readbuf'};
 644   delete ${*$cmd}{'net_cmd_sending'};
 645   $r;
 646 }
 647
 648 1;
 649
 650 __END__
 651
 652
 653 =head1 NAME
 654
 655 Net::Cmd - Network Command class (as used by FTP, SMTP etc)
 656
 657 =head1 SYNOPSIS
 658
 659     use Net::Cmd;
 660
 661     @ISA = qw(Net::Cmd);
 662
 663 =head1 DESCRIPTION
 664
 665 C<Net::Cmd> is a collection of methods that can be inherited by a sub class
 666 of C<IO::Handle>. These methods implement the functionality required for a
 667 command based protocol, for example FTP and SMTP.
 668
 669 =head1 USER METHODS
 670
 671 These methods provide a user interface to the C<Net::Cmd> object.
 672
 673 =over 4
 674
 675 =item debug ( VALUE )
 676
 677 Set the level of debug information for this object. If C<VALUE> is not given
 678 then the current state is returned. Otherwise the state is changed to
 679 C<VALUE> and the previous state returned.
 680
 681 Different packages
 682 may implement different levels of debug but a non-zero value results in
 683 copies of all commands and responses also being sent to STDERR.
 684
 685 If C<VALUE> is C<undef> then the debug level will be set to the default
 686 debug level for the class.
 687
 688 This method can also be called as a I<static> method to set/get the default
 689 debug level for a given class.
 690
 691 =item message ()
 692
 693 Returns the text message returned from the last command. In a scalar
 694 context it returns a single string, in a list context it will return
 695 each line as a separate element. (See L<PSEUDO RESPONSES> below.)
 696
 697 =item code ()
 698
 699 Returns the 3-digit code from the last command. If a command is pending
 700 then the value 0 is returned. (See L<PSEUDO RESPONSES> below.)
 701
 702 =item ok ()
 703
 704 Returns non-zero if the last code value was greater than zero and
 705 less than 400. This holds true for most command servers. Servers
 706 where this does not hold may override this method.
 707
 708 =item status ()
 709
 710 Returns the most significant digit of the current status code. If a command
 711 is pending then C<CMD_PENDING> is returned.
 712
 713 =item datasend ( DATA )
 714
 715 Send data to the remote server, converting LF to CRLF. Any line starting
 716 with a '.' will be prefixed with another '.'.
 717 C<DATA> may be an array or a reference to an array.
 718 The C<DATA> passed in must be encoded by the caller to octets of whatever
 719 encoding is required, e.g. by using the Encode module's C<encode()> function.
 720
 721 =item dataend ()
 722
 723 End the sending of data to the remote server. This is done by ensuring that
 724 the data already sent ends with CRLF then sending '.CRLF' to end the
 725 transmission. Once this data has been sent C<dataend> calls C<response> and
 726 returns true if C<response> returns CMD_OK.
 727
 728 =back
 729
 730 =head1 CLASS METHODS
 731
 732 These methods are not intended to be called by the user, but used or
 733 over-ridden by a sub-class of C<Net::Cmd>
 734
 735 =over 4
 736
 737 =item debug_print ( DIR, TEXT )
 738
 739 Print debugging information. C<DIR> denotes the direction I<true> being
 740 data being sent to the server. Calls C<debug_text> before printing to
 741 STDERR.
 742
 743 =item debug_text ( DIR, TEXT )
 744
 745 This method is called to print debugging information. TEXT is
 746 the text being sent. The method should return the text to be printed.
 747
 748 This is primarily meant for the use of modules such as FTP where passwords
 749 are sent, but we do not want to display them in the debugging information.
 750
 751 =item command ( CMD [, ARGS, ... ])
 752
 753 Send a command to the command server. All arguments are first joined with
 754 a space character and CRLF is appended, this string is then sent to the
 755 command server.
 756
 757 Returns undef upon failure.
 758
 759 =item unsupported ()
 760
 761 Sets the status code to 580 and the response text to 'Unsupported command'.
 762 Returns zero.
 763
 764 =item response ()
 765
 766 Obtain a response from the server. Upon success the most significant digit
 767 of the status code is returned. Upon failure, timeout etc., I<CMD_ERROR> is
 768 returned.
 769
 770 =item parse_response ( TEXT )
 771
 772 This method is called by C<response> as a method with one argument. It should
 773 return an array of 2 values, the 3-digit status code and a flag which is true
 774 when this is part of a multi-line response and this line is not the last.
 775
 776 =item getline ()
 777
 778 Retrieve one line, delimited by CRLF, from the remote server. Returns I<undef>
 779 upon failure.
 780
 781 B<NOTE>: If you do use this method for any reason, please remember to add
 782 some C<debug_print> calls into your method.
 783
 784 =item ungetline ( TEXT )
 785
 786 Unget a line of text from the server.
 787
 788 =item rawdatasend ( DATA )
 789
 790 Send data to the remote server without performing any conversions. C<DATA>
 791 is a scalar.
 792 As with C<datasend()>, the C<DATA> passed in must be encoded by the caller
 793 to octets of whatever encoding is required, e.g. by using the Encode module's
 794 C<encode()> function.
 795
 796 =item read_until_dot ()
 797
 798 Read data from the remote server until a line consisting of a single '.'.
 799 Any lines starting with '..' will have one of the '.'s removed.
 800
 801 Returns a reference to a list containing the lines, or I<undef> upon failure.
 802
 803 =item tied_fh ()
 804
 805 Returns a filehandle tied to the Net::Cmd object.  After issuing a
 806 command, you may read from this filehandle using read() or <>.  The
 807 filehandle will return EOF when the final dot is encountered.
 808 Similarly, you may write to the filehandle in order to send data to
 809 the server after issuing a command that expects data to be written.
 810
 811 See the Net::POP3 and Net::SMTP modules for examples of this.
 812
 813 =back
 814
 815 =head1 PSEUDO RESPONSES
 816
 817 Normally the values returned by C<message()> and C<code()> are
 818 obtained from the remote server, but in a few circumstances, as
 819 detailed below, C<Net::Cmd> will return values that it sets. You
 820 can alter this behavior by overriding DEF_REPLY_CODE() to specify
 821 a different default reply code, or overriding one of the specific
 822 error handling methods below.
 823
 824 =over 4
 825
 826 =item Initial value
 827
 828 Before any command has executed or if an unexpected error occurs
 829 C<code()> will return "421" (temporary connection failure) and
 830 C<message()> will return undef.
 831
 832 =item Connection closed
 833
 834 If the underlying C<IO::Handle> is closed, or if there are
 835 any read or write failures, the file handle will be forced closed,
 836 and C<code()> will return "421" (temporary connection failure)
 837 and C<message()> will return "[$pkg] Connection closed"
 838 (where $pkg is the name of the class that subclassed C<Net::Cmd>).
 839 The _set_status_closed() method can be overridden to set a different
 840 message (by calling set_status()) or otherwise trap this error.
 841
 842 =item Timeout
 843
 844 If there is a read or write timeout C<code()> will return "421"
 845 (temporary connection failure) and C<message()> will return
 846 "[$pkg] Timeout" (where $pkg is the name of the class
 847 that subclassed C<Net::Cmd>). The _set_status_timeout() method
 848 can be overridden to set a different message (by calling set_status())
 849 or otherwise trap this error.
 850
 851 =back
 852
 853 =head1 EXPORTS
 854
 855 C<Net::Cmd> exports six subroutines, five of these, C<CMD_INFO>, C<CMD_OK>,
 856 C<CMD_MORE>, C<CMD_REJECT> and C<CMD_ERROR>, correspond to possible results
 857 of C<response> and C<status>. The sixth is C<CMD_PENDING>.
 858
 859 =head1 AUTHOR
 860
 861 Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
 862
 863 Steve Hay E<lt>F<shay@cpan.org>E<gt> is now maintaining libnet as of version
 864 1.22_02
 865
 866 =head1 COPYRIGHT
 867
 868 Versions up to 2.29_1 Copyright (c) 1995-2006 Graham Barr. All rights reserved.
 869 Changes in Version 2.29_2 onwards Copyright (C) 2013-2014 Steve Hay.  All rights
 870 reserved.
 871
 872 This module is free software; you can redistribute it and/or modify it under the
 873 same terms as Perl itself, i.e. under the terms of either the GNU General Public
 874 License or the Artistic License, as specified in the F<LICENCE> file.
 875
 876 =cut