home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_ste.zip / Net / SNPP.pm < prev    next >
Text File  |  1997-11-04  |  8KB  |  394 lines
  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.10"; # $Id: //depot/libnet/Net/SNPP.pm#3$
  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 service_level
  150. {
  151.  @_ == 2 or croak 'usage: $snpp->service_level( LEVEL )';
  152.  my $me = shift;
  153.  my $level = int(shift);
  154.  
  155.  if($level < 0 || $level > 11)
  156.   {
  157.    $me->set_status(550,"Invalid Service Level");
  158.    return 0;
  159.   }
  160.  
  161.  $me->_LEVE($level);
  162. }
  163.  
  164. sub alert
  165. {
  166.  @_ == 1 || @_ == 2 or croak 'usage: $snpp->alert( VALUE )';
  167.  my $me = shift;
  168.  my $value  = (@_ == 1 || shift) ? 1 : 0;
  169.  
  170.  $me->_ALER($value);
  171. }
  172.  
  173. sub coverage
  174. {
  175.  @_ == 1 or croak 'usage: $snpp->coverage( AREA )';
  176.  shift->_COVE(@_);
  177. }
  178.  
  179. sub hold
  180. {
  181.  @_ == 2 || @_ == 3 or croak 'usage: $snpp->hold( TIME [, LOCAL ] )';
  182.  my $me = shift;
  183.  my $time = shift;
  184.  my $local = (shift) ? "" : " +0000";
  185.  
  186.  my @g = reverse((gmtime($time))[0..5]);
  187.  $g[1] += 1;
  188.  $g[0] %= 100;
  189.  
  190.  $me->_HOLD( sprintf("%02d%02d%02d%02d%02d%02d%s",@g,$local));
  191. }
  192.  
  193. sub caller_id
  194. {
  195.  @_ == 2 or croak 'usage: $snpp->caller_id( CALLER_ID )';
  196.  shift->_CALL(@_);
  197. }
  198.  
  199. sub subject
  200. {
  201.  @_ == 2 or croak 'usage: $snpp->subject( SUBJECT )';
  202.  shift->_SUBJ(@_);
  203. }
  204.  
  205. sub two_way
  206. {
  207.  @_ == 1 or croak 'usage: $snpp->two_way()';
  208.  shift->_2WAY();
  209. }
  210.  
  211. sub quit
  212. {
  213.  @_ == 1 or croak 'usage: $snpp->quit()';
  214.  my $snpp = shift;
  215.  
  216.  $snpp->_QUIT;
  217.  $snpp->close;
  218. }
  219.  
  220. ##
  221. ## IO/perl methods
  222. ##
  223.  
  224. sub DESTROY
  225. {
  226.  my $snpp = shift;
  227.  defined(fileno($snpp)) && $snpp->quit
  228. }
  229.  
  230. ##
  231. ## Over-ride methods (Net::Cmd)
  232. ##
  233.  
  234. sub debug_text
  235. {
  236.  $_[2] =~ s/^((logi|page)\s+\S+\s+)\S+/$1 xxxx/io;
  237.  $_[2];
  238. }
  239.  
  240. sub parse_response
  241. {
  242.  return ()
  243.     unless $_[1] =~ s/^(\d\d\d)(.?)//o;
  244.  my($code,$more) = ($1, $2 eq "-");
  245.  
  246.  $more ||= $code == 214;
  247.  
  248.  ($code,$more);
  249. }
  250.  
  251. ##
  252. ## RFC1861 commands
  253. ##
  254.  
  255. # Level 1
  256.  
  257. sub _PAGE { shift->command("PAGE", @_)->response()  == CMD_OK }   
  258. sub _MESS { shift->command("MESS", @_)->response()  == CMD_OK }   
  259. sub _RESE { shift->command("RESE")->response()  == CMD_OK }   
  260. sub _SEND { shift->command("SEND")->response()  == CMD_OK }   
  261. sub _QUIT { shift->command("QUIT")->response()  == CMD_OK }   
  262. sub _HELP { shift->command("HELP")->response()  == CMD_OK }   
  263. sub _DATA { shift->command("DATA")->response()  == CMD_MORE }   
  264. sub _SITE { shift->command("SITE",@_) }   
  265.  
  266. # Level 2
  267.  
  268. sub _LOGI { shift->command("LOGI", @_)->response()  == CMD_OK }   
  269. sub _LEVE { shift->command("LEVE", @_)->response()  == CMD_OK }   
  270. sub _ALER { shift->command("ALER", @_)->response()  == CMD_OK }   
  271. sub _COVE { shift->command("COVE", @_)->response()  == CMD_OK }   
  272. sub _HOLD { shift->command("HOLD", @_)->response()  == CMD_OK }   
  273. sub _CALL { shift->command("CALL", @_)->response()  == CMD_OK }   
  274. sub _SUBJ { shift->command("SUBJ", @_)->response()  == CMD_OK }   
  275.  
  276.  
  277. 1;
  278. __END__
  279.  
  280. =head1 NAME
  281.  
  282. Net::SNPP - Simple Network Pager Protocol Client
  283.  
  284. =head1 SYNOPSIS
  285.  
  286.     use Net::SNPP;
  287.     
  288.     # Constructors
  289.     $snpp = Net::SNPP->new('snpphost');
  290.     $snpp = Net::SNPP->new('snpphost', Timeout => 60);
  291.  
  292. =head1 NOTE
  293.  
  294. This module is not complete, yet !
  295.  
  296. =head1 DESCRIPTION
  297.  
  298. This module implements a client interface to the SNPP protocol, enabling
  299. a perl5 application to talk to SNPP servers. This documentation assumes
  300. that you are familiar with the SNPP protocol described in RFC1861.
  301.  
  302. A new Net::SNPP object must be created with the I<new> method. Once
  303. this has been done, all SNPP commands are accessed through this object.
  304.  
  305. =head1 EXAMPLES
  306.  
  307. This example will send a pager message in one hour saying "Your lunch is ready"
  308.  
  309.     #!/usr/local/bin/perl -w
  310.     
  311.     use Net::SNPP;
  312.     
  313.     $snpp = Net::SNPP->new('snpphost');
  314.     
  315.     $snpp->send( Pager   => $some_pager_number,
  316.              Message => "Your lunch is ready",
  317.              Alert   => 1,
  318.              Hold    => time + 3600, # lunch ready in 1 hour :-)
  319.            ) || die $snpp->message;
  320.     
  321.     $snpp->quit;
  322.  
  323. =head1 CONSTRUCTOR
  324.  
  325. =over 4
  326.  
  327. =item new ( [ HOST, ] [ OPTIONS ] )
  328.  
  329. This is the constructor for a new Net::SNPP object. C<HOST> is the
  330. name of the remote host to which a SNPP connection is required.
  331.  
  332. If C<HOST> is not given, then the C<SNPP_Host> specified in C<Net::Config>
  333. will be used.
  334.  
  335. C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
  336. Possible options are:
  337.  
  338. B<Timeout> - Maximum time, in seconds, to wait for a response from the
  339. SNPP server (default: 120)
  340.  
  341. B<Debug> - Enable debugging information
  342.  
  343.  
  344. Example:
  345.  
  346.  
  347.     $snpp = Net::SNPP->new('snpphost',
  348.                Debug => 1,
  349.               );
  350.  
  351. =head1 METHODS
  352.  
  353. Unless otherwise stated all methods return either a I<true> or I<false>
  354. value, with I<true> meaning that the operation was a success. When a method
  355. states that it returns a value, failure will be returned as I<undef> or an
  356. empty list.
  357.  
  358. =over 4
  359.  
  360. =item reset ()
  361.  
  362. =item help ()
  363.  
  364. Request help text from the server. Returns the text or undef upon failure
  365.  
  366. =item quit ()
  367.  
  368. Send the QUIT command to the remote SNPP server and close the socket connection.
  369.  
  370. =back
  371.  
  372. =head1 EXPORTS
  373.  
  374. C<Net::SNPP> exports all that C<Net::CMD> exports, plus three more subroutines
  375. that can bu used to compare against the result of C<status>. These are :-
  376. C<CMD_2WAYERROR>, C<CMD_2WAYOK>, and C<CMD_2WAYQUEUED>.
  377.  
  378. =head1 SEE ALSO
  379.  
  380. L<Net::Cmd>
  381. RFC1861
  382.  
  383. =head1 AUTHOR
  384.  
  385. Graham Barr <gbarr@pobox.com>
  386.  
  387. =head1 COPYRIGHT
  388.  
  389. Copyright (c) 1995-1997 Graham Barr. All rights reserved.
  390. This program is free software; you can redistribute it and/or modify
  391. it under the same terms as Perl itself.
  392.  
  393. =cut
  394.