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