|
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#7$ |
|
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 |