home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-2 / Inter.Net 55-2.iso / Mandrake / mdkinst / usr / lib / perl5 / site_perl / 5.005 / i386-linux / Net / Cmd.pm next >
Encoding:
Perl POD Document  |  2000-01-12  |  6.3 KB  |  395 lines
  1. # Net::Cmd.pm
  2. #
  3. # Copyright (c) 1995-1997 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.  
  16. $VERSION = "2.12";
  17. @ISA     = qw(Exporter);
  18. @EXPORT  = qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING);
  19.  
  20. sub CMD_INFO    { 1 }
  21. sub CMD_OK    { 2 }
  22. sub CMD_MORE    { 3 }
  23. sub CMD_REJECT    { 4 }
  24. sub CMD_ERROR    { 5 }
  25. sub CMD_PENDING { 0 }
  26.  
  27. my %debug = ();
  28.  
  29. sub _print_isa
  30. {
  31.  no strict qw(refs);
  32.  
  33.  my $pkg = shift;
  34.  my $cmd = $pkg;
  35.  
  36.  $debug{$pkg} ||= 0;
  37.  
  38.  my %done = ();
  39.  my @do   = ($pkg);
  40.  my %spc = ( $pkg , "");
  41.  
  42.  print STDERR "\n";
  43.  while ($pkg = shift @do)
  44.   {
  45.    next if defined $done{$pkg};
  46.  
  47.    $done{$pkg} = 1;
  48.  
  49.    my $v = defined ${"${pkg}::VERSION"}
  50.                 ? "(" . ${"${pkg}::VERSION"} . ")"
  51.                 : "";
  52.  
  53.    my $spc = $spc{$pkg};
  54.    print STDERR "$cmd: ${spc}${pkg}${v}\n";
  55.  
  56.    if(defined @{"${pkg}::ISA"})
  57.     {
  58.      @spc{@{"${pkg}::ISA"}} = ("  " . $spc{$pkg}) x @{"${pkg}::ISA"};
  59.      unshift(@do, @{"${pkg}::ISA"});
  60.     }
  61.   }
  62.  
  63.  print STDERR "\n";
  64. }
  65.  
  66. sub debug
  67. {
  68.  @_ == 1 or @_ == 2 or croak 'usage: $obj->debug([LEVEL])';
  69.  
  70.  my($cmd,$level) = @_;
  71.  my $pkg = ref($cmd) || $cmd;
  72.  my $oldval = 0;
  73.  
  74.  if(ref($cmd))
  75.   {
  76.    $oldval = ${*$cmd}{'net_cmd_debug'} || 0;
  77.   }
  78.  else
  79.   {
  80.    $oldval = $debug{$pkg} || 0;
  81.   }
  82.  
  83.  return $oldval
  84.     unless @_ == 2;
  85.  
  86.  $level = $debug{$pkg} || 0
  87.     unless defined $level;
  88.  
  89.  _print_isa($pkg)
  90.     if($level && !exists $debug{$pkg});
  91.  
  92.  if(ref($cmd))
  93.   {
  94.    ${*$cmd}{'net_cmd_debug'} = $level;
  95.   }
  96.  else
  97.   {
  98.    $debug{$pkg} = $level;
  99.   }
  100.  
  101.  $oldval;
  102. }
  103.  
  104. sub message
  105. {
  106.  @_ == 1 or croak 'usage: $obj->message()';
  107.  
  108.  my $cmd = shift;
  109.  
  110.  wantarray ? @{${*$cmd}{'net_cmd_resp'}}
  111.            : join("", @{${*$cmd}{'net_cmd_resp'}});
  112. }
  113.  
  114. sub debug_text { $_[2] }
  115.  
  116. sub debug_print
  117. {
  118.  my($cmd,$out,$text) = @_;
  119.  print STDERR $cmd,($out ? '>>> ' : '<<< '), $cmd->debug_text($out,$text);
  120. }
  121.  
  122. sub code
  123. {
  124.  @_ == 1 or croak 'usage: $obj->code()';
  125.  
  126.  my $cmd = shift;
  127.  
  128.  ${*$cmd}{'net_cmd_code'} = "000"
  129.     unless exists ${*$cmd}{'net_cmd_code'};
  130.  
  131.  ${*$cmd}{'net_cmd_code'};
  132. }
  133.  
  134. sub status
  135. {
  136.  @_ == 1 or croak 'usage: $obj->status()';
  137.  
  138.  my $cmd = shift;
  139.  
  140.  substr(${*$cmd}{'net_cmd_code'},0,1);
  141. }
  142.  
  143. sub set_status
  144. {
  145.  @_ == 3 or croak 'usage: $obj->set_status(CODE, MESSAGE)';
  146.  
  147.  my $cmd = shift;
  148.  my($code,$resp) = @_;
  149.  
  150.  $resp = [ $resp ]
  151.     unless ref($resp);
  152.  
  153.  (${*$cmd}{'net_cmd_code'},${*$cmd}{'net_cmd_resp'}) = ($code, $resp);
  154.  
  155.  1;
  156. }
  157.  
  158. sub command
  159. {
  160.  my $cmd = shift;
  161.  
  162.  $cmd->dataend()
  163.     if(exists ${*$cmd}{'net_cmd_lastch'});
  164.  
  165.  if (scalar(@_))
  166.   {
  167.    local $SIG{PIPE} = 'IGNORE';
  168.  
  169.    my $str =  join(" ",@_) . "\015\012";
  170.    my $len = length $str;
  171.    my $swlen;
  172.    
  173.    $cmd->close
  174.     unless (defined($swlen = syswrite($cmd,$str,$len)) && $swlen == $len);
  175.  
  176.    $cmd->debug_print(1,$str)
  177.     if($cmd->debug);
  178.  
  179.    ${*$cmd}{'net_cmd_resp'} = [];      # the response
  180.    ${*$cmd}{'net_cmd_code'} = "000";    # Made this one up :-)
  181.   }
  182.  
  183.  $cmd;
  184. }
  185.  
  186. sub ok
  187. {
  188.  @_ == 1 or croak 'usage: $obj->ok()';
  189.  
  190.  my $code = $_[0]->code;
  191.  0 < $code && $code < 400;
  192. }
  193.  
  194. sub unsupported
  195. {
  196.  my $cmd = shift;
  197.  
  198.  ${*$cmd}{'net_cmd_resp'} = [ 'Unsupported command' ];
  199.  ${*$cmd}{'net_cmd_code'} = 580;
  200.  0;
  201. }
  202.  
  203. sub getline
  204. {
  205.  my $cmd = shift;
  206.  
  207.  ${*$cmd}{'net_cmd_lines'} ||= [];
  208.  
  209.  return shift @{${*$cmd}{'net_cmd_lines'}}
  210.     if scalar(@{${*$cmd}{'net_cmd_lines'}});
  211.  
  212.  my $partial = ${*$cmd}{'net_cmd_partial'} || "";
  213.  my $fd = fileno($cmd);
  214.  
  215.  return undef
  216.     unless defined $fd;
  217.  
  218.  my $rin = "";
  219.  vec($rin,$fd,1) = 1;
  220.  
  221.  my $buf;
  222.  
  223.  until(scalar(@{${*$cmd}{'net_cmd_lines'}}))
  224.   {
  225.    my $timeout = $cmd->timeout || undef;
  226.    my $rout;
  227.    if (select($rout=$rin, undef, undef, $timeout))
  228.     {
  229.      unless (sysread($cmd, $buf="", 1024))
  230.       {
  231.        carp ref($cmd) . ": Unexpected EOF on command channel"
  232.         if $cmd->debug;
  233.        $cmd->close;
  234.        return undef;
  235.       } 
  236.  
  237.      substr($buf,0,0) = $partial;    ## prepend from last sysread
  238.  
  239.      my @buf = split(/\015?\012/, $buf);    ## break into lines
  240.  
  241.      $partial = length($buf) == 0 || substr($buf, -1, 1) eq "\012"
  242.         ? ''
  243.           : pop(@buf);
  244.  
  245.      map { $_ .= "\n" } @buf;
  246.  
  247.      push(@{${*$cmd}{'net_cmd_lines'}},@buf);
  248.  
  249.     }
  250.    else
  251.     {
  252.      carp "$cmd: Timeout" if($cmd->debug);
  253.      return undef;
  254.     }
  255.   }
  256.  
  257.  ${*$cmd}{'net_cmd_partial'} = $partial;
  258.  
  259.  shift @{${*$cmd}{'net_cmd_lines'}};
  260. }
  261.  
  262. sub ungetline
  263. {
  264.  my($cmd,$str) = @_;
  265.  
  266.  ${*$cmd}{'net_cmd_lines'} ||= [];
  267.  unshift(@{${*$cmd}{'net_cmd_lines'}}, $str);
  268. }
  269.  
  270. sub parse_response
  271. {
  272.  return ()
  273.     unless $_[1] =~ s/^(\d\d\d)(.?)//o;
  274.  ($1, $2 eq "-");
  275. }
  276.  
  277. sub response
  278. {
  279.  my $cmd = shift;
  280.  my($code,$more) = (undef) x 2;
  281.  
  282.  ${*$cmd}{'net_cmd_resp'} ||= [];
  283.  
  284.  while(1)
  285.   {
  286.    my $str = $cmd->getline();
  287.  
  288.    return CMD_ERROR
  289.     unless defined($str);
  290.  
  291.    $cmd->debug_print(0,$str)
  292.      if ($cmd->debug);
  293.  
  294.    ($code,$more) = $cmd->parse_response($str);
  295.    unless(defined $code)
  296.     {
  297.      $cmd->ungetline($str);
  298.      last;
  299.     }
  300.  
  301.    ${*$cmd}{'net_cmd_code'} = $code;
  302.  
  303.    push(@{${*$cmd}{'net_cmd_resp'}},$str);
  304.  
  305.    last unless($more);
  306.   } 
  307.  
  308.  substr($code,0,1);
  309. }
  310.  
  311. sub read_until_dot
  312. {
  313.  my $cmd = shift;
  314.  my $arr = [];
  315.  
  316.  while(1)
  317.   {
  318.    my $str = $cmd->getline() or return undef;
  319.  
  320.    $cmd->debug_print(0,$str)
  321.      if ($cmd->debug & 4);
  322.  
  323.    last if($str =~ /^\.\r?\n/o);
  324.  
  325.    $str =~ s/^\.\././o;
  326.  
  327.    push(@$arr,$str);
  328.   }
  329.  
  330.  $arr;
  331. }
  332.  
  333. sub datasend
  334. {
  335.  my $cmd = shift;
  336.  my $arr = @_ == 1 && ref($_[0]) ? $_[0] : \@_;
  337.  my $line = join("" ,@$arr);
  338.  
  339.  return 1
  340.     unless length($line);
  341.  
  342.  if($cmd->debug)
  343.   {
  344.    my $b = "$cmd>>> ";
  345.    print STDERR $b,join("\n$b",split(/\n/,$line)),"\n";
  346.   }
  347.  
  348.  $line =~ s/\n/\015\012/sgo;
  349.  
  350.  ${*$cmd}{'net_cmd_lastch'} ||= " ";
  351.  $line = ${*$cmd}{'net_cmd_lastch'} . $line;
  352.  
  353.  $line =~ s/(\012\.)/$1./sog;
  354.  
  355.  ${*$cmd}{'net_cmd_lastch'} = substr($line,-1,1);
  356.  
  357.  my $len = length($line) - 1;
  358.  
  359.  return $len == 0 ||
  360.     syswrite($cmd, $line, $len, 1) == $len;
  361. }
  362.  
  363. sub dataend
  364. {
  365.  my $cmd = shift;
  366.  
  367.  return 1
  368.     unless(exists ${*$cmd}{'net_cmd_lastch'});
  369.  
  370.  if(${*$cmd}{'net_cmd_lastch'} eq "\015")
  371.   {
  372.    syswrite($cmd,"\012",1);
  373.    print STDERR "\n"
  374.     if($cmd->debug);
  375.   }
  376.  elsif(${*$cmd}{'net_cmd_lastch'} ne "\012")
  377.   {
  378.    syswrite($cmd,"\015\012",2);
  379.    print STDERR "\n"
  380.     if($cmd->debug);
  381.   }
  382.  
  383.  print STDERR "$cmd>>> .\n"
  384.     if($cmd->debug);
  385.  
  386.  syswrite($cmd,".\015\012",3);
  387.  
  388.  delete ${*$cmd}{'net_cmd_lastch'};
  389.  
  390.  $cmd->response() == CMD_OK;
  391. }
  392.  
  393. 1;
  394.  
  395.