home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_ste.zip / Net / PH.pm < prev    next >
Text File  |  1997-11-25  |  17KB  |  785 lines
  1. #
  2. # Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com> and
  3. # Alex Hristov <hristov@slb.com>. All rights reserved. This program is free
  4. # software; you can redistribute it and/or modify it under the same terms
  5. # as Perl itself.
  6.  
  7. package Net::PH;
  8.  
  9. require 5.001;
  10.  
  11. use strict;
  12. use vars qw(@ISA $VERSION);
  13. use Carp;
  14.  
  15. use Socket 1.3;
  16. use IO::Socket;
  17. use Net::Cmd;
  18. use Net::Config;
  19.  
  20. $VERSION = "2.20"; # $Id: //depot/libnet/Net/PH.pm#6$
  21. @ISA     = qw(Exporter Net::Cmd IO::Socket::INET);
  22.  
  23. sub new
  24. {
  25.  my $pkg  = shift;
  26.  my $host = shift if @_ % 2;
  27.  my %arg  = @_; 
  28.  my $hosts = defined $host ? [ $host ] : $NetConfig{ph_hosts};
  29.  my $ph;
  30.  
  31.  my $h;
  32.  foreach $h (@{$hosts})
  33.   {
  34.    $ph = $pkg->SUPER::new(PeerAddr => ($host = $h), 
  35.               PeerPort => $arg{Port} || 'csnet-ns(105)',
  36.               Proto    => 'tcp',
  37.               Timeout  => defined $arg{Timeout}
  38.                     ? $arg{Timeout}
  39.                     : 120
  40.              ) and last;
  41.   }
  42.  
  43.  return undef
  44.     unless defined $ph;
  45.  
  46.  ${*$ph}{'net_ph_host'} = $host;
  47.  
  48.  $ph->autoflush(1);
  49.  
  50.  $ph->debug(exists $arg{Debug} ? $arg{Debug} : undef);
  51.  
  52.  $ph;
  53. }
  54.  
  55. sub status
  56. {
  57.  my $ph = shift;
  58.  
  59.  $ph->command('status')->response;
  60.  $ph->code;
  61. }
  62.  
  63. sub login
  64. {
  65.  my $ph = shift;
  66.  my($user,$pass,$encrypted) = @_;
  67.  my $resp;
  68.  
  69.  $resp = $ph->command("login",$user)->response;
  70.  
  71.  if(defined($pass) && $resp == CMD_MORE)
  72.   {
  73.    if($encrypted)
  74.     {
  75.      my $challenge_str = $ph->message;
  76.      chomp($challenge_str);
  77.      Net::PH::crypt::crypt_start($pass);
  78.      my $cryptstr = Net::PH::crypt::encryptit($challenge_str);
  79.  
  80.      $ph->command("answer", $cryptstr);
  81.     }
  82.    else
  83.     {
  84.      $ph->command("clear", $pass);
  85.     }
  86.    $resp = $ph->response;
  87.   }
  88.  
  89.  $resp == CMD_OK;
  90. }
  91.  
  92. sub logout
  93. {
  94.  my $ph = shift;
  95.  
  96.  $ph->command("logout")->response == CMD_OK;
  97. }
  98.  
  99. sub id
  100. {
  101.  my $ph = shift;
  102.  my $id = @_ ? shift : $<;
  103.  
  104.  $ph->command("id",$id)->response == CMD_OK;
  105. }
  106.  
  107. sub siteinfo
  108. {
  109.  my $ph = shift;
  110.  
  111.  $ph->command("siteinfo");
  112.  
  113.  my $ln;
  114.  my %resp;
  115.  my $cur_num = 0;
  116.  
  117.  while(defined($ln = $ph->getline))
  118.   {
  119.    $ph->debug_print(0,$ln)
  120.      if ($ph->debug & 2);
  121.    chomp($ln);
  122.    my($code,$num,$tag,$data);
  123.  
  124.    if($ln =~ /^-(\d+):(\d+):(?:\s*([^:]+):)?\s*(.*)/o)
  125.     {
  126.      ($code,$num,$tag,$data) = ($1, $2, $3 || "",$4);
  127.      $resp{$tag} = bless [$code, $num, $tag, $data], "Net::PH::Result";
  128.     }
  129.    else
  130.     {
  131.      $ph->set_status($ph->parse_response($ln));
  132.      return \%resp;
  133.     }
  134.   }
  135.  
  136.  return undef;
  137. }
  138.  
  139. sub query
  140. {
  141.  my $ph = shift;
  142.  my $search = shift;
  143.  
  144.  my($k,$v);
  145.  
  146.  my @args = ('query', _arg_hash($search));
  147.  
  148.  push(@args,'return',_arg_list( shift ))
  149.     if @_;
  150.  
  151.  unless($ph->command(@args)->response == CMD_INFO)
  152.   {
  153.    return $ph->code == 501
  154.     ? []
  155.     : undef;
  156.   }
  157.  
  158.  my $ln;
  159.  my @resp;
  160.  my $cur_num = 0;
  161.  
  162.  my($last_tag);
  163.  
  164.  while(defined($ln = $ph->getline))
  165.   {
  166.    $ph->debug_print(0,$ln)
  167.      if ($ph->debug & 2);
  168.    chomp($ln);
  169.    my($code,$idx,$num,$tag,$data);
  170.  
  171.    if($ln =~ /^-(\d+):(\d+):\s*([^:]*):\s*(.*)/o)
  172.     {
  173.      ($code,$idx,$tag,$data) = ($1,$2,$3,$4);
  174.      my $num = $idx - 1;
  175.  
  176.      $resp[$num] ||= {};
  177.  
  178.      $tag = $last_tag
  179.     unless(length($tag));
  180.  
  181.      $last_tag = $tag;
  182.  
  183.      if(exists($resp[$num]->{$tag}))
  184.       {
  185.        $resp[$num]->{$tag}->[3] .= "\n" . $data;
  186.       }
  187.      else
  188.       {
  189.        $resp[$num]->{$tag} = bless [$code, $idx, $tag, $data], "Net::PH::Result";
  190.       }
  191.     }
  192.    else
  193.     {
  194.      $ph->set_status($ph->parse_response($ln));
  195.      return \@resp;
  196.     }
  197.   }
  198.  
  199.  return undef;
  200. }
  201.  
  202. sub change
  203. {
  204.  my $ph = shift;
  205.  my $search = shift;
  206.  my $make = shift;
  207.  
  208.  $ph->command(
  209.     "change", _arg_hash($search),
  210.     "make",   _arg_hash($make)
  211.  )->response == CMD_OK;
  212. }
  213.  
  214. sub _arg_hash
  215. {
  216.  my $hash = shift;
  217.  
  218.  return $hash
  219.     unless(ref($hash));
  220.  
  221.  my($k,$v);
  222.  my @r;
  223.  
  224.  while(($k,$v) = each %$hash)
  225.   {
  226.    my $a = $v;
  227.    $a =~ s/\n/\\n/sog;
  228.    $a =~ s/\t/\\t/sog;
  229.    $a = '"' . $a . '"'
  230.     if $a =~ /\W/;
  231.    $a = '""'
  232.     unless length $a;
  233.  
  234.    push(@r, "$k=$a");   
  235.   }
  236.  join(" ", @r);
  237. }
  238.  
  239. sub _arg_list
  240. {
  241.  my $arr = shift;
  242.  
  243.  return $arr
  244.     unless(ref($arr));
  245.  
  246.  my $v;
  247.  my @r;
  248.  
  249.  foreach $v (@$arr)
  250.   {
  251.    my $a = $v;
  252.    $a =~ s/\n/\\n/sog;
  253.    $a =~ s/\t/\\t/sog;
  254.    $a = '"' . $a . '"'
  255.     if $a =~ /\W/;
  256.    push(@r, $a);   
  257.   }
  258.  
  259.  join(" ",@r);
  260. }
  261.  
  262. sub add
  263. {
  264.  my $ph = shift;
  265.  my $arg = @_ > 1 ? { @_ } : shift;
  266.  
  267.  $ph->command('add', _arg_hash($arg))->response == CMD_OK;
  268. }
  269.  
  270. sub delete
  271. {
  272.  my $ph = shift;
  273.  my $arg = @_ > 1 ? { @_ } : shift;
  274.  
  275.  $ph->command('delete', _arg_hash($arg))->response == CMD_OK;
  276. }
  277.  
  278. sub force
  279. {
  280.  my $ph = shift; 
  281.  my $search = shift;
  282.  my $force = shift;
  283.  
  284.  $ph->command(
  285.     "change", _arg_hash($search),
  286.     "force",  _arg_hash($force)
  287.  )->response == CMD_OK;
  288. }
  289.  
  290.  
  291. sub fields
  292. {
  293.  my $ph = shift;
  294.  
  295.  $ph->command("fields", _arg_list(\@_));
  296.  
  297.  my $ln;
  298.  my %resp;
  299.  my $cur_num = 0;
  300.  my @tags = ();
  301.  
  302.  while(defined($ln = $ph->getline))
  303.   {
  304.    $ph->debug_print(0,$ln)
  305.      if ($ph->debug & 2);
  306.    chomp($ln);
  307.  
  308.    my($code,$num,$tag,$data,$last_tag);
  309.  
  310.    if($ln =~ /^-(\d+):(\d+):\s*([^:]*):\s*(.*)/o)
  311.     {
  312.      ($code,$num,$tag,$data) = ($1,$2,$3,$4);
  313.  
  314.      $tag = $last_tag
  315.     unless(length($tag));
  316.  
  317.      $last_tag = $tag;
  318.  
  319.      if(exists $resp{$tag})
  320.       {
  321.        $resp{$tag}->[3] .= "\n" . $data;
  322.       }
  323.      else
  324.       {
  325.        $resp{$tag} = bless [$code, $num, $tag, $data], "Net::PH::Result";
  326.        push @tags, $tag;
  327.       }
  328.     }
  329.    else
  330.     {
  331.      $ph->set_status($ph->parse_response($ln));
  332.      return wantarray ? (\%resp, \@tags) : \%resp;
  333.     }
  334.   }
  335.  
  336.  return;
  337. }
  338.  
  339. sub quit
  340. {
  341.  my $ph = shift;
  342.  
  343.  $ph->close
  344.     if $ph->command("quit")->response == CMD_OK;
  345. }
  346.  
  347. ##
  348. ## Net::Cmd overrides
  349. ##
  350.  
  351. sub parse_response
  352. {
  353.  return ()
  354.     unless $_[1] =~ s/^(-?)(\d\d\d):?//o;
  355.  ($2, $1 eq "-");
  356. }
  357.  
  358. sub debug_text { $_[2] =~ /^(clear)/i ? "$1 ....\n" : $_[2]; }
  359.  
  360. package Net::PH::Result;
  361.  
  362. sub code  { shift->[0] }
  363. sub value { shift->[1] }
  364. sub field { shift->[2] }
  365. sub text  { shift->[3] }
  366.  
  367. package Net::PH::crypt;
  368.  
  369. #  The code in this package is based upon 'cryptit.c', Copyright (C) 1988 by
  370. #  Steven Dorner, and Paul Pomes, and the University of Illinois Board
  371. #  of Trustees, and by CSNET.
  372.  
  373. use integer;
  374. use strict;
  375.  
  376. sub ROTORSZ () { 256 }
  377. sub MASK () { 255 }
  378.  
  379. my(@t1,@t2,@t3,$n1,$n2);
  380.  
  381. sub crypt_start {
  382.     my $pass = shift;
  383.     $n1 = 0;
  384.     $n2 = 0;
  385.     crypt_init($pass);
  386. }
  387.  
  388. sub crypt_init {
  389.     my $pw = shift;
  390.     my $i;
  391.  
  392.     @t2 = @t3 = (0) x ROTORSZ;
  393.  
  394.     my $buf = crypt($pw,$pw);
  395.     return -1 unless length($buf) > 0;
  396.     $buf = substr($buf . "\0" x 13,0,13);
  397.     my @buf = map { ord $_ } split(//, $buf);
  398.  
  399.  
  400.     my $seed = 123;
  401.     for($i = 0 ; $i < 13 ; $i++) {
  402.     $seed = $seed * $buf[$i] + $i;
  403.     }
  404.     @t1 = (0 .. ROTORSZ-1);
  405.     
  406.     for($i = 0 ; $i < ROTORSZ ; $i++) {
  407.     $seed = 5 * $seed + $buf[$i % 13];
  408.     my $random = $seed % 65521;
  409.     my $k = ROTORSZ - 1 - $i;
  410.     my $ic = ($random & MASK) % ($k + 1);
  411.     $random >>= 8;
  412.     @t1[$k,$ic] = @t1[$ic,$k];
  413.     next if $t3[$k] != 0;
  414.     $ic = ($random & MASK) % $k;
  415.     while($t3[$ic] != 0) {
  416.         $ic = ($ic + 1) % $k;
  417.     }
  418.     $t3[$k] = $ic;
  419.     $t3[$ic] = $k;
  420.     }
  421.     for($i = 0 ; $i < ROTORSZ ; $i++) {
  422.     $t2[$t1[$i] & MASK] = $i
  423.     }
  424. }
  425.  
  426. sub encode {
  427.     my $sp = shift;
  428.     my $ch;
  429.     my $n = scalar(@$sp);
  430.     my @out = ($n);
  431.     my $i;
  432.  
  433.     for($i = 0 ; $i < $n ; ) {
  434.     my($f0,$f1,$f2) = splice(@$sp,0,3);
  435.     push(@out,
  436.         $f0 >> 2,
  437.         ($f0 << 4) & 060 | ($f1 >> 4) & 017,
  438.         ($f1 << 2) & 074 | ($f2 >> 6) & 03,
  439.         $f2 & 077);
  440.     $i += 3;
  441.    }
  442.    join("", map { chr((($_ & 077) + 35) & 0xff) } @out);  # ord('#') == 35
  443. }
  444.  
  445. sub encryptit {
  446.     my $from = shift;
  447.     my @from = map { ord $_ } split(//, $from);
  448.     my @sp = ();
  449.     my $ch;
  450.     while(defined($ch = shift @from)) {
  451.     push(@sp,
  452.         $t2[($t3[($t1[($ch + $n1) & MASK] + $n2) & MASK] - $n2) & MASK] - $n1);
  453.  
  454.     $n1++;
  455.     if($n1 == ROTORSZ) {
  456.         $n1 = 0;
  457.         $n2++;
  458.         $n2 = 0 if $n2 == ROTORSZ;
  459.     }
  460.     }
  461.     encode(\@sp);
  462. }
  463.  
  464. 1;
  465.  
  466. __END__
  467.  
  468. =head1 NAME
  469.  
  470. Net::PH - CCSO Nameserver Client class
  471.  
  472. =head1 SYNOPSIS
  473.  
  474.     use Net::PH;
  475.     
  476.     $ph = Net::PH->new("some.host.name",
  477.                        Port    => 105,
  478.                        Timeout => 120,
  479.                        Debug   => 0);
  480.  
  481.     if($ph) {
  482.         $q = $ph->query({ field1 => "value1" },
  483.                         [qw(name address pobox)]);
  484.     
  485.         if($q) {
  486.         }
  487.     }
  488.     
  489.     # Alternative syntax
  490.     
  491.     if($ph) {
  492.         $q = $ph->query('field1=value1',
  493.                         'name address pobox');
  494.     
  495.         if($q) {
  496.         }
  497.     }
  498.  
  499. =head1 DESCRIPTION
  500.  
  501. C<Net::PH> is a class implementing a simple Nameserver/PH client in Perl
  502. as described in the CCSO Nameserver -- Server-Client Protocol. Like other
  503. modules in the Net:: family the C<Net::PH> object inherits methods from
  504. C<Net::Cmd>.
  505.  
  506. =head1 CONSTRUCTOR
  507.  
  508. =over 4
  509.  
  510. =item new ( [ HOST ] [, OPTIONS ])
  511.  
  512.     $ph = Net::PH->new("some.host.name",
  513.                        Port    => 105,
  514.                        Timeout => 120,
  515.                        Debug   => 0
  516.                       );
  517.  
  518. This is the constructor for a new Net::PH object. C<HOST> is the
  519. name of the remote host to which a PH connection is required.
  520.  
  521. If C<HOST> is not given, then the C<SNPP_Host> specified in C<Net::Config>
  522. will be used.
  523.  
  524. C<OPTIONS> is an optional list of named options which are passed in
  525. a hash like fashion, using key and value pairs. Possible options are:-
  526.  
  527. B<Port> - Port number to connect to on remote host.
  528.  
  529. B<Timeout> - Maximum time, in seconds, to wait for a response from the
  530. Nameserver, a value of zero will cause all IO operations to block.
  531. (default: 120)
  532.  
  533. B<Debug> - Enable the printing of debugging information to STDERR
  534.  
  535. =back
  536.  
  537. =head1 METHODS
  538.  
  539. Unless otherwise stated all methods return either a I<true> or I<false>
  540. value, with I<true> meaning that the operation was a success. When a method
  541. states that it returns a value, failure will be returned as I<undef> or an
  542. empty list.
  543.  
  544. =over 4
  545.  
  546. =item query( SEARCH [, RETURN ] )
  547.  
  548.     $q = $ph->query({ name => $myname },
  549.             [qw(name email schedule)]);
  550.     
  551.     foreach $handle (@{$q}) {
  552.     foreach $field (keys %{$handle}) {
  553.             $c = ${$handle}{$field}->code;
  554.             $v = ${$handle}{$field}->value;
  555.             $f = ${$handle}{$field}->field;
  556.             $t = ${$handle}{$field}->text;
  557.             print "field:[$field] [$c][$v][$f][$t]\n" ;
  558.     }
  559.     }
  560.  
  561.     
  562.  
  563. Search the database and return fields from all matching entries.
  564.  
  565. The C<SEARCH> argument is a reference to a HASH which contains field/value
  566. pairs which will be passed to the Nameserver as the search criteria.
  567.  
  568. C<RETURN> is optional, but if given it should be a reference to a list which
  569. contains field names to be returned.
  570.  
  571. The alternative syntax is to pass strings instead of references, for example
  572.  
  573.     $q = $ph->query('name=myname',
  574.             'name email schedule');
  575.  
  576. The C<SEARCH> argument is a string that is passed to the Nameserver as the 
  577. search criteria. The strings being passed should B<not> contain any carriage
  578. returns, or else the query command might fail or return invalid data.
  579.  
  580. C<RETURN> is optional, but if given it should be a string which will
  581. contain field names to be returned.
  582.  
  583. Each match from the server will be returned as a HASH where the keys are the
  584. field names and the values are C<Net::PH:Result> objects (I<code>, I<value>, 
  585. I<field>, I<text>).
  586.  
  587. Returns a reference to an ARRAY which contains references to HASHs, one
  588. per match from the server.
  589.  
  590. =item change( SEARCH , MAKE )
  591.  
  592.     $r = $ph->change({ email => "*.domain.name" },
  593.                      { schedule => "busy");
  594.  
  595. Change field values for matching entries.
  596.  
  597. The C<SEARCH> argument is a reference to a HASH which contains field/value
  598. pairs which will be passed to the Nameserver as the search criteria.
  599.  
  600. The C<MAKE> argument is a reference to a HASH which contains field/value
  601. pairs which will be passed to the Nameserver that
  602. will set new values to designated fields.
  603.  
  604. The alternative syntax is to pass strings instead of references, for example
  605.  
  606.     $r = $ph->change('email="*.domain.name"',
  607.                      'schedule="busy"');
  608.  
  609. The C<SEARCH> argument is a string to be passed to the Nameserver as the 
  610. search criteria. The strings being passed should B<not> contain any carriage
  611. returns, or else the query command might fail or return invalid data.
  612.  
  613.  
  614. The C<MAKE> argument is a string to be passed to the Nameserver that
  615. will set new values to designated fields.
  616.  
  617. Upon success all entries that match the search criteria will have
  618. the field values, given in the Make argument, changed.
  619.  
  620. =item login( USER, PASS [, ENCRYPT ])
  621.  
  622.     $r = $ph->login('username','password',1);
  623.  
  624. Enter login mode using C<USER> and C<PASS>. If C<ENCRYPT> is given and
  625. is I<true> then the password will be used to encrypt a challenge text 
  626. string provided by the server, and the encrypted string will be sent back
  627. to the server. If C<ENCRYPT> is not given, or I<false> then the password 
  628. will be sent in clear text (I<this is not recommended>)
  629.  
  630. =item logout()
  631.  
  632.     $r = $ph->logout();
  633.  
  634. Exit login mode and return to anonymous mode.
  635.  
  636. =item fields( [ FIELD_LIST ] )
  637.  
  638.     $fields = $ph->fields();
  639.     foreach $field (keys %{$fields}) {
  640.         $c = ${$fields}{$field}->code;
  641.         $v = ${$fields}{$field}->value;
  642.         $f = ${$fields}{$field}->field;
  643.         $t = ${$fields}{$field}->text;
  644.         print "field:[$field] [$c][$v][$f][$t]\n";
  645.     }
  646.  
  647. In a scalar context, returns a reference to a HASH. The keys of the HASH are
  648. the field names and the values are C<Net::PH:Result> objects (I<code>,
  649. I<value>, I<field>, I<text>).
  650.  
  651. In an array context, returns a two element array. The first element is a
  652. reference to a HASH as above, the second element is a reference to an array
  653. which contains the tag names in the order that they were returned from the
  654. server.
  655.  
  656. C<FIELD_LIST> is a string that lists the fields for which info will be
  657. returned.
  658.  
  659. =item add( FIELD_VALUES )
  660.  
  661.     $r = $ph->add( { name => $name, phone => $phone });
  662.  
  663. This method is used to add new entries to the Nameserver database. You
  664. must successfully call L<login> before this method can be used.
  665.  
  666. B<Note> that this method adds new entries to the database. To modify
  667. an existing entry use L<change>.
  668.  
  669. C<FIELD_VALUES> is a reference to a HASH which contains field/value
  670. pairs which will be passed to the Nameserver and will be used to 
  671. initialize the new entry.
  672.  
  673. The alternative syntax is to pass a string instead of a reference, for example
  674.  
  675.     $r = $ph->add('name=myname phone=myphone');
  676.  
  677. C<FIELD_VALUES> is a string that consists of field/value pairs which the
  678. new entry will contain. The strings being passed should B<not> contain any
  679. carriage returns, or else the query command might fail or return invalid data.
  680.  
  681.  
  682. =item delete( FIELD_VALUES )
  683.  
  684.     $r = $ph->delete('name=myname phone=myphone');
  685.  
  686. This method is used to delete existing entries from the Nameserver database.
  687. You must successfully call L<login> before this method can be used.
  688.  
  689. B<Note> that this method deletes entries to the database. To modify
  690. an existing entry use L<change>.
  691.  
  692. C<FIELD_VALUES> is a string that serves as the search criteria for the
  693. records to be deleted. Any entry in the database which matches this search 
  694. criteria will be deleted.
  695.  
  696. =item id( [ ID ] )
  697.  
  698.     $r = $ph->id('709');
  699.  
  700. Sends C<ID> to the Nameserver, which will enter this into its
  701. logs. If C<ID> is not given then the UID of the user running the
  702. process will be sent.
  703.  
  704. =item status()
  705.  
  706. Returns the current status of the Nameserver.
  707.  
  708. =item siteinfo()
  709.  
  710.     $siteinfo = $ph->siteinfo();
  711.     foreach $field (keys %{$siteinfo}) {
  712.         $c = ${$siteinfo}{$field}->code;
  713.         $v = ${$siteinfo}{$field}->value;
  714.         $f = ${$siteinfo}{$field}->field;
  715.         $t = ${$siteinfo}{$field}->text;
  716.         print "field:[$field] [$c][$v][$f][$t]\n";
  717.     }
  718.  
  719. Returns a reference to a HASH containing information about the server's 
  720. site. The keys of the HASH are the field names and values are
  721. C<Net::PH:Result> objects (I<code>, I<value>, I<field>, I<text>).
  722.  
  723. =item quit()
  724.  
  725.     $r = $ph->quit();
  726.  
  727. Quit the connection
  728.  
  729. =back
  730.  
  731. =head1 Q&A
  732.  
  733. How do I get the values of a Net::PH::Result object?
  734.  
  735.     foreach $handle (@{$q}) {
  736.         foreach $field (keys %{$handle}) {
  737.             $my_code  = ${$q}{$field}->code;
  738.             $my_value = ${$q}{$field}->value;
  739.             $my_field = ${$q}{$field}->field;
  740.             $my_text  = ${$q}{$field}->text;
  741.         }
  742.     }
  743.  
  744. How do I get a count of the returned matches to my query?
  745.  
  746.     $my_count = scalar(@{$query_result});
  747.  
  748. How do I get the status code and message of the last C<$ph> command?
  749.  
  750.     $status_code    = $ph->code;
  751.     $status_message = $ph->message;
  752.  
  753. =head1 SEE ALSO
  754.  
  755. L<Net::Cmd>
  756.  
  757. =head1 AUTHORS
  758.  
  759. Graham Barr <gbarr@pobox.com>
  760. Alex Hristov <hristov@slb.com>
  761.  
  762. =head1 ACKNOWLEDGMENTS
  763.  
  764. Password encryption code ported to perl by Broc Seib <bseib@purdue.edu>,
  765. Purdue University Computing Center.
  766.  
  767. Otis Gospodnetic <otisg@panther.middlebury.edu> suggested
  768. passing parameters as string constants. Some queries cannot be 
  769. executed when passing parameters as string references.
  770.  
  771.         Example: query first_name last_name email="*.domain"
  772.  
  773. =head1 COPYRIGHT
  774.  
  775. The encryption code is based upon cryptit.c, Copyright (C) 1988 by
  776. Steven Dorner, and Paul Pomes, and the University of Illinois Board
  777. of Trustees, and by CSNET.
  778.  
  779. All other code is Copyright (c) 1996-1997 Graham Barr <gbarr@pobox.com>
  780. and Alex Hristov <hristov@slb.com>. All rights reserved. This program is
  781. free software; you can redistribute it and/or modify it under the same
  782. terms as Perl itself.
  783.  
  784. =cut
  785.