lib/Net/SNPP.pm

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