AIS-client
view release on metacpan or search on metacpan
# 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: $!";
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/';
$agent = $params{agent} ||
"http$ssl_ext://$ENV{SERVER_NAME}$ENV{SCRIPT_NAME}";
$SessionPrefix = $params{prefix} || 'AIS'; # 'AIS_session';
eval{
tie %Sessions => DirDB => "${SessionPrefix}_sessions";
};
if($@){
print <<EOF;
Content-Type: text/plain
AIS::client module was not able to open DirDB [${SessionPrefix}_sessions]
eval result:
$@
AIS::client version $VERSION
EOF
exit;
};
if($freq){
housekeeping unless ($$ % $freq)
};
if ($ENV{QUERY_STRING} eq 'LOGOUT'){
# eval <<'LOGOUT';
($Coo) = ($ENV{HTTP_COOKIE} =~ /${SessionPrefix}_session=(\w+)/)
and delete $Sessions{$Coo};
print <<EOF;
Set-Cookie:/${SessionPrefix}_session=
Content-Type: text/html
<html><head><title> LOGGED OUT </title></head>
<body bgcolor=ffffff>
if($Coo){
# print "Content-Type: text/plain\n\n";
# print "We have a cookie: $Coo\n";
# print( %{$Sessions{$Coo}});
# exit;
# Do we have an identity?
if (exists($Sessions{$Coo}->{identity}) and $Sessions{$Coo}->{identity} ne 'ERROR'){
# most of the time, this is what we are expecting
goto HAVE_ID ; # unless $Sessions{$Coo}->{identity} eq 'ERROR';
}else{
# eval <<'NOIDENTITYEVAL';
# get an identity from the AIS server
# (process might be underway already)
if ($ENV{QUERY_STRING} =~ /^OTU_KEY=(\w+)/){
# eval <<'HAVEOTUKEYEVAL';
my $OTUkey = $1;
# carp "have aissri [$aissri]";
my ($method, $host, $port, $path) =
($aissri =~ m#^(\w+)://([^:/]+):?(\d*)(.+)$#)
or die "Could not get meth,hos,por,pat from aissri <$aissri>";
# carp "have \$method, \$host, \$port, \$path $method, $host, $port, $path";
unless ($method eq 'http'){
croak "aissri parameter must begin 'http://' at this time";
};
( run in 1.415 second using v1.01-cache-2.11-cpan-98e64b0badf )