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.
12 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
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);
23 sub CMD_2WAYERROR () { 7 }
24 sub CMD_2WAYOK () { 8 }
25 sub CMD_2WAYQUEUED () { 9 }
30 my $type = ref($self) || $self;
31 my $host = shift if @_ % 2;
33 my $hosts = defined $host ? [ $host ] : $NetConfig{snpp_hosts};
37 foreach $h (@{$hosts})
39 $obj = $type->SUPER::new(PeerAddr => ($host = $h),
40 PeerPort => $arg{Port} || 'snpp(444)',
42 Timeout => defined $arg{Timeout}
51 ${*$obj}{'net_snpp_host'} = $host;
55 $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
57 unless ($obj->response() == CMD_OK)
67 ## User interface methods
72 @_ == 2 or croak 'usage: $snpp->pager_id( PAGER_ID )';
78 @_ == 2 or croak 'usage: $snpp->content( MESSAGE )';
90 if(exists $arg{Pager})
92 my $pagers = ref($arg{Pager}) ? $arg{Pager} : [ $arg{Pager} ];
94 foreach $pager (@$pagers)
96 $me->_PAGE($pager) || return 0
100 $me->_MESS($arg{Message}) || return 0
101 if(exists $arg{Message});
103 $me->hold($arg{Hold}) || return 0
104 if(exists $arg{Hold});
106 $me->hold($arg{HoldLocal},1) || return 0
107 if(exists $arg{HoldLocal});
109 $me->_COVE($arg{Coverage}) || return 0
110 if(exists $arg{Coverage});
112 $me->_ALER($arg{Alert} ? 1 : 0) || return 0
113 if(exists $arg{Alert});
115 $me->service_level($arg{ServiceLevel}) || return 0
116 if(exists $arg{ServiceLevel});
126 my $ok = $me->_DATA() && $me->datasend(@_);
136 @_ == 2 || @_ == 3 or croak 'usage: $snpp->login( USER [, PASSWORD ])';
142 @_ == 1 or croak 'usage: $snpp->help()';
145 return $me->_HELP() ? $me->message
151 @_ == 1 or croak 'usage: $snpp->xwho()';
154 $me->_XWHO or return undef;
157 my @msg = $me->message;
158 pop @msg; # Remove command complete line
160 foreach $line (@msg) {
161 $line =~ /^\s*(\S+)\s*(.*)/ and $hash{$1} = $2;
169 @_ == 2 or croak 'usage: $snpp->service_level( LEVEL )';
171 my $level = int(shift);
173 if($level < 0 || $level > 11)
175 $me->set_status(550,"Invalid Service Level");
184 @_ == 1 || @_ == 2 or croak 'usage: $snpp->alert( VALUE )';
186 my $value = (@_ == 1 || shift) ? 1 : 0;
193 @_ == 1 or croak 'usage: $snpp->coverage( AREA )';
199 @_ == 2 || @_ == 3 or croak 'usage: $snpp->hold( TIME [, LOCAL ] )';
202 my $local = (shift) ? "" : " +0000";
204 my @g = reverse((gmtime($time))[0..5]);
208 $me->_HOLD( sprintf("%02d%02d%02d%02d%02d%02d%s",@g,$local));
213 @_ == 2 or croak 'usage: $snpp->caller_id( CALLER_ID )';
219 @_ == 2 or croak 'usage: $snpp->subject( SUBJECT )';
225 @_ == 1 or croak 'usage: $snpp->two_way()';
231 @_ == 1 or croak 'usage: $snpp->quit()';
245 defined(fileno($snpp)) && $snpp->quit
249 ## Over-ride methods (Net::Cmd)
254 $_[2] =~ s/^((logi|page)\s+\S+\s+)\S+/$1 xxxx/io;
261 unless $_[1] =~ s/^(\d\d\d)(.?)//o;
262 my($code,$more) = ($1, $2 eq "-");
264 $more ||= $code == 214;
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",@_) }
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 }
296 sub _XWHO { shift->command("XWHO")->response() == CMD_OK }
303 Net::SNPP - Simple Network Pager Protocol Client
310 $snpp = Net::SNPP->new('snpphost');
311 $snpp = Net::SNPP->new('snpphost', Timeout => 60);
315 This module is not complete, yet !
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.
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.
328 This example will send a pager message in one hour saying "Your lunch is ready"
330 #!/usr/local/bin/perl -w
334 $snpp = Net::SNPP->new('snpphost');
336 $snpp->send( Pager => $some_pager_number,
337 Message => "Your lunch is ready",
339 Hold => time + 3600, # lunch ready in 1 hour :-)
340 ) || die $snpp->message;
348 =item new ( [ HOST, ] [ OPTIONS ] )
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.
353 If C<HOST> is not given, then the C<SNPP_Host> specified in C<Net::Config>
356 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
357 Possible options are:
359 B<Timeout> - Maximum time, in seconds, to wait for a response from the
360 SNPP server (default: 120)
362 B<Debug> - Enable debugging information
368 $snpp = Net::SNPP->new('snpphost',
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
385 Request help text from the server. Returns the text or undef upon failure
389 Send the QUIT command to the remote SNPP server and close the socket connection.
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>.
406 Graham Barr <gbarr@pobox.com>
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.