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