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