home *** CD-ROM | disk | FTP | other *** search
/ CLIX - Fazer Clix Custa Nix / CLIX-CD.cdr / mac / lib / Net / PH.pm < prev    next >
Encoding:
Text File  |  1997-11-18  |  20.9 KB  |  961 lines  |  [TEXT/McPL]
  1. #
  2. # Copyright (c) 1995-1997 Graham Barr <gbarr@ti.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 = do { my @r=(q$Revision: 1.1 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
  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.    push(@r, "$k=$a");   
  232.   }
  233.  join(" ", @r);
  234. }
  235.  
  236. sub _arg_list
  237. {
  238.  my $arr = shift;
  239.  
  240.  return $arr
  241.     unless(ref($arr));
  242.  
  243.  my $v;
  244.  my @r;
  245.  
  246.  foreach $v (@$arr)
  247.   {
  248.    my $a = $v;
  249.    $a =~ s/\n/\\n/sog;
  250.    $a =~ s/\t/\\t/sog;
  251.    $a = '"' . $a . '"'
  252.     if $a =~ /\W/;
  253.    push(@r, $a);   
  254.   }
  255.  
  256.  join(" ",@r);
  257. }
  258.  
  259. sub add
  260. {
  261.  my $ph = shift;
  262.  my $arg = @_ > 1 ? { @_ } : shift;
  263.  
  264.  $ph->command('add', _arg_hash($arg))->response == CMD_OK;
  265. }
  266.  
  267. sub delete
  268. {
  269.  my $ph = shift;
  270.  my $arg = @_ > 1 ? { @_ } : shift;
  271.  
  272.  $ph->command('delete', _arg_hash($arg))->response == CMD_OK;
  273. }
  274.  
  275. sub force
  276. {
  277.  my $ph = shift; 
  278.  my $search = shift;
  279.  my $force = shift;
  280.  
  281.  $ph->command(
  282.     "change", _arg_hash($search),
  283.     "force",  _arg_hash($force)
  284.  )->response == CMD_OK;
  285. }
  286.  
  287.  
  288. sub fields
  289. {
  290.  my $ph = shift;
  291.  
  292.  $ph->command("fields", _arg_list(\@_));
  293.  
  294.  my $ln;
  295.  my %resp;
  296.  my $cur_num = 0;
  297.  
  298.  while(defined($ln = $ph->getline))
  299.   {
  300.    $ph->debug_print(0,$ln)
  301.      if ($ph->debug & 2);
  302.    chomp($ln);
  303.    my($code,$num,$tag,$data,$last_tag);
  304.  
  305.    if($ln =~ /^-(\d+):(\d+):\s*([^:]*):\s*(.*)/o)
  306.     {
  307.      ($code,$num,$tag,$data) = ($1,$2,$3,$4);
  308.  
  309.      $tag = $last_tag
  310.     unless(length($tag));
  311.  
  312.      $last_tag = $tag;
  313.  
  314.      if(exists $resp{$tag})
  315.       {
  316.        $resp{$tag}->[3] .= "\n" . $data;
  317.       }
  318.      else
  319.       {
  320.        $resp{$tag} = bless [$code, $num, $tag, $data], "Net::PH::Result";
  321.       }
  322.     }
  323.    else
  324.     {
  325.      $ph->set_status($ph->parse_response($ln));
  326.      return \%resp;
  327.     }
  328.   }
  329.  return undef;
  330. }
  331.  
  332. sub quit
  333. {
  334.  my $ph = shift;
  335.  
  336.  $ph->close
  337.     if $ph->command("quit")->response == CMD_OK;
  338. }
  339.  
  340. ##
  341. ## Net::Cmd overrides
  342. ##
  343.  
  344. sub parse_response
  345. {
  346.  return ()
  347.     unless $_[1] =~ s/^(-?)(\d\d\d):?//o;
  348.  ($2, $1 eq "-");
  349. }
  350.  
  351. sub debug_text { $_[2] =~ /^(clear)/i ? "$1 ....\n" : $_[2]; }
  352.  
  353. package Net::PH::Result;
  354.  
  355. sub code  { shift->[0] }
  356. sub value { shift->[1] }
  357. sub field { shift->[2] }
  358. sub text  { shift->[3] }
  359.  
  360. package Net::PH::crypt;
  361.  
  362. ##
  363. #    'cryptit.pl'
  364. #
  365. #    Description:    perl port of Steven Dorner's cryptit.c
  366. #
  367. #                    Allows password encryption for CCSO
  368. #                    qi server.
  369. #
  370. #    Author:            Broc Seib
  371. #                       Purdue University Computing Center
  372. #    Date:            Thu Nov  7 21:17:46 EST 1996
  373. #                    Tue Nov 12 16:04:36 EST 1996
  374. ##
  375.  
  376. ##
  377. #
  378. #  This software is based upon 'cryptit.c', Copyright (C) 1988 by
  379. #  Steven Dorner and the University of Illinois Board of Trustees,
  380. #  and by CSNET.
  381. #
  382. #  The development of this software is independent of any of the
  383. #  aforementioned parties. No warranties of any kind are expressed
  384. #  or implied.
  385. #
  386. #  Author of this perl library 'cryptit.pl' may be contacted:
  387. #
  388. #    Broc Seib bseib@purdue.edu  Network Systems Programmer
  389. #    1408 Mathematical Sciences  Instructional Computing Division
  390. #    W Lafayette, IN 47907-1408  Purdue University Computing Center
  391. #    
  392. ##
  393.  
  394. use Math::BigInt;
  395. use    integer;
  396.  
  397. ##
  398. #    CONSTANTS
  399. #
  400.  
  401. use vars qw($c1 $c2 $c3 $c4 @cr $n1 $n2
  402.         $ROTORSZ $MASK $ERR $REPORT $BUGZ
  403.         @t1 @t2 @t3 $i $k );
  404.  
  405. BEGIN {
  406.     $ROTORSZ = 256;
  407.     $MASK = 255;
  408.     $BUGZ = 0;        # to set debug output level
  409.     $ERR = "";
  410.     $REPORT = "$ERR\nPlease report this bug to bseib\@purdue.edu.\n";
  411. }
  412. #
  413. ##
  414.  
  415.  
  416. ##
  417. #    Routine:        crypt_start
  418. #                    &crypt_start($passwd);
  419. #
  420. #    Description:    Initializes the crypt tables based on a passwd.
  421. #
  422. #    Author:            Broc Seib
  423. #                       Purdue University Computing Center
  424. #    Date:            Thu Nov  7 21:33:37 EST 1996
  425. ##
  426. sub crypt_start # (char *pass)
  427. {
  428.     my    $pw = $_[0] if $_[0];
  429.     my    ($ic, $i, $k, $temp, $random, $buf, $lbuf);
  430.     my    $seed;
  431.     my    ($signed_seed, $sign);
  432.     my    $b32 = new Math::BigInt '4294967296';
  433.     my    $b31 = new Math::BigInt '2147483648';
  434.  
  435.     $n1 = 0;
  436.     $n2 = 0;
  437.  
  438.     ##
  439.     #    init tables to zero
  440.     #
  441.     for ($i = 0; $i < $ROTORSZ; $i++) {
  442.         $t1[$i] = $t2[$i] = $t3[$i] = 0;
  443.     }
  444.     #
  445.     ##
  446.  
  447.     ##
  448.     #    create a "random" set of chars, DES-based on your passwd,
  449.     #    using the same passwd as salt.
  450.     #
  451.     $buf = crypt($pw, $pw);    # should return a 13 char str to $buf
  452.     $lbuf = length($buf);
  453.     return(-1) if ($lbuf <= 0); # caller didn't supply a passwd
  454.     #
  455.     #    using a seeded pseudo random num gen, fill in the tables
  456.     #    with "random" guk.
  457.     #
  458.     $seed = new Math::BigInt '123';        # where did 123 come from, Steve? :-)
  459.     for ($i = 0; $i < $lbuf; $i++) {
  460.         $seed = ($seed * ord(substr($buf,$i,1)) + $i) % $b32;
  461.     }
  462.     for ($i = 0; $i < $ROTORSZ; $i++) {
  463.         $t1[$i] = $i;
  464.     }
  465.  
  466.     for ($i = 0; $i < $ROTORSZ; $i++) {
  467.         print STDERR "\n" if ($BUGZ > 1);
  468.         $seed = (5 * $seed + ord(substr($buf,($i % $lbuf),1))) % $b32;
  469.         printf(STDERR "seed: %08lx\n",$seed) if ($BUGZ > 1);
  470.         if ($seed >= $b31) {
  471.             $sign = -1;
  472.             $signed_seed = ($seed - $b32);
  473.         } else {
  474.             $sign = 1;
  475.             $signed_seed = ($seed);
  476.         }
  477.         printf(STDERR "sgsd: %08lx\n",$signed_seed) if ($BUGZ > 1);
  478.         $random = $sign * int($signed_seed % '65521');
  479.         printf(STDERR "ran1: %08lx\n",$random) if ($BUGZ > 1);
  480.         $k = $ROTORSZ - 1 - $i;
  481.         $ic = ($random & $MASK) % ($k + 1);
  482.         printf(STDERR " ic1: %08lx\n",$ic) if ($BUGZ > 1);
  483.         $random = ($random >> 8) & $MASK;
  484.         printf(STDERR "ran2: %08lx\n",$random) if ($BUGZ > 1);
  485.         $temp = $t1[$k];
  486.         $t1[$k] = $t1[$ic];
  487.         $t1[$ic] = $temp;
  488.         next if ($t3[$k] != 0);
  489.         unless ($k) {
  490.             $ERR = "[0] Can't % by zero. \$k=$k";
  491.             die $REPORT;
  492.         }
  493.         $ic = ($random & $MASK) % $k;
  494.         printf(STDERR " ic2: %08lx\n",$ic) if ($BUGZ > 1);
  495.         while ($t3[$ic] != 0) {
  496.             unless ($k) {
  497.                 $ERR = "[1] Can't % by zero. \$k=$k";
  498.                 die $REPORT;
  499.             }
  500.             $ic = ($ic + 1) % $k;
  501.             printf(STDERR " ic3: %08lx\n",$ic) if ($BUGZ > 1);
  502.         }
  503.         $t3[$k] = $ic;
  504.         $t3[$ic] = $k;
  505.     }
  506.     for ($i = 0; $i < $ROTORSZ; $i++) {
  507.         $t2[$t1[$i] & $MASK] = $i;
  508.     }
  509.     #
  510.     ##
  511.  
  512.     ##
  513.     #    if in debug mode, print the crypt tables
  514.     #
  515.     &print_t(@t1) if $BUGZ;
  516.     &print_t(@t2) if $BUGZ;
  517.     &print_t(@t3) if $BUGZ;
  518.     #
  519.     ##
  520.  
  521.     ##
  522.     #    return value undefined
  523.     #
  524.     undef;
  525.     #
  526.     ##
  527. }
  528.  
  529.  
  530. ##
  531. #    Routine:        encryptit
  532. #                    ($len,$crypt_str) = &encryptit($plain_str);
  533. #
  534. #    Description:    Encrypts a string given the current state of
  535. #                    the encryption tables, as setup by &crypt_start().
  536. #                    The plain string is passed in, A length scalar is
  537. #                    returned, representing the length of the encrypted
  538. #                    string. The encrypted string also contains a length
  539. #                    byte as the first byte. The crypt string is returned
  540. #                    as the second return array element.
  541. #
  542. #    Author:            Broc Seib
  543. #                       Purdue University Computing Center
  544. #    Date:            Thu Nov  7 23:00:44 EST 1996
  545. ##
  546. sub encryptit
  547. {
  548.     my    $plain_str = $_[0] if $_[0];
  549.     my    $crypt_str;
  550.     my    ($x, @cr);
  551.  
  552.     print STDERR $plain_str,"\n" if $BUGZ;
  553.  
  554.     ##
  555.     #    for each letter in the plain str, create a
  556.     #    byte for part of the crypt str. They will actually
  557.     #    be remapped into a 6bit character set, thus growing
  558.     #    in length by a factor of a third. It is advised to pass
  559.     #    in a string that is a length multiple of three.
  560.     #
  561.     for ($i=0;$i<length($plain_str);$i++) {
  562.         $x = ord(substr($plain_str,$i,1)) + $n1;
  563.         $x = $t1[$x & $MASK] + $n2;
  564.         $x = $t3[$x & $MASK] - $n2;
  565.         $x = $t2[$x & $MASK] - $n1;
  566.         $x = ($x & $MASK);
  567.         push (@cr, $x);
  568.         $n1 = ($n1 + 1) % $ROTORSZ;
  569.         $n2 = ($n2 + 1) % $ROTORSZ unless ($n1);
  570.     }
  571.     #
  572.     ##
  573.  
  574.     ##
  575.     #    convert this list of bytes into printable string
  576.     #    and return it along with str length
  577.     #
  578.     $crypt_str =  &encode(@cr);
  579.     return (length($crypt_str),$crypt_str);
  580.     #
  581.     ##
  582. }
  583.  
  584.  
  585. ##
  586. #    Routine:        encode
  587. #
  588. #    Description:    Encodes a list of bytes into a printable string.
  589. #                    The printable characters are in a set of 64
  590. #                    beginning with ASCII '#'. Only 6 bits are needed
  591. #                    per character, so a set of 3 chars incoming are
  592. #                    converted into 4 chars outgoing. The beginning
  593. #                    length byte represents the number of eight bit
  594. #                    chars coming in, not the number of six bit chars
  595. #                    going out.
  596. #
  597. #    Author:            Broc Seib
  598. #                       Purdue University Computing Center
  599. #    Date:            Thu Nov  7 23:41:36 EST 1996
  600. ##
  601. sub encode
  602. {
  603.     my    @cr = @_ if @_;        # the crypt char list;
  604.     my    $str;
  605.     my    ($c1, $c2, $c3, $c4);
  606.     my    @ts;                # stands for "threesome"
  607.  
  608.     $str = &ENC($#cr + 1);        # length byte
  609.  
  610.     @ts = splice(@cr,0,3);        # grab first three from list
  611.     while ($#ts == 2) {            # right size
  612.         $c1 = int(  $ts[0] / 4);
  613.         $c2 = int( ($ts[0] % 4) * 16 + (int($ts[1] / 16) % 16) );
  614.         $c3 = int( ($ts[1] % 16) * 4 + (int($ts[2] / 64) % 4 ) );
  615.         $c4 = int( ($ts[2] % 64) );
  616.         $str = $str . &ENC($c1) . &ENC($c2) . &ENC($c3) . &ENC($c4);
  617.         @ts = splice(@cr,0,3);    # grab next three from list
  618.     }
  619.  
  620.     $str;    # return encoded string
  621. }
  622.  
  623.  
  624. sub ENC {
  625.     my    $c = $_[0] if $_[0];
  626.     return sprintf("%c",(($c % 64) + ord('#')) );
  627. }
  628.  
  629. sub SetDebugMode {
  630.     $BUGZ = $_[0];
  631. }
  632.  
  633. sub print_t {
  634.     my $i = 0;
  635.     my @t = @_;
  636.     foreach (@t) {
  637.         printf(STDERR "%02x",$_);
  638.         unless (++$i % 32) {
  639.             print STDERR "\n";
  640.         } else {
  641.             print STDERR ":" unless ($i % 4);
  642.         }
  643.     }
  644.     print STDERR "\n";
  645. }
  646.  
  647. ##
  648. #    EOF
  649. ##
  650. 1;
  651.  
  652. __END__
  653.  
  654. =head1 NAME
  655.  
  656. Net::PH - CCSO Nameserver Client class
  657.  
  658. =head1 SYNOPSIS
  659.  
  660.     use Net::PH;
  661.     
  662.     $ph = Net::PH->new("some.host.name",
  663.                        Port    => 105,
  664.                        Timeout => 120,
  665.                        Debug   => 0);
  666.  
  667.     if($ph) {
  668.         $q = $ph->query({ field1 => "value1" },
  669.                         [qw(name address pobox)]);
  670.     
  671.         if($q) {
  672.         }
  673.     }
  674.     
  675.     # Alternative syntax
  676.     
  677.     if($ph) {
  678.         $q = $ph->query('field1=value1',
  679.                         'name address pobox');
  680.     
  681.         if($q) {
  682.         }
  683.     }
  684.  
  685. =head1 DESCRIPTION
  686.  
  687. C<Net::PH> is a class implementing a simple Nameserver/PH client in Perl
  688. as described in the CCSO Nameserver -- Server-Client Protocol. Like other
  689. modules in the Net:: family the C<Net::PH> object inherits methods from
  690. C<Net::Cmd>.
  691.  
  692. =head1 CONSTRUCTOR
  693.  
  694. =over 4
  695.  
  696. =item new ( [ HOST ] [, OPTIONS ])
  697.  
  698.     $ph = Net::PH->new("some.host.name",
  699.                        Port    => 105,
  700.                        Timeout => 120,
  701.                        Debug   => 0
  702.                       );
  703.  
  704. This is the constructor for a new Net::PH object. C<HOST> is the
  705. name of the remote host to which a PH connection is required.
  706.  
  707. If C<HOST> is not given, then the C<SNPP_Host> specified in C<Net::Config>
  708. will be used.
  709.  
  710. C<OPTIONS> is an optional list of named options which are passed in
  711. a hash like fashion, using key and value pairs. Possible options are:-
  712.  
  713. B<Port> - Port number to connect to on remote host.
  714.  
  715. B<Timeout> - Maximum time, in seconds, to wait for a response from the
  716. Nameserver, a value of zero will cause all IO operations to block.
  717. (default: 120)
  718.  
  719. B<Debug> - Enable the printing of debugging information to STDERR
  720.  
  721. =back
  722.  
  723. =head1 METHODS
  724.  
  725. Unless otherwise stated all methods return either a I<true> or I<false>
  726. value, with I<true> meaning that the operation was a success. When a method
  727. states that it returns a value, failure will be returned as I<undef> or an
  728. empty list.
  729.  
  730. =over 4
  731.  
  732. =item query( SEARCH [, RETURN ] )
  733.  
  734.     $q = $ph->query({ name => $myname },
  735.             [qw(name email schedule)]);
  736.     
  737.     foreach $handle (@{$q}) {
  738.     foreach $field (keys %{$handle}) {
  739.             $c = ${$handle}{$field}->code;
  740.             $v = ${$handle}{$field}->value;
  741.             $f = ${$handle}{$field}->field;
  742.             $t = ${$handle}{$field}->text;
  743.             print "field:[$field] [$c][$v][$f][$t]\n" ;
  744.     }
  745.     }
  746.  
  747.     
  748.  
  749. Search the database and return fields from all matching entries.
  750.  
  751. The C<SEARCH> argument is a reference to a HASH which contains field/value
  752. pairs which will be passed to the Nameserver as the search criteria.
  753.  
  754. C<RETURN> is optional, but if given it should be a reference to a list which
  755. contains field names to be returned.
  756.  
  757. The alternative syntax is to pass strings instead of references, for example
  758.  
  759.     $q = $ph->query('name=myname',
  760.             'name email schedule');
  761.  
  762. The C<SEARCH> argument is a string that is passed to the Nameserver as the 
  763. search criteria.
  764.  
  765. C<RETURN> is optional, but if given it should be a string which will
  766. contain field names to be returned.
  767.  
  768. Each match from the server will be returned as a HASH where the keys are the
  769. field names and the values are C<Net::PH:Result> objects (I<code>, I<value>, 
  770. I<field>, I<text>).
  771.  
  772. Returns a reference to an ARRAY which contains references to HASHs, one
  773. per match from the server.
  774.  
  775. =item change( SEARCH , MAKE )
  776.  
  777.     $r = $ph->change({ email => "*.domain.name" },
  778.                      { schedule => "busy");
  779.  
  780. Change field values for matching entries.
  781.  
  782. The C<SEARCH> argument is a reference to a HASH which contains field/value
  783. pairs which will be passed to the Nameserver as the search criteria.
  784.  
  785. The C<MAKE> argument is a reference to a HASH which contains field/value
  786. pairs which will be passed to the Nameserver that
  787. will set new values to designated fields.
  788.  
  789. The alternative syntax is to pass strings instead of references, for example
  790.  
  791.     $r = $ph->change('email="*.domain.name"',
  792.                      'schedule="busy"');
  793.  
  794. The C<SEARCH> argument is a string to be passed to the Nameserver as the 
  795. search criteria.
  796.  
  797. The C<MAKE> argument is a string to be passed to the Nameserver that
  798. will set new values to designated fields.
  799.  
  800. Upon success all entries that match the search criteria will have
  801. the field values, given in the Make argument, changed.
  802.  
  803. =item login( USER, PASS [, ENCRYPT ])
  804.  
  805.     $r = $ph->login('username','password',1);
  806.  
  807. Enter login mode using C<USER> and C<PASS>. If C<ENCRYPT> is given and
  808. is I<true> then the password will be used to encrypt a challenge text 
  809. string provided by the server, and the encrypted string will be sent back
  810. to the server. If C<ENCRYPT> is not given, or I<false> the the password 
  811. will be sent in clear text (I<this is not recommended>)
  812.  
  813. =item logout()
  814.  
  815.     $r = $ph->logout();
  816.  
  817. Exit login mode and return to anonymous mode.
  818.  
  819. =item fields( [ FIELD_LIST ] )
  820.  
  821.     $fields = $ph->fields();
  822.     foreach $field (keys %{$fields}) {
  823.         $c = ${$fields}{$field}->code;
  824.         $v = ${$fields}{$field}->value;
  825.         $f = ${$fields}{$field}->field;
  826.         $t = ${$fields}{$field}->text;
  827.         print "field:[$field] [$c][$v][$f][$t]\n";
  828.     }
  829.  
  830. Returns a reference to a HASH. The keys of the HASH are the field names
  831. and the values are C<Net::PH:Result> objects (I<code>, I<value>, I<field>,
  832. I<text>).
  833.  
  834. C<FIELD_LIST> is a string that lists the fields for which info will be
  835. returned.
  836.  
  837. =item add( FIELD_VALUES )
  838.  
  839.     $r = $ph->add( { name => $name, phone => $phone });
  840.  
  841. This method is used to add new entries to the Nameserver database. You
  842. must successfully call L<login> before this method can be used.
  843.  
  844. B<Note> that this method adds new entries to the database. To modify
  845. an existing entry use L<change>.
  846.  
  847. C<FIELD_VALUES> is a reference to a HASH which contains field/value
  848. pairs which will be passed to the Nameserver and will be used to 
  849. initialize the new entry.
  850.  
  851. The alternative syntax is to pass a string instead of a reference, for example
  852.  
  853.     $r = $ph->add('name=myname phone=myphone');
  854.  
  855. C<FIELD_VALUES> is a string that consists of field/value pairs which the
  856. new entry will contain.
  857.  
  858. =item delete( FIELD_VALUES )
  859.  
  860.     $r = $ph->delete('name=myname phone=myphone');
  861.  
  862. This method is used to delete existing entries from the Nameserver database.
  863. You must successfully call L<login> before this method can be used.
  864.  
  865. B<Note> that this method deletes entries to the database. To modify
  866. an existing entry use L<change>.
  867.  
  868. C<FIELD_VALUES> is a string that serves as the search criteria for the
  869. records to be deleted. Any entry in the database which matches this search 
  870. criteria will be deleted.
  871.  
  872. =item id( [ ID ] )
  873.  
  874.     $r = $ph->id('709');
  875.  
  876. Sends C<ID> to the Nameserver, which will enter this into its
  877. logs. If C<ID> is not given then the UID of the user running the
  878. process will be sent.
  879.  
  880. =item status()
  881.  
  882. Returns the current status of the Nameserver.
  883.  
  884. =item siteinfo()
  885.  
  886.     $siteinfo = $ph->siteinfo();
  887.     foreach $field (keys %{$siteinfo}) {
  888.         $c = ${$siteinfo}{$field}->code;
  889.         $v = ${$siteinfo}{$field}->value;
  890.         $f = ${$siteinfo}{$field}->field;
  891.         $t = ${$siteinfo}{$field}->text;
  892.         print "field:[$field] [$c][$v][$f][$t]\n";
  893.     }
  894.  
  895. Returns a reference to a HASH containing information about the server's 
  896. site. The keys of the HASH are the field names and values are
  897. C<Net::PH:Result> objects (I<code>, I<value>, I<field>, I<text>).
  898.  
  899. =item quit()
  900.  
  901.     $r = $ph->quit();
  902.  
  903. Quit the connection
  904.  
  905. =back
  906.  
  907. =head1 Q&A
  908.  
  909. How do I get the values of a Net::PH::Result object?
  910.  
  911.     foreach $handle (@{$q}) {
  912.         foreach $field (keys %{$handle}) {
  913.             $my_code  = ${$q}{$field}->code;
  914.             $my_value = ${$q}{$field}->value;
  915.             $my_field = ${$q}{$field}->field;
  916.             $my_text  = ${$q}{$field}->text;
  917.         }
  918.     }
  919.  
  920. How do I get a count of the returned matches to my query?
  921.  
  922.     $my_count = scalar(@{$query_result});
  923.  
  924. How do I get the status code and message of the last C<$ph> command?
  925.  
  926.     $status_code    = $ph->code;
  927.     $status_message = $ph->message;
  928.  
  929. =head1 SEE ALSO
  930.  
  931. L<Net::Cmd>
  932.  
  933. =head1 AUTHORS
  934.  
  935. Graham Barr <gbarr@ti.com>
  936. Alex Hristov <hristov@slb.com>
  937.  
  938. =head1 ACKNOWLEDGMENTS
  939.  
  940. Password encryption code ported to perl by Broc Seib <bseib@purdue.edu>,
  941. Purdue University Computing Center.
  942.  
  943. Otis Gospodnetic <otisg@panther.middlebury.edu> suggested
  944. passing parameters as string constants. Some queries cannot be 
  945. executed when passing parameters as string references.
  946.  
  947.         Example: query first_name last_name email="*.domain"
  948.  
  949. =head1 COPYRIGHT
  950.  
  951. The encryption code is based upon cryptit.c, Copyright (C) 1988 by
  952. Steven Dorner and the University of Illinois Board of Trustees,
  953. and by CSNET.
  954.  
  955. All other code is Copyright (c) 1996-1997 Graham Barr <gbarr@ti.com>
  956. and Alex Hristov <hristov@slb.com>. All rights reserved. This program is
  957. free software; you can redistribute it and/or modify it under the same
  958. terms as Perl itself.
  959.  
  960. =cut
  961.