Commit | Line | Data |
406c51ee |
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 |