lib/Net/Cmd.pm

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