[p5sagit/p5-mst-13.2.git] / lib / Net / SNPP.pm

# Net::SNPP.pm
#
# Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.ti.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;

=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.

C<OPTIONS> are passed in a hash like fasion, 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,
			  );

=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, falure 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 <Graham.Barr@tiuk.ti.com>

=head1 REVISION

$Revision: 1.1 $
$Date: 1996/07/26 06:49:13 $

The VERSION is derived from the revision by changing each number after the
first dot into a 2 digit number so

	Revision 1.8   => VERSION 1.08
	Revision 1.2.3 => VERSION 1.0203

=head1 COPYRIGHT

Copyright (c) 1995 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.

=cut

require 5.001;

use strict;
use vars qw($VERSION @ISA @EXPORT);
use Socket 1.3;
use Carp;
use IO::Socket;
use Net::Cmd;

$VERSION = do{my @r=(q$Revision: 1.1 $=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r};
@ISA     = qw(Net::Cmd IO::Socket::INET);
@EXPORT  = qw(CMD_2WAYERROR CMD_2WAYOK CMD_2WAYQUEUED);

sub CMD_2WAYERROR  { 7 }
sub CMD_2WAYOK     { 8 }
sub CMD_2WAYQUEUED { 9 }

sub import
{
 my $pkg = shift;
 my $callpkg = caller;
 my @export = ();
 my %export;
 my $export;

 @export{@_} = (1) x @_;

 foreach $export (@EXPORT)
  {
   if(exists $export{$export})
    {
     push(@export,$export);
     delete $export{$export};
    }
  }

 Exporter::export 'Net::SNPP', $callpkg, @export
	if(@_ == 0 || @export);

 @export = keys %export;
 Exporter::export 'Net::Cmd',  $callpkg, @export
	if(@_ == 0 || @export);
}

sub new
{
 my $self = shift;
 my $type = ref($self) || $self;
 my $host = shift;
 my %arg  = @_; 
 my $obj = $type->SUPER::new(PeerAddr => $host, 
			     PeerPort => $arg{Port} || 'snpp(444)',
			     Proto    => 'tcp',
			     Timeout  => defined $arg{Timeout}
						? $arg{Timeout}
						: 120
			    ) or return undef;

 $obj->autoflush(1);

 $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);

 unless ($obj->response() == CMD_OK)
  {
   $obj->SUPER::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 = @_;

   $me->_PAGE($arg{Pager}) || return 0
	if(exists $arg{Pager});

   $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 service_level
{
 @_ == 2 or croak 'usage: $snpp->service_level( LEVEL )';
 my $me = shift;
 my $levl = int(shift);
 my($me,$level) = @_;

 if($level < 0 || $level > 11)
  {
   $me->set_status(550,"Invalid Service Level");
   return 0;
  }

 $me->_LEVE($levl);
}

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 $until = 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 close
{
 my $me = shift;

 return 1
   unless (ref($me) && defined fileno($me));

 $me->_QUIT && $me->SUPER::close;
}

sub DESTROY { shift->close }
sub quit    { shift->close }

##
## Over-ride methods (Net::Cmd)
##

sub debug_text
{
 $_[2] =~ s/^((logi|page)\s+\S+\s+)\S*/$1 xxxx/io;
}

##
## 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 }   

# 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 }   


1;
Commit	Line	Data
7e1af8bc	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;