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