File Coverage

blib/lib/RAPNAP/client.pm

Criterion	Covered	Total	%
statement	15	36	41.6
branch	0	8	0.0
condition	1	4	25.0
subroutine	5	6	83.3
pod	0	1	0.0
total	21	55	38.1

package RAPNAP::client;

use strict;

use vars qw/$VERSION $key/;

$VERSION = '0.02';

use Socket;
my $eol = "\015\012";
sub rapnap_check{ # RA, PNA, optional Subject Line, optional Target Address
	my ($remote,$port, $iaddr, $paddr, $proto, $line);

        $remote  = 'www.pay2send.com';
        $port    = 80;  # http
        $iaddr   = inet_aton($remote)               || die "no host: $remote";
        $paddr   = sockaddr_in($port, $iaddr);
        $proto   = getprotobyname('tcp');
        socket(SOCK, PF_INET, SOCK_STREAM, $proto)  || die "socket: $!";
        connect(SOCK, $paddr)    || die "connect: $!";
	my $S = select SOCK;
	$| = 1;
	select $S;
	my $query="key=$key&ra=$_[0]&pna=$_[1]";
	$_[2] and $query .= "&sl=$_[2]";
	$_[3] and $query .= "&ta=$_[3]";
	$query =~ s/([^\w\.\=\&])/sprintf('%%%02X',ord($1))/ge;
# print "DEBUG: QUERY: $query\n\n";
	my $length = length $query;

	print SOCK join $eol,
		'POST /cgi/rapnap/check HTTP/1.1',
		'Host: www.pay2send.com',
		"User-Agent: RAPNAP::client $VERSION",
		# 'Transfer-Encoding:',
		'Connection: close',
		"Content-length: $length",
		'',
		$query,
		''
		;

	 my $response = join '', ();

# print "DEBUG: FULL RESPONSE:\n$response\nEND FULL RESPONSE\n\n";

	$response =~ m#Content-Type: \S+\s+([0-9a-fA-F]+)\s+(.+)#s;

	return substr($2,0,hex($1));

};



sub import{

	no strict 'refs';
	*{caller() . '::rapnap_check'} = \&rapnap_check;
	$key = $_[1] || 'ipv4';

};



1;
__END__