diff options
Diffstat (limited to 'Net/SNPP.pm')
| -rw-r--r-- | Net/SNPP.pm | 420 |
1 files changed, 0 insertions, 420 deletions
diff --git a/Net/SNPP.pm b/Net/SNPP.pm deleted file mode 100644 index bd2c59a..0000000 --- a/Net/SNPP.pm +++ /dev/null @@ -1,420 +0,0 @@ -# Net::SNPP.pm -# -# Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com>. All rights reserved. -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. - -package Net::SNPP; - -require 5.001; - -use strict; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); -use Socket 1.3; -use Carp; -use IO::Socket; -use Net::Cmd; -use Net::Config; - -$VERSION = "1.11"; # $Id: //depot/libnet/Net/SNPP.pm#7 $ -@ISA = qw(Net::Cmd IO::Socket::INET); -@EXPORT = (qw(CMD_2WAYERROR CMD_2WAYOK CMD_2WAYQUEUED), @Net::Cmd::EXPORT); - -sub CMD_2WAYERROR () { 7 } -sub CMD_2WAYOK () { 8 } -sub CMD_2WAYQUEUED () { 9 } - -sub new -{ - my $self = shift; - my $type = ref($self) || $self; - my $host = shift if @_ % 2; - my %arg = @_; - my $hosts = defined $host ? [ $host ] : $NetConfig{snpp_hosts}; - my $obj; - - my $h; - foreach $h (@{$hosts}) - { - $obj = $type->SUPER::new(PeerAddr => ($host = $h), - PeerPort => $arg{Port} || 'snpp(444)', - Proto => 'tcp', - Timeout => defined $arg{Timeout} - ? $arg{Timeout} - : 120 - ) and last; - } - - return undef - unless defined $obj; - - ${*$obj}{'net_snpp_host'} = $host; - - $obj->autoflush(1); - - $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef); - - unless ($obj->response() == CMD_OK) - { - $obj->close(); - return undef; - } - - $obj; -} - -## -## User interface methods -## - -sub pager_id -{ - @_ == 2 or croak 'usage: $snpp->pager_id( PAGER_ID )'; - shift->_PAGE(@_); -} - -sub content -{ - @_ == 2 or croak 'usage: $snpp->content( MESSAGE )'; - shift->_MESS(@_); -} - -sub send -{ - my $me = shift; - - if(@_) - { - my %arg = @_; - - if(exists $arg{Pager}) - { - my $pagers = ref($arg{Pager}) ? $arg{Pager} : [ $arg{Pager} ]; - my $pager; - foreach $pager (@$pagers) - { - $me->_PAGE($pager) || return 0 - } - } - - $me->_MESS($arg{Message}) || return 0 - if(exists $arg{Message}); - - $me->hold($arg{Hold}) || return 0 - if(exists $arg{Hold}); - - $me->hold($arg{HoldLocal},1) || return 0 - if(exists $arg{HoldLocal}); - - $me->_COVE($arg{Coverage}) || return 0 - if(exists $arg{Coverage}); - - $me->_ALER($arg{Alert} ? 1 : 0) || return 0 - if(exists $arg{Alert}); - - $me->service_level($arg{ServiceLevel}) || return 0 - if(exists $arg{ServiceLevel}); - } - - $me->_SEND(); -} - -sub data -{ - my $me = shift; - - my $ok = $me->_DATA() && $me->datasend(@_); - - return $ok - unless($ok && @_); - - $me->dataend; -} - -sub login -{ - @_ == 2 || @_ == 3 or croak 'usage: $snpp->login( USER [, PASSWORD ])'; - shift->_LOGI(@_); -} - -sub help -{ - @_ == 1 or croak 'usage: $snpp->help()'; - my $me = shift; - - return $me->_HELP() ? $me->message - : undef; -} - -sub xwho -{ - @_ == 1 or croak 'usage: $snpp->xwho()'; - my $me = shift; - - $me->_XWHO or return undef; - - my(%hash,$line); - my @msg = $me->message; - pop @msg; # Remove command complete line - - foreach $line (@msg) { - $line =~ /^\s*(\S+)\s*(.*)/ and $hash{$1} = $2; - } - - \%hash; -} - -sub service_level -{ - @_ == 2 or croak 'usage: $snpp->service_level( LEVEL )'; - my $me = shift; - my $level = int(shift); - - if($level < 0 || $level > 11) - { - $me->set_status(550,"Invalid Service Level"); - return 0; - } - - $me->_LEVE($level); -} - -sub alert -{ - @_ == 1 || @_ == 2 or croak 'usage: $snpp->alert( VALUE )'; - my $me = shift; - my $value = (@_ == 1 || shift) ? 1 : 0; - - $me->_ALER($value); -} - -sub coverage -{ - @_ == 1 or croak 'usage: $snpp->coverage( AREA )'; - shift->_COVE(@_); -} - -sub hold -{ - @_ == 2 || @_ == 3 or croak 'usage: $snpp->hold( TIME [, LOCAL ] )'; - my $me = shift; - my $time = shift; - my $local = (shift) ? "" : " +0000"; - - my @g = reverse((gmtime($time))[0..5]); - $g[1] += 1; - $g[0] %= 100; - - $me->_HOLD( sprintf("%02d%02d%02d%02d%02d%02d%s",@g,$local)); -} - -sub caller_id -{ - @_ == 2 or croak 'usage: $snpp->caller_id( CALLER_ID )'; - shift->_CALL(@_); -} - -sub subject -{ - @_ == 2 or croak 'usage: $snpp->subject( SUBJECT )'; - shift->_SUBJ(@_); -} - -sub two_way -{ - @_ == 1 or croak 'usage: $snpp->two_way()'; - shift->_2WAY(); -} - -sub quit -{ - @_ == 1 or croak 'usage: $snpp->quit()'; - my $snpp = shift; - - $snpp->_QUIT; - $snpp->close; -} - -## -## IO/perl methods -## - -sub DESTROY -{ - my $snpp = shift; - defined(fileno($snpp)) && $snpp->quit -} - -## -## Over-ride methods (Net::Cmd) -## - -sub debug_text -{ - $_[2] =~ s/^((logi|page)\s+\S+\s+)\S+/$1 xxxx/io; - $_[2]; -} - -sub parse_response -{ - return () - unless $_[1] =~ s/^(\d\d\d)(.?)//o; - my($code,$more) = ($1, $2 eq "-"); - - $more ||= $code == 214; - - ($code,$more); -} - -## -## RFC1861 commands -## - -# Level 1 - -sub _PAGE { shift->command("PAGE", @_)->response() == CMD_OK } -sub _MESS { shift->command("MESS", @_)->response() == CMD_OK } -sub _RESE { shift->command("RESE")->response() == CMD_OK } -sub _SEND { shift->command("SEND")->response() == CMD_OK } -sub _QUIT { shift->command("QUIT")->response() == CMD_OK } -sub _HELP { shift->command("HELP")->response() == CMD_OK } -sub _DATA { shift->command("DATA")->response() == CMD_MORE } -sub _SITE { shift->command("SITE",@_) } - -# Level 2 - -sub _LOGI { shift->command("LOGI", @_)->response() == CMD_OK } -sub _LEVE { shift->command("LEVE", @_)->response() == CMD_OK } -sub _ALER { shift->command("ALER", @_)->response() == CMD_OK } -sub _COVE { shift->command("COVE", @_)->response() == CMD_OK } -sub _HOLD { shift->command("HOLD", @_)->response() == CMD_OK } -sub _CALL { shift->command("CALL", @_)->response() == CMD_OK } -sub _SUBJ { shift->command("SUBJ", @_)->response() == CMD_OK } - -# NonStandard - -sub _XWHO { shift->command("XWHO")->response() == CMD_OK } - -1; -__END__ - -=head1 NAME - -Net::SNPP - Simple Network Pager Protocol Client - -=head1 SYNOPSIS - - use Net::SNPP; - - # Constructors - $snpp = Net::SNPP->new('snpphost'); - $snpp = Net::SNPP->new('snpphost', Timeout => 60); - -=head1 NOTE - -This module is not complete, yet ! - -=head1 DESCRIPTION - -This module implements a client interface to the SNPP protocol, enabling -a perl5 application to talk to SNPP servers. This documentation assumes -that you are familiar with the SNPP protocol described in RFC1861. - -A new Net::SNPP object must be created with the I<new> method. Once -this has been done, all SNPP commands are accessed through this object. - -=head1 EXAMPLES - -This example will send a pager message in one hour saying "Your lunch is ready" - - #!/usr/local/bin/perl -w - - use Net::SNPP; - - $snpp = Net::SNPP->new('snpphost'); - - $snpp->send( Pager => $some_pager_number, - Message => "Your lunch is ready", - Alert => 1, - Hold => time + 3600, # lunch ready in 1 hour :-) - ) || die $snpp->message; - - $snpp->quit; - -=head1 CONSTRUCTOR - -=over 4 - -=item new ( [ HOST, ] [ OPTIONS ] ) - -This is the constructor for a new Net::SNPP object. C<HOST> is the -name of the remote host to which a SNPP connection is required. - -If C<HOST> is not given, then the C<SNPP_Host> specified in C<Net::Config> -will be used. - -C<OPTIONS> are passed in a hash like fashion, using key and value pairs. -Possible options are: - -B<Timeout> - Maximum time, in seconds, to wait for a response from the -SNPP server (default: 120) - -B<Debug> - Enable debugging information - - -Example: - - - $snpp = Net::SNPP->new('snpphost', - Debug => 1, - ); - -=back - -=head1 METHODS - -Unless otherwise stated all methods return either a I<true> or I<false> -value, with I<true> meaning that the operation was a success. When a method -states that it returns a value, failure will be returned as I<undef> or an -empty list. - -=over 4 - -=item reset () - -=item help () - -Request help text from the server. Returns the text or undef upon failure - -=item quit () - -Send the QUIT command to the remote SNPP server and close the socket connection. - -=back - -=head1 EXPORTS - -C<Net::SNPP> exports all that C<Net::CMD> exports, plus three more subroutines -that can bu used to compare against the result of C<status>. These are :- -C<CMD_2WAYERROR>, C<CMD_2WAYOK>, and C<CMD_2WAYQUEUED>. - -=head1 SEE ALSO - -L<Net::Cmd> -RFC1861 - -=head1 AUTHOR - -Graham Barr <gbarr@pobox.com> - -=head1 COPYRIGHT - -Copyright (c) 1995-1997 Graham Barr. All rights reserved. -This program is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=for html <hr> - -I<$Id: //depot/libnet/Net/SNPP.pm#7 $> - -=cut |