App-DubiousHTTP

 view release on metacpan or  search on metacpan

lib/App/DubiousHTTP/TestServer.pm  view on Meta::CPAN

use strict;
use warnings;
package App::DubiousHTTP::TestServer;
use Scalar::Util 'weaken';
use Digest::MD5 'md5_base64';
use MIME::Base64 'decode_base64';
use App::DubiousHTTP::Tests::Common qw($TRACKHDR $CLIENTIP ungarble_url);

use IO::Socket::INET;
my $IOCLASS;
BEGIN {
    $IOCLASS = 'IO::Socket::'. ( eval { require IO::Socket::IP } ? 'IP':'INET' );
}

lib/App/DubiousHTTP/TestServer.pm  view on Meta::CPAN

    delete $clients{fileno($cl)};
    $SELECT->delete($cl);
}

sub add_client {
    my ($cl,$response,$sslctx) = @_;
    my $addr = $cl->sockhost.':'.$cl->sockport;
    $DEBUG && _debug("new client from $addr");

    $clients{fileno($cl)}{time} = time();
    weaken( my $wcl = $cl );
    $clients{fileno($cl)}{fd} = $wcl;
    $SELECT->timeout($cl,5,sub { delete_client($wcl) if $wcl });

    return _install_check_https($cl,$response,$sslctx) if $sslctx;
    return _install_http($cl,$response);
}

sub _install_check_https {
    my ($cl,$response,$sslctx) = @_;
    $DEBUG && _debug("add handler for checking https");

lib/App/DubiousHTTP/TestServer.pm  view on Meta::CPAN

	$close = $1 ? 0:1;
	$DEBUG && _debug("set close=$close because of HTTP version in $type");
    } else {
	$close = 1;
	$DEBUG && _debug("set close=$close because no other information are known in $type");
    }
    return $close;
}

package App::DubiousHTTP::TestServer::Select;
use Scalar::Util 'weaken';
use Time::HiRes 'gettimeofday';

my $maxfn = 0;
my @handler;
my @didit;
my @timeout;
my @timer;
my @mask = ('','');
my @tmpmask;
my $now = gettimeofday();

lib/App/DubiousHTTP/TestServer.pm  view on Meta::CPAN

    $handler[$fn] = $didit[$fn] = $timeout[$fn] = $timer[$fn] = undef;
    if ($maxfn == $fn) {
	$maxfn-- while ($maxfn>=0 && !$handler[$maxfn]);
    }
}

sub handler {
    my ($self,$cl,%sub) = @_;
    defined( my $fn = fileno($cl) ) or die "invalid fd";
    $maxfn = $fn if $fn>$maxfn;
    weaken(my $wcl = $cl);
    while (my ($rw,$sub) = each %sub) {
	$sub = [ $sub ] if ref($sub) eq 'CODE';
	splice(@$sub,1,0,$wcl);
	$handler[$fn][$rw] = $sub;
	$DEBUG && _debug("add handler($fn,$rw)");
    }
}

sub timer {
    my ($self,$cl,$to,$cb) = @_;