Commit | Line | Data |
406c51ee |
1 | # Net::SNPP.pm |
2 | # |
3 | # Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com>. All rights reserved. |
4 | # This program is free software; you can redistribute it and/or |
5 | # modify it under the same terms as Perl itself. |
6 | |
7 | package Net::SNPP; |
8 | |
9 | require 5.001; |
10 | |
11 | use strict; |
12 | use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
13 | use Socket 1.3; |
14 | use Carp; |
15 | use IO::Socket; |
16 | use Net::Cmd; |
17 | use Net::Config; |
18 | |
19 | $VERSION = "1.11"; # $Id:$ |
20 | @ISA = qw(Net::Cmd IO::Socket::INET); |
21 | @EXPORT = (qw(CMD_2WAYERROR CMD_2WAYOK CMD_2WAYQUEUED), @Net::Cmd::EXPORT); |
22 | |
23 | sub CMD_2WAYERROR () { 7 } |
24 | sub CMD_2WAYOK () { 8 } |
25 | sub CMD_2WAYQUEUED () { 9 } |
26 | |
27 | sub new |
28 | { |
29 | my $self = shift; |
30 | my $type = ref($self) || $self; |
31 | my $host = shift if @_ % 2; |
32 | my %arg = @_; |
33 | my $hosts = defined $host ? [ $host ] : $NetConfig{snpp_hosts}; |
34 | my $obj; |
35 | |
36 | my $h; |
37 | foreach $h (@{$hosts}) |
38 | { |
39 | $obj = $type->SUPER::new(PeerAddr => ($host = $h), |
40 | PeerPort => $arg{Port} || 'snpp(444)', |
41 | Proto => 'tcp', |
42 | Timeout => defined $arg{Timeout} |
43 | ? $arg{Timeout} |
44 | : 120 |
45 | ) and last; |
46 | } |
47 | |
48 | return undef |
49 | unless defined $obj; |
50 | |
51 | ${*$obj}{'net_snpp_host'} = $host; |
52 | |
53 | $obj->autoflush(1); |
54 | |
55 | $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef); |
56 | |
57 | unless ($obj->response() == CMD_OK) |
58 | { |
59 | $obj->close(); |
60 | return undef; |
61 | } |
62 | |
63 | $obj; |
64 | } |
65 | |
66 | ## |
67 | ## User interface methods |
68 | ## |
69 | |
70 | sub pager_id |
71 | { |
72 | @_ == 2 or croak 'usage: $snpp->pager_id( PAGER_ID )'; |
73 | shift->_PAGE(@_); |
74 | } |
75 | |
76 | sub content |
77 | { |
78 | @_ == 2 or croak 'usage: $snpp->content( MESSAGE )'; |
79 | shift->_MESS(@_); |
80 | } |
81 | |
82 | sub send |
83 | { |
84 | my $me = shift; |
85 | |
86 | if(@_) |
87 | { |
88 | my %arg = @_; |
89 | |
90 | if(exists $arg{Pager}) |
91 | { |
92 | my $pagers = ref($arg{Pager}) ? $arg{Pager} : [ $arg{Pager} ]; |
93 | my $pager; |
94 | foreach $pager (@$pagers) |
95 | { |
96 | $me->_PAGE($pager) || return 0 |
97 | } |
98 | } |
99 | |
100 | $me->_MESS($arg{Message}) || return 0 |
101 | if(exists $arg{Message}); |
102 | |
103 | $me->hold($arg{Hold}) || return 0 |
104 | if(exists $arg{Hold}); |
105 | |
106 | $me->hold($arg{HoldLocal},1) || return 0 |
107 | if(exists $arg{HoldLocal}); |
108 | |
109 | $me->_COVE($arg{Coverage}) || return 0 |
110 | if(exists $arg{Coverage}); |
111 | |
112 | $me->_ALER($arg{Alert} ? 1 : 0) || return 0 |
113 | if(exists $arg{Alert}); |
114 | |
115 | $me->service_level($arg{ServiceLevel}) || return 0 |
116 | if(exists $arg{ServiceLevel}); |
117 | } |
118 | |
119 | $me->_SEND(); |
120 | } |
121 | |
122 | sub data |
123 | { |
124 | my $me = shift; |
125 | |
126 | my $ok = $me->_DATA() && $me->datasend(@_); |
127 | |
128 | return $ok |
129 | unless($ok && @_); |
130 | |
131 | $me->dataend; |
132 | } |
133 | |
134 | sub login |
135 | { |
136 | @_ == 2 || @_ == 3 or croak 'usage: $snpp->login( USER [, PASSWORD ])'; |
137 | shift->_LOGI(@_); |
138 | } |
139 | |
140 | sub help |
141 | { |
142 | @_ == 1 or croak 'usage: $snpp->help()'; |
143 | my $me = shift; |
144 | |
145 | return $me->_HELP() ? $me->message |
146 | : undef; |
147 | } |
148 | |
149 | sub xwho |
150 | { |
151 | @_ == 1 or croak 'usage: $snpp->xwho()'; |
152 | my $me = shift; |
153 | |
154 | $me->_XWHO or return undef; |
155 | |
156 | my(%hash,$line); |
157 | my @msg = $me->message; |
158 | pop @msg; # Remove command complete line |
159 | |
160 | foreach $line (@msg) { |
161 | $line =~ /^\s*(\S+)\s*(.*)/ and $hash{$1} = $2; |
162 | } |
163 | |
164 | \%hash; |
165 | } |
166 | |
167 | sub service_level |
168 | { |
169 | @_ == 2 or croak 'usage: $snpp->service_level( LEVEL )'; |
170 | my $me = shift; |
171 | my $level = int(shift); |
172 | |
173 | if($level < 0 || $level > 11) |
174 | { |
175 | $me->set_status(550,"Invalid Service Level"); |
176 | return 0; |
177 | } |
178 | |
179 | $me->_LEVE($level); |
180 | } |
181 | |
182 | sub alert |
183 | { |
184 | @_ == 1 || @_ == 2 or croak 'usage: $snpp->alert( VALUE )'; |
185 | my $me = shift; |
186 | my $value = (@_ == 1 || shift) ? 1 : 0; |
187 | |
188 | $me->_ALER($value); |
189 | } |
190 | |
191 | sub coverage |
192 | { |
193 | @_ == 1 or croak 'usage: $snpp->coverage( AREA )'; |
194 | shift->_COVE(@_); |
195 | } |
196 | |
197 | sub hold |
198 | { |
199 | @_ == 2 || @_ == 3 or croak 'usage: $snpp->hold( TIME [, LOCAL ] )'; |
200 | my $me = shift; |
201 | my $time = shift; |
202 | my $local = (shift) ? "" : " +0000"; |
203 | |
204 | my @g = reverse((gmtime($time))[0..5]); |
205 | $g[1] += 1; |
206 | $g[0] %= 100; |
207 | |
208 | $me->_HOLD( sprintf("%02d%02d%02d%02d%02d%02d%s",@g,$local)); |
209 | } |
210 | |
211 | sub caller_id |
212 | { |
213 | @_ == 2 or croak 'usage: $snpp->caller_id( CALLER_ID )'; |
214 | shift->_CALL(@_); |
215 | } |
216 | |
217 | sub subject |
218 | { |
219 | @_ == 2 or croak 'usage: $snpp->subject( SUBJECT )'; |
220 | shift->_SUBJ(@_); |
221 | } |
222 | |
223 | sub two_way |
224 | { |
225 | @_ == 1 or croak 'usage: $snpp->two_way()'; |
226 | shift->_2WAY(); |
227 | } |
228 | |
229 | sub quit |
230 | { |
231 | @_ == 1 or croak 'usage: $snpp->quit()'; |
232 | my $snpp = shift; |
233 | |
234 | $snpp->_QUIT; |
235 | $snpp->close; |
236 | } |
237 | |
238 | ## |
239 | ## IO/perl methods |
240 | ## |
241 | |
242 | sub DESTROY |
243 | { |
244 | my $snpp = shift; |
245 | defined(fileno($snpp)) && $snpp->quit |
246 | } |
247 | |
248 | ## |
249 | ## Over-ride methods (Net::Cmd) |
250 | ## |
251 | |
252 | sub debug_text |
253 | { |
254 | $_[2] =~ s/^((logi|page)\s+\S+\s+)\S+/$1 xxxx/io; |
255 | $_[2]; |
256 | } |
257 | |
258 | sub parse_response |
259 | { |
260 | return () |
261 | unless $_[1] =~ s/^(\d\d\d)(.?)//o; |
262 | my($code,$more) = ($1, $2 eq "-"); |
263 | |
264 | $more ||= $code == 214; |
265 | |
266 | ($code,$more); |
267 | } |
268 | |
269 | ## |
270 | ## RFC1861 commands |
271 | ## |
272 | |
273 | # Level 1 |
274 | |
275 | sub _PAGE { shift->command("PAGE", @_)->response() == CMD_OK } |
276 | sub _MESS { shift->command("MESS", @_)->response() == CMD_OK } |
277 | sub _RESE { shift->command("RESE")->response() == CMD_OK } |
278 | sub _SEND { shift->command("SEND")->response() == CMD_OK } |
279 | sub _QUIT { shift->command("QUIT")->response() == CMD_OK } |
280 | sub _HELP { shift->command("HELP")->response() == CMD_OK } |
281 | sub _DATA { shift->command("DATA")->response() == CMD_MORE } |
282 | sub _SITE { shift->command("SITE",@_) } |
283 | |
284 | # Level 2 |
285 | |
286 | sub _LOGI { shift->command("LOGI", @_)->response() == CMD_OK } |
287 | sub _LEVE { shift->command("LEVE", @_)->response() == CMD_OK } |
288 | sub _ALER { shift->command("ALER", @_)->response() == CMD_OK } |
289 | sub _COVE { shift->command("COVE", @_)->response() == CMD_OK } |
290 | sub _HOLD { shift->command("HOLD", @_)->response() == CMD_OK } |
291 | sub _CALL { shift->command("CALL", @_)->response() == CMD_OK } |
292 | sub _SUBJ { shift->command("SUBJ", @_)->response() == CMD_OK } |
293 | |
294 | # NonStandard |
295 | |
296 | sub _XWHO { shift->command("XWHO")->response() == CMD_OK } |
297 | |
298 | 1; |
299 | __END__ |
300 | |
301 | =head1 NAME |
302 | |
303 | Net::SNPP - Simple Network Pager Protocol Client |
304 | |
305 | =head1 SYNOPSIS |
306 | |
307 | use Net::SNPP; |
308 | |
309 | # Constructors |
310 | $snpp = Net::SNPP->new('snpphost'); |
311 | $snpp = Net::SNPP->new('snpphost', Timeout => 60); |
312 | |
313 | =head1 NOTE |
314 | |
315 | This module is not complete, yet ! |
316 | |
317 | =head1 DESCRIPTION |
318 | |
319 | This module implements a client interface to the SNPP protocol, enabling |
320 | a perl5 application to talk to SNPP servers. This documentation assumes |
321 | that you are familiar with the SNPP protocol described in RFC1861. |
322 | |
323 | A new Net::SNPP object must be created with the I<new> method. Once |
324 | this has been done, all SNPP commands are accessed through this object. |
325 | |
326 | =head1 EXAMPLES |
327 | |
328 | This example will send a pager message in one hour saying "Your lunch is ready" |
329 | |
330 | #!/usr/local/bin/perl -w |
331 | |
332 | use Net::SNPP; |
333 | |
334 | $snpp = Net::SNPP->new('snpphost'); |
335 | |
336 | $snpp->send( Pager => $some_pager_number, |
337 | Message => "Your lunch is ready", |
338 | Alert => 1, |
339 | Hold => time + 3600, # lunch ready in 1 hour :-) |
340 | ) || die $snpp->message; |
341 | |
342 | $snpp->quit; |
343 | |
344 | =head1 CONSTRUCTOR |
345 | |
346 | =over 4 |
347 | |
348 | =item new ( [ HOST, ] [ OPTIONS ] ) |
349 | |
350 | This is the constructor for a new Net::SNPP object. C<HOST> is the |
351 | name of the remote host to which a SNPP connection is required. |
352 | |
353 | If C<HOST> is not given, then the C<SNPP_Host> specified in C<Net::Config> |
354 | will be used. |
355 | |
356 | C<OPTIONS> are passed in a hash like fashion, using key and value pairs. |
357 | Possible options are: |
358 | |
359 | B<Timeout> - Maximum time, in seconds, to wait for a response from the |
360 | SNPP server (default: 120) |
361 | |
362 | B<Debug> - Enable debugging information |
363 | |
364 | |
365 | Example: |
366 | |
367 | |
368 | $snpp = Net::SNPP->new('snpphost', |
369 | Debug => 1, |
370 | ); |
371 | |
372 | =head1 METHODS |
373 | |
374 | Unless otherwise stated all methods return either a I<true> or I<false> |
375 | value, with I<true> meaning that the operation was a success. When a method |
376 | states that it returns a value, failure will be returned as I<undef> or an |
377 | empty list. |
378 | |
379 | =over 4 |
380 | |
381 | =item reset () |
382 | |
383 | =item help () |
384 | |
385 | Request help text from the server. Returns the text or undef upon failure |
386 | |
387 | =item quit () |
388 | |
389 | Send the QUIT command to the remote SNPP server and close the socket connection. |
390 | |
391 | =back |
392 | |
393 | =head1 EXPORTS |
394 | |
395 | C<Net::SNPP> exports all that C<Net::CMD> exports, plus three more subroutines |
396 | that can bu used to compare against the result of C<status>. These are :- |
397 | C<CMD_2WAYERROR>, C<CMD_2WAYOK>, and C<CMD_2WAYQUEUED>. |
398 | |
399 | =head1 SEE ALSO |
400 | |
401 | L<Net::Cmd> |
402 | RFC1861 |
403 | |
404 | =head1 AUTHOR |
405 | |
406 | Graham Barr <gbarr@pobox.com> |
407 | |
408 | =head1 COPYRIGHT |
409 | |
410 | Copyright (c) 1995-1997 Graham Barr. All rights reserved. |
411 | This program is free software; you can redistribute it and/or modify |
412 | it under the same terms as Perl itself. |
413 | |
414 | =cut |