AIS-client

 view release on metacpan or  search on metacpan

client.pm  view on Meta::CPAN

package AIS::client;

use 5.006;
$VERSION = 0.07;
use Carp;

use DirDB 0.09; # or any other concurrent-access-safe
                # persistence abstraction
	        # that can store and retreive hash references
	        # and has a working DELETE method
	        #
	        # but if you change it, you'll also need to change
	        # the lines that refer to DirDB subsequently,
	        # including the tieing of %{"caller().'::AIS_STASH'}

sub miniget($$$$){
	my($HostName, $PortNumber, $Desired, $agent)  = @_;
	eval <<'ENDMINIGET';
	use Socket qw(:DEFAULT :crlf);
	$PortNumber ||= 80;
	$agent ||= "$ENV{SERVER_NAME}$ENV{SCRIPT_NAME}";
	my $iaddr	= inet_aton($HostName)	|| die "Cannot find host named $HostName";
	my $paddr	= sockaddr_in($PortNumber,$iaddr);
	my $proto	= getprotobyname('tcp');

	socket(SOCK, PF_INET, SOCK_STREAM, $proto)  || die "socket: $!";
	connect(SOCK, $paddr)    || die "connect: $!";

	# SOCK->autoflush(1);
	my $ofh = select SOCK;
	$| = 1;
	select $ofh;
	my $Query = join("\r\n", # "CRLF"
		"GET $Desired HTTP/1.1",
		# Do we need a Host: header with an "AbsoluteURI?"
		# not needed: http://www.w3.org/Protocols/rfc2616/rfc2616-sec5.html#sec5.2
		# but this is trumped by an Apache error message invoking RFC2068 sections 9 and 14.23
		"Host: $HostName",
		"User-Agent: $agent",
		"Connection: close",
		'','') ;
	print SOCK $Query  or croak "could not print to miniget socket";

	 join('',<SOCK>);

ENDMINIGET

}

sub housekeeping(){

	my @deletia;
	my $t = time;

	while(($k,$v) = each %Sessions){

		if ($v->{last_access} < ($t - $maxage)){
			push @deletia, $k
		};
	};

	@Sessions{@deletia} = ();
};

sub redirect($){
	print <<EOF;
Location: $_[0]
Content-Type: text/html

<HTML><HEAD><TITLE>Relocate </TITLE>
<META HTTP-EQUIV="REFRESH" CONTENT="1;URL=$_[0]">
</HEAD>
<BODY>
<A HREF="$_[0]">
<H1>Trying to relocate to $_[0]</H1>please click
here</A>.
</BODY></HTML>

EOF

};

sub import{
	shift;
	my %params = @_;

my $Coo;

 $ssl_ext = exists($ENV{SSL_CIPHER}) ? 's' : '';
 $freq = (defined($params{freq}) ? $params{freq} : 2000);
 $maxage = $params{maxage} || 72*60*60;
 $aissri = $params{aissri} || 'http://www.pay2send.com/cgi/ais/';



( run in 3.170 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )