Add REST test (#1398)
Xavier Guimard
7 years ago
parent
1d02a9e443
commit
90b2df9b0d
@ -0,0 +1,340 @@ |
||||
package LWP::Protocol::PSGI; |
||||
|
||||
use strict; |
||||
use 5.008_001; |
||||
our $VERSION = '0.10'; |
||||
|
||||
use parent qw(LWP::Protocol); |
||||
use HTTP::Message::PSGI qw( req_to_psgi res_from_psgi ); |
||||
use Carp; |
||||
|
||||
my @protocols = qw( http https ); |
||||
my %orig; |
||||
|
||||
my @apps; |
||||
|
||||
sub register { |
||||
my $class = shift; |
||||
|
||||
my $app = LWP::Protocol::PSGI::App->new(@_); |
||||
unshift @apps, $app; |
||||
|
||||
# register this guy (as well as saving original code) once |
||||
if (! scalar keys %orig) { |
||||
for my $proto (@protocols) { |
||||
if (my $orig = LWP::Protocol::implementor($proto)) { |
||||
$orig{$proto} = $orig; |
||||
LWP::Protocol::implementor($proto, $class); |
||||
} else { |
||||
Carp::carp("LWP::Protocol::$proto is unavailable. Skip registering overrides for it.") if $^W; |
||||
} |
||||
} |
||||
} |
||||
|
||||
if (defined wantarray) { |
||||
return LWP::Protocol::PSGI::Guard->new(sub { |
||||
$class->unregister_app($app); |
||||
}); |
||||
} |
||||
} |
||||
|
||||
sub unregister_app { |
||||
my ($class, $app) = @_; |
||||
|
||||
my $i = 0; |
||||
foreach my $stored_app (@apps) { |
||||
if ($app == $stored_app) { |
||||
splice @apps, $i, 1; |
||||
return; |
||||
} |
||||
$i++; |
||||
} |
||||
} |
||||
|
||||
|
||||
sub unregister { |
||||
my $class = shift; |
||||
for my $proto (@protocols) { |
||||
if ($orig{$proto}) { |
||||
LWP::Protocol::implementor($proto, $orig{$proto}); |
||||
} |
||||
} |
||||
@apps = (); |
||||
} |
||||
|
||||
sub request { |
||||
my($self, $request, $proxy, $arg, @rest) = @_; |
||||
|
||||
if (my $app = $self->handles($request)) { |
||||
my $env = req_to_psgi $request; |
||||
my $response = res_from_psgi $app->app->($env); |
||||
my $content = $response->content; |
||||
$response->content(''); |
||||
$self->collect_once($arg, $response, $content); |
||||
} else { |
||||
$orig{$self->{scheme}}->new($self->{scheme}, $self->{ua})->request($request, $proxy, $arg, @rest); |
||||
} |
||||
} |
||||
|
||||
# for testing |
||||
sub create { |
||||
my $class = shift; |
||||
push @apps, LWP::Protocol::PSGI::App->new(@_); |
||||
$class->new; |
||||
} |
||||
|
||||
sub handles { |
||||
my($self, $request) = @_; |
||||
|
||||
foreach my $app (@apps) { |
||||
if ($app->match($request)) { |
||||
return $app; |
||||
} |
||||
} |
||||
} |
||||
|
||||
package |
||||
LWP::Protocol::PSGI::Guard; |
||||
use strict; |
||||
|
||||
sub new { |
||||
my($class, $code) = @_; |
||||
bless $code, $class; |
||||
} |
||||
|
||||
sub DESTROY { |
||||
my $self = shift; |
||||
$self->(); |
||||
} |
||||
|
||||
package |
||||
LWP::Protocol::PSGI::App; |
||||
use strict; |
||||
|
||||
sub new { |
||||
my ($class, $app, %options) = @_; |
||||
bless { app => $app, options => \%options }, $class; |
||||
} |
||||
|
||||
sub app { $_[0]->{app} } |
||||
sub options { $_[0]->{options} } |
||||
sub match { |
||||
my ($self, $request) = @_; |
||||
my $options = $self->options; |
||||
|
||||
if ($options->{host}) { |
||||
my $matcher = $self->_matcher($options->{host}); |
||||
$matcher->($request->uri->host) || $matcher->($request->uri->host_port); |
||||
} elsif ($options->{uri}) { |
||||
$self->_matcher($options->{uri})->($request->uri); |
||||
} else { |
||||
1; |
||||
} |
||||
} |
||||
|
||||
sub _matcher { |
||||
my($self, $stuff) = @_; |
||||
if (ref $stuff eq 'Regexp') { |
||||
sub { $_[0] =~ $stuff }; |
||||
} elsif (ref $stuff eq 'CODE') { |
||||
$stuff; |
||||
} elsif (!ref $stuff) { |
||||
sub { $_[0] eq $stuff }; |
||||
} else { |
||||
Carp::croak("Don't know how to match: ", ref $stuff); |
||||
} |
||||
} |
||||
|
||||
1; |
||||
__END__ |
||||
|
||||
=encoding utf-8 |
||||
|
||||
=for stopwords |
||||
|
||||
=head1 NAME |
||||
|
||||
LWP::Protocol::PSGI - Override LWP's HTTP/HTTPS backend with your own PSGI application |
||||
|
||||
=head1 SYNOPSIS |
||||
|
||||
use LWP::UserAgent; |
||||
use LWP::Protocol::PSGI; |
||||
|
||||
# $app can be any PSGI application: Mojolicious, Catalyst or your own |
||||
my $app = do { |
||||
use Dancer; |
||||
set apphandler => 'PSGI'; |
||||
get '/search' => sub { |
||||
return 'searching for ' . params->{q}; |
||||
}; |
||||
dance; |
||||
}; |
||||
|
||||
# Register the $app to handle all LWP requests |
||||
LWP::Protocol::PSGI->register($app); |
||||
|
||||
# can hijack any code or module that uses LWP::UserAgent underneath, with no changes |
||||
my $ua = LWP::UserAgent->new; |
||||
my $res = $ua->get("http://www.google.com/search?q=bar"); |
||||
print $res->content; # "searching for bar" |
||||
|
||||
# Only hijacks specific host (and port) |
||||
LWP::Protocol::PSGI->register($psgi_app, host => 'localhost:3000'); |
||||
|
||||
my $ua = LWP::UserAgent->new; |
||||
$ua->get("http://localhost:3000/app"); # this routes $app |
||||
$ua->get("http://google.com/api"); # this doesn't - handled with actual HTTP requests |
||||
|
||||
=head1 DESCRIPTION |
||||
|
||||
LWP::Protocol::PSGI is a module to hijack B<any> code that uses |
||||
L<LWP::UserAgent> underneath such that any HTTP or HTTPS requests can |
||||
be routed to your own PSGI application. |
||||
|
||||
Because it works with any code that uses LWP, you can override various |
||||
WWW::*, Net::* or WebService::* modules such as L<WWW::Mechanize>, |
||||
without modifying the calling code or its internals. |
||||
|
||||
use WWW::Mechanize; |
||||
use LWP::Protocol::PSGI; |
||||
|
||||
LWP::Protocol::PSGI->register($my_psgi_app); |
||||
|
||||
my $mech = WWW::Mechanize->new; |
||||
$mech->get("http://amazon.com/"); # $my_psgi_app runs |
||||
|
||||
=head1 TESTING |
||||
|
||||
This module is extremely handy if you have tests that run HTTP |
||||
requests against your application and want them to work with both |
||||
internal and external instances. |
||||
|
||||
# in your .t file |
||||
use Test::More; |
||||
use LWP::UserAgent; |
||||
|
||||
unless ($ENV{TEST_LIVE}) { |
||||
require LWP::Protocol::PSGI; |
||||
my $app = Plack::Util::load_psgi("app.psgi"); |
||||
LWP::Protocol::PSGI->register($app); |
||||
} |
||||
|
||||
my $ua = LWP::UserAgent->new; |
||||
my $res = $ua->get("http://myapp.example.com/"); |
||||
is $res->code, 200; |
||||
like $res->content, qr/Hello/; |
||||
|
||||
This test script will by default route all HTTP requests to your own |
||||
PSGI app defined in C<$app>, but with the environment variable |
||||
C<TEST_LIVE> set, runs the requests against the live server. |
||||
|
||||
You can also combine L<Plack::App::Proxy> with L<LWP::Protocol::PSGI> |
||||
to route all requests made in your test aginst a specific server. |
||||
|
||||
use LWP::Protocol::PSGI; |
||||
use Plack::App::Proxy; |
||||
|
||||
my $app = Plack::App::Proxy->new(remote => "http://testapp.local:3000")->to_app; |
||||
LWP::Protocol::PSGI->register($app); |
||||
|
||||
my $ua = LWP::UserAgent->new; |
||||
my $res = $ua->request("http://testapp.com"); # this hits testapp.local:3000 |
||||
|
||||
=head1 METHODS |
||||
|
||||
=over 4 |
||||
|
||||
=item register |
||||
|
||||
LWP::Protocol::PSGI->register($app, %options); |
||||
my $guard = LWP::Protocol::PSGI->register($app, %options); |
||||
|
||||
Registers an override hook to hijack HTTP requests. If called in a |
||||
non-void context, returns a guard object that automatically resets |
||||
the override when it goes out of context. |
||||
|
||||
{ |
||||
my $guard = LWP::Protocol::PSGI->register($app); |
||||
# hijack the code using LWP with $app |
||||
} |
||||
|
||||
# now LWP uses the original HTTP implementations |
||||
|
||||
When C<%options> is specified, the option limits which URL and hosts |
||||
this handler overrides. You can either pass C<host> or C<uri> to match |
||||
requests, and if it doesn't match, the handler falls back to the |
||||
original LWP HTTP protocol implementor. |
||||
|
||||
LWP::Protocol::PSGI->register($app, host => 'www.google.com'); |
||||
LWP::Protocol::PSGI->register($app, host => qr/\.google\.com$/); |
||||
LWP::Protocol::PSGI->register($app, uri => sub { my $uri = shift; ... }); |
||||
|
||||
The options can take either a string, where it does a complete match, a |
||||
regular expression or a subroutine reference that returns boolean |
||||
given the value of C<host> (only the hostname) or C<uri> (the whole |
||||
URI, including query parameters). |
||||
|
||||
=item unregister |
||||
|
||||
LWP::Protocol::PSGI->unregister; |
||||
|
||||
Resets all the overrides for LWP. If you use the guard interface |
||||
described above, it will be automatically called for you. |
||||
|
||||
=back |
||||
|
||||
=head1 DIFFERENCES WITH OTHER MODULES |
||||
|
||||
=head2 Mock vs Protocol handlers |
||||
|
||||
There are similar modules on CPAN that allows you to emulate LWP |
||||
requests and responses. Most of them are implemented as a mock |
||||
library, which means it doesn't go through the LWP guts and just gives |
||||
you a wrapper for receiving HTTP::Request and returning HTTP::Response |
||||
back. |
||||
|
||||
LWP::Protocol::PSGI is implemented as an LWP protocol handler and it |
||||
allows you to use most of the LWP extensions to add capabilities such |
||||
as manipulating headers and parsing cookies. |
||||
|
||||
=head2 Test::LWP::UserAgent |
||||
|
||||
L<Test::LWP::UserAgent> has the similar concept of overriding LWP |
||||
request method with particular PSGI applications. It has more features |
||||
and options such as passing through the requests to the native LWP |
||||
handler, while LWP::Protocol::PSGI only allows to map certain hosts |
||||
and ports. |
||||
|
||||
Test::LWP::UserAgent requires you to change the instantiation of |
||||
UserAgent from C<< LWP::UserAgent->new >> to C<< |
||||
Test::LWP::UserAgent->new >> somehow and it's your responsibility to |
||||
do so. This mechanism gives you more control which requests should go |
||||
through the PSGI app, and it might not be difficult if the creation is |
||||
done in one place in your code base. However it might be hard or even |
||||
impossible when you are dealing with third party modules that calls |
||||
LWP::UserAgent inside. |
||||
|
||||
LWP::Protocol::PSGI affects the LWP calling code more globally, while |
||||
having an option to enable it only in a specific block, thus there's |
||||
no need to change the UserAgent object manually, whether it is in your |
||||
code or CPAN modules. |
||||
|
||||
=head1 AUTHOR |
||||
|
||||
Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt> |
||||
|
||||
=head1 COPYRIGHT |
||||
|
||||
Copyright 2011- Tatsuhiko Miyagawa |
||||
|
||||
=head1 LICENSE |
||||
|
||||
This library is free software; you can redistribute it and/or modify |
||||
it under the same terms as Perl itself. |
||||
|
||||
=head1 SEE ALSO |
||||
|
||||
L<Plack::Client> L<LWP::UserAgent> |
||||
|
||||
=cut |
||||
@ -0,0 +1,80 @@ |
||||
use Test::More; |
||||
use strict; |
||||
use IO::String; |
||||
use LWP::UserAgent; |
||||
use inc::LWP::Protocol::PSGI; |
||||
use Plack::Request; |
||||
|
||||
require 't/test-lib.pm'; |
||||
my $maintests = 4; |
||||
|
||||
LWP::Protocol::PSGI->register( |
||||
sub { |
||||
my $req = Plack::Request->new(@_); |
||||
if ( $req->path_info eq '/init' ) { |
||||
ok( $req->content eq '{"name":"dwho"}', ' Init req gives dwho' ) |
||||
or explain( $req->content, '{"name":"dwho"}' ); |
||||
} |
||||
elsif ( $req->path_info eq '/vrfy' ) { |
||||
ok( $req->content eq '{"code":"1234"}', ' Code is 1234' ) |
||||
or explain( $req->content, '{"code":"1234"}' ); |
||||
} |
||||
else { |
||||
fail( ' Bad REST call ' . $req->path_info ); |
||||
} |
||||
return [ |
||||
200, |
||||
[ 'Content-Type' => 'application/json', 'Content-Length' => 12 ], |
||||
['{"result":1}'] |
||||
]; |
||||
} |
||||
); |
||||
|
||||
my $client = LLNG::Manager::Test->new( |
||||
{ |
||||
ini => { |
||||
logLevel => 'error', |
||||
rest2fActivation => 1, |
||||
rest2fInitUrl => 'http://auth.example.com/init', |
||||
rest2fInitArgs => { name => 'uid' }, |
||||
rest2fVerifyUrl => 'http://auth.example.com/vrfy', |
||||
rest2fVerifyArgs => { code => 'code' }, |
||||
} |
||||
} |
||||
); |
||||
my $res; |
||||
|
||||
# Try to authenticate |
||||
# ------------------- |
||||
ok( |
||||
$res = $client->_post( |
||||
'/', |
||||
IO::String->new('user=dwho&password=dwho'), |
||||
length => 23, |
||||
accept => 'text/html', |
||||
), |
||||
'Auth query' |
||||
); |
||||
my ( $host, $url, $query ) = |
||||
expectForm( $res, undef, '/rest2fcheck', 'token', 'code' ); |
||||
$query =~ s/code=/code=1234/; |
||||
|
||||
ok( |
||||
$res = $client->_post( |
||||
'/rest2fcheck', |
||||
IO::String->new($query), |
||||
length => length($query), |
||||
), |
||||
'Post code' |
||||
); |
||||
my $id = expectCookie($res); |
||||
$client->logout($id); |
||||
|
||||
#print STDERR Dumper($res); |
||||
|
||||
count($maintests); |
||||
|
||||
clean_sessions(); |
||||
|
||||
done_testing( count() ); |
||||
|
||||
Loading…
Reference in new issue