HTTP-WebTest
view release on metacpan or search on metacpan
lib/HTTP/WebTest/SelfTest.pm view on Meta::CPAN
=cut
use vars qw(@EXPORT $HOSTNAME $PORT $URL);
@EXPORT = qw($HOSTNAME $PORT $URL
abs_url
check_webtest
read_file write_file
generate_testfile canonical_output compare_output
parse_basic_credentials
start_webserver stop_webserver);
use Algorithm::Diff qw(diff);
use MIME::Base64;
use URI;
use HTTP::WebTest::Utils qw(find_port start_webserver stop_webserver);
=head2 $HOSTNAME
lib/HTTP/WebTest/SelfTest.pm view on Meta::CPAN
my @diff = diff([split /\n/, $output1], [split /\n/, $output2]);
for my $hunk (@diff) {
for my $diff_str (@$hunk) {
printf "%s %03d %s\n", @$diff_str;
}
}
}
=head2 parse_basic_credentials($credentials)
Decodes credentials for Basic authorization scheme according RFC2617.
=head3 Returns
Returns user/password pair.
=cut
sub parse_basic_credentials {
my $credentials = shift;
return () unless defined $credentials;
$credentials =~ m|^ \s* Basic \s+ ([A-Za-z0-9+/=]+) \s* $|x;
my $basic_credentials = $1;
return () unless defined $basic_credentials;
my $user_pass = decode_base64($basic_credentials);
my($user, $password) = $user_pass =~ /^ (.*) : (.*) $/x;
return () unless defined $password;
return ($user, $password);
}
=head1 DEPRECATED SUBROUTINES
This module imports in namespace of test script following helper
subroutines but they are deprecated and may be removed in the future
t/02-generic.t view on Meta::CPAN
} 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);
t/03-proxy.t view on Meta::CPAN
return $response;
};
if($path eq '/show-url') {
$connect->send_response($show_url_response->());
} elsif($path =~ m|/pauth-(\w+)-(\w+)-(\w+)|) {
my $realm = $1;
my $user = $2;
my $password = $3;
# check if we have good credentials
my $credentials = $request->header('Proxy-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_response($show_url_response->());
} else {
# authorization is either missing or wrong
# create response object
my $response = new HTTP::Response(RC_PROXY_AUTHENTICATION_REQUIRED);
$response->header(Proxy_Authenticate => "Basic realm=\"$realm\"");
( run in 0.651 second using v1.01-cache-2.11-cpan-4d50c553e7e )