view release on metacpan or  search on metacpan

t/02-generic.t  view on Meta::CPAN

	$connect->send_response($response);
    } elsif($path eq '/show-cookies') {
	my $content = '';

	# find all cookies in headers
	for my $cookie_list ($request->header('Cookie')) {
	    my @cookies = ();
	    for my $cookie (split /;\s*/, $cookie_list) {
		my($name, $value) = split /=/, $cookie;
		push @cookies, [ $name, $value ];
	    }

	    # ensure same order of cookies by sorting them; otherwise
	    # it could return different results for different versions
	    # of Perl
	    @cookies = sort { $a->[0] cmp $b->[0] } @cookies;

	    for my $cookie (@cookies) {
		my($name, $value) = @$cookie;
		$content .= "<$name>=<$value>\n";
	    }
	}

	my $response = new HTTP::Response(RC_OK);
	$response->header(Content_Type => 'text/plain');
	$response->content($content);

	$connect->send_response($response);
    } elsif($path eq '/show-headers') {
	my $content = $request->headers_as_string;

	my $response = new HTTP::Response(RC_OK);
	$response->header(Content_Type => 'text/plain');
	$response->content($content);

	$connect->send_response($response);
    } elsif($path eq '/show-agent') {
	my $content = 'User agent: ' . $request->user_agent;

	my $response = new HTTP::Response(RC_OK);
	$response->header(Content_Type => 'text/plain');
	$response->content($content);

	$connect->send_response($response);
    } elsif($path eq '/redirect') {
	my $response = new HTTP::Response(RC_FOUND);
	$response->header(Location => '/test-file1');

	$connect->send_response($response);
    } elsif($path eq '/redirect-show-cookies') {
	my $response = new HTTP::Response(RC_FOUND);
	$response->header(Location => '/show-cookies');

	$connect->send_response($response);
    } elsif($path =~ m|/auth-(\w+)-(\w+)-(\w+)|) {
	my $realm = $1;
	my $user = $2;
	my $password = $3;

	# check if we have good credentials
	my $credentials = $request->header('Authorization');
	my($user1, $password1) = parse_basic_credentials($credentials);
	if(defined($user1) and defined($password1) and
	   $user eq $user1 and $password eq $password1) {
	    # authorization is ok
	    $connect->send_file_response('t/test1.txt');
	} else {
	    # authorization is either missing or wrong
	    my $response = new HTTP::Response(RC_UNAUTHORIZED);
	    $response->header(WWW_Authenticate => "Basic realm=\"$realm\"");

	    $connect->send_response($response);
	}
    } elsif($path =~ m|/status-code-(\d+)|) {
	my $status_code = $1;

	my $response = new HTTP::Response($status_code);

	$connect->send_response($response);
    } else {
	$connect->send_error(RC_NOT_FOUND);
    }
}