Skip to content

lemonldap-ng
lemonldap-ng
Commit 5dedd384 authored by Xavier Guimard's avatar Xavier Guimard
Browse files
Options

Test lib is going become base of future Cli.pm

parent 276514f7
Hide whitespace changes
Inline Side-by-side
Showing with 217 additions and 210 deletions
lemonldap-ng-common/lib/Lemonldap/NG/Common/Conf.pm
View file @ 5dedd384
......@@ -203,6 +203,7 @@ sub getConf {
and $r->{useXForwardedForIP} == 1 )
{
$r->{trustedProxies} = '*';
delete $r->{useXForwardedForIP};
}
# Force Choice backend
......
lemonldap-ng-manager/lib/Lemonldap/NG/Manager/Cli/Lib.pm 0 → 100644
View file @ 5dedd384
package Lemonldap::NG::Manager::Cli::Lib;
use JSON::MaybeXS;
use 5.10.0;
use Mouse;
use Lemonldap::NG::Manager;
has iniFile => ( is => 'ro', isa => 'Str', required => 1 );
has app => (
is => 'ro',
isa => 'CodeRef',
builder => sub {
return Lemonldap::NG::Manager->run(
{
configStorage => { confFile => $_[0]->{iniFile} },
protection => 'none',
}
);
}
);
sub get {
my ( $self, $path, $query ) = splice @_;
$query //= '';
return $self->app->(
{
'HTTP_ACCEPT' => 'application/json, text/plain, */*',
'SCRIPT_NAME' => '',
'HTTP_ACCEPT_ENCODING' => 'gzip, deflate',
'SERVER_NAME' => '127.0.0.1',
'QUERY_STRING' => $query,
'HTTP_CACHE_CONTROL' => 'max-age=0',
'HTTP_ACCEPT_LANGUAGE' => 'fr,fr-FR;q=0.8,en-US;q=0.5,en;q=0.3',
'PATH_INFO' => $path,
'REQUEST_METHOD' => 'GET',
'REQUEST_URI' => $path . ( $query ? "?$query" : '' ),
'SERVER_PORT' => '8002',
'SERVER_PROTOCOL' => 'HTTP/1.1',
'HTTP_USER_AGENT' =>
'Mozilla/5.0 (VAX-4000; rv:36.0) Gecko/20350101 Firefox',
'REMOTE_ADDR' => '127.0.0.1',
'HTTP_HOST' => '127.0.0.1:8002'
}
);
}
sub post {
my ( $self, $path, $query, $body, $type, $len ) = splice @_;
die "$body must be a IO::Handle"
unless ( ref($body) and $body->can('read') );
return $self->app->(
{
'HTTP_ACCEPT' => 'application/json, text/plain, */*',
'SCRIPT_NAME' => '',
'HTTP_ACCEPT_ENCODING' => 'gzip, deflate',
'SERVER_NAME' => '127.0.0.1',
'QUERY_STRING' => $query,
'HTTP_CACHE_CONTROL' => 'max-age=0',
'HTTP_ACCEPT_LANGUAGE' => 'fr,fr-FR;q=0.8,en-US;q=0.5,en;q=0.3',
'PATH_INFO' => $path,
'REQUEST_METHOD' => 'POST',
'REQUEST_URI' => $path . ( $query ? "?$query" : '' ),
'SERVER_PORT' => '8002',
'SERVER_PROTOCOL' => 'HTTP/1.1',
'HTTP_USER_AGENT' =>
'Mozilla/5.0 (VAX-4000; rv:36.0) Gecko/20350101 Firefox',
'REMOTE_ADDR' => '127.0.0.1',
'HTTP_HOST' => '127.0.0.1:8002',
'psgix.input.buffered' => 1,
'psgi.input' => $body,
'CONTENT_LENGTH' => $len // scalar( ( stat $body )[7] ),
'CONTENT_TYPE' => $type,
}
);
}
sub put {
my ( $self, $path, $query, $body, $type, $len ) = splice @_;
die "$body must be a IO::Handle"
unless ( ref($body) and $body->can('read') );
return $self->app->(
{
'HTTP_ACCEPT' => 'application/json, text/plain, */*',
'SCRIPT_NAME' => '',
'HTTP_ACCEPT_ENCODING' => 'gzip, deflate',
'SERVER_NAME' => '127.0.0.1',
'QUERY_STRING' => $query,
'HTTP_CACHE_CONTROL' => 'max-age=0',
'HTTP_ACCEPT_LANGUAGE' => 'fr,fr-FR;q=0.8,en-US;q=0.5,en;q=0.3',
'PATH_INFO' => $path,
'REQUEST_METHOD' => 'PUT',
'REQUEST_URI' => $path . ( $query ? "?$query" : '' ),
'SERVER_PORT' => '8002',
'SERVER_PROTOCOL' => 'HTTP/1.1',
'HTTP_USER_AGENT' =>
'Mozilla/5.0 (VAX-4000; rv:36.0) Gecko/20350101 Firefox',
'REMOTE_ADDR' => '127.0.0.1',
'HTTP_HOST' => '127.0.0.1:8002',
'psgix.input.buffered' => 1,
'psgi.input' => $body,
'CONTENT_LENGTH' => $len // scalar( ( stat $body )[7] ),
'CONTENT_TYPE' => $type,
}
);
}
sub del {
my ( $self, $path, $query ) = splice @_;
return $self->app->(
{
'HTTP_ACCEPT' => 'application/json, text/plain, */*',
'SCRIPT_NAME' => '',
'HTTP_ACCEPT_ENCODING' => 'gzip, deflate',
'SERVER_NAME' => '127.0.0.1',
'QUERY_STRING' => $query,
'HTTP_CACHE_CONTROL' => 'max-age=0',
'HTTP_ACCEPT_LANGUAGE' => 'fr,fr-FR;q=0.8,en-US;q=0.5,en;q=0.3',
'PATH_INFO' => $path,
'REQUEST_METHOD' => 'DELETE',
'REQUEST_URI' => $path . ( $query ? "?$query" : '' ),
'SERVER_PORT' => '8002',
'SERVER_PROTOCOL' => 'HTTP/1.1',
'HTTP_USER_AGENT' =>
'Mozilla/5.0 (VAX-4000; rv:36.0) Gecko/20350101 Firefox',
'REMOTE_ADDR' => '127.0.0.1',
'HTTP_HOST' => '127.0.0.1:8002',
}
);
}
sub jsonResponse {
my ( $self, $path, $query ) = splice @_;
my $res = $self->get( $path, $query )
or die "Manager lib has refused my get, aborting";
die "Manager lib does not return a 200 code, aborting"
unless ( $res->[0] == 200 );
my $href = decode_json( $res->[2]->[0] ) or die 'Response is not JSON';
return $href;
}
sub jsonPostResponse {
my ( $self, $path, $query, $body, $type, $len ) = splice @_;
my $res = $self->post( $path, $query, $body, $type, $len )
or die "Manager lib has refused my post, aborting";
die "Manager lib does not return a 200 code, aborting"
unless ( $res->[0] == 200 );
my $href = decode_json( $res->[2]->[0] ) or die 'Response is not JSON';
return $href;
}
sub jsonPutResponse {
my ( $self, $path, $query, $body, $type, $len ) = splice @_;
my $res = $self->put( $path, $query, $body, $type, $len )
or die "Manager lib has refused my put, aborting";
die "Manager lib does not return a 200 code, aborting"
unless ( $res->[0] == 200 );
my $href = decode_json( $res->[2]->[0] ) or die 'Response is not JSON';
return $href;
}
1;
lemonldap-ng-manager/t/02-HTML-template.t
View file @ 5dedd384
......@@ -2,13 +2,12 @@
use Test::More;
use strict;
use 5.10.0;
require 't/test-lib.pm';
my $res;
ok( $res = get('/'), 'Succeed to get /' );
ok( $res = &client->get('/'), 'Succeed to get /' );
my %hdrs = @{ $res->[1] };
ok( $res->[0] == 200, 'Return a 200 code' )
or print STDERR "Received" . Dumper($res);
......
lemonldap-ng-manager/t/03-HTML-forms.t
View file @ 5dedd384
......@@ -2,7 +2,6 @@
use Test::More;
use strict;
use 5.10.0;
my $formDir = 'site/static/forms';
......@@ -22,7 +21,7 @@ delete $forms{restore};
my ( @types, $attr, $tree, $ctrees );
ok( $tree = Lemonldap::NG::Manager::Build::Tree::tree(), 'Get tree' );
ok( $ctrees = Lemonldap::NG::Manager::Build::CTrees::cTrees(), 'Get cTrees' );
ok( $attr = Lemonldap::NG::Manager::Build::Attributes::attributes(),
ok( $attr = Lemonldap::NG::Manager::Build::Attributes::attributes(),
'Get attributes' );
$count += 4;
......
lemonldap-ng-manager/t/05-rest-api.t
View file @ 5dedd384
......@@ -3,7 +3,6 @@
use Test::More;
use JSON::MaybeXS;
use strict;
use 5.10.0;
require 't/test-lib.pm';
my $struct = 'site/static/struct.json';
......@@ -35,11 +34,11 @@ my @good = qw(
);
foreach my $query (@good) {
my $href = jsonResponse($query);
my $href = &client->jsonResponse($query);
}
foreach my $query (@bad) {
my $res = get( $query, '' );
my $res = &client->get( $query, '' );
ok( $res->[0] == 400, "Request reject for $query" )
or print STDERR "# Receive a $res->[0] code";
my $href;
......@@ -64,7 +63,7 @@ ok( ref $hstruct eq 'ARRAY', 'struct.json is an array' );
count(2);
foreach my $query (@hkeys) {
my $href = jsonResponse( "/confs/1/$query", '' );
my $href = &client->jsonResponse( "/confs/1/$query", '' );
ok( ref $href eq 'ARRAY', 'Response is an array' );
count(1);
foreach my $k (@$href) {
......@@ -76,7 +75,7 @@ foreach my $query (@hkeys) {
# Metadatas
{
my $href = jsonResponse( 'confs/1', '' );
my $href = &client->jsonResponse( 'confs/1', '' );
foreach (qw(cfgNum cfgAuthor cfgAuthorIP cfgDate)) {
ok( exists( $href->{$_} ), "Key $_ exists" );
}
......
lemonldap-ng-manager/t/06-rest-api.t
View file @ 5dedd384
#!/usr/bin/env perl
use Test::More;
use 5.10.0;
use strict;
use JSON::MaybeXS;
use IO::String;
......@@ -9,9 +8,9 @@ require 't/test-lib.pm';
my $res;
ok(
$res =
post( '/confs/newRSAKey', '',
IO::String->new(''), 'application/json', 0, ),
$res = &client->post(
'/confs/newRSAKey', '', IO::String->new(''), 'application/json', 0,
),
"Request succeed"
);
ok( $res->[0] == 200, "Result code is 200" );
......@@ -20,7 +19,7 @@ ok( $key = decode_json( $res->[2]->[0] ), 'Response is JSON' );
count(3);
ok(
$res = post(
$res = &client->post(
'/confs/newRSAKey', '', IO::String->new('{"password":"hello"}'),
'application/json', 20,
),
......
lemonldap-ng-manager/t/10-save-unchanged-conf.t
View file @ 5dedd384
#!/usr/bin/env perl -I pl/lib
use Test::More;
use 5.10.0;
use strict;
use JSON::MaybeXS;
use Data::Dumper;
......@@ -25,8 +24,11 @@ eval { unlink $confFiles->[1]; };
while ( my $body = &body() ) {
my $desc = shift @desc;
my ( $res, $resBody );
ok( $res = post( '/confs/', 'cfgNum=1', $body, 'application/json' ),
"$desc: positive result" );
ok(
$res =
&client->post( '/confs/', 'cfgNum=1', $body, 'application/json' ),
"$desc: positive result"
);
ok( $res->[0] == 200, "$desc: result code is 200" );
ok(
$resBody = decode_json( $res->[2]->[0] ),
......
lemonldap-ng-manager/t/12-save-changed-conf.t
View file @ 5dedd384
#!/usr/bin/env perl -I pl/lib
use Test::More;
use 5.10.0;
use strict;
use JSON::MaybeXS;
use Data::Dumper;
......@@ -18,7 +17,7 @@ sub body {
eval { unlink $confFiles->[1]; };
my ( $res, $resBody );
ok( $res = post( '/confs/', 'cfgNum=1', &body, 'application/json' ),
ok( $res = &client->post( '/confs/', 'cfgNum=1', &body, 'application/json' ),
"Request succeed" );
ok( $res->[0] == 200, "Result code is 200" );
ok( $resBody = decode_json( $res->[2]->[0] ),
......
lemonldap-ng-manager/t/40-sessions.t
View file @ 5dedd384
......@@ -3,7 +3,6 @@
use Test::More;
use JSON::MaybeXS;
use strict;
use 5.10.0;
use Lemonldap::NG::Common::Session;
eval { mkdir 't/sessions' };
......@@ -36,13 +35,13 @@ sub newSession {
my @ids;
$ids[0] = newSession( 'dwho', '127.10.0.1' );
$ids[1] = newSession( 'dwho2', '127.2.0.2' );
my $res = jsonResponse("/sessions/global/$ids[0]");
my $res = &client->jsonResponse("/sessions/global/$ids[0]");
ok( ( $res->{uid} and $res->{uid} eq 'dwho' ), 'Uid found' );
ok( ( $res->{ipAddr} and $res->{ipAddr} eq '127.10.0.1' ), 'IP found' );
count(2);
# "All" query
$res = jsonResponse("/sessions/global/");
$res = &client->jsonResponse("/sessions/global/");
ok( $res->{result} == 1, 'Result code = 1' );
ok( $res->{count} == 2, 'Found 2 sessions' );
ok( @{ $res->{values} } == 2, 'List 2 sessions' );
......@@ -52,7 +51,7 @@ ok( $res->{values}->[$_]->{session} =~ /^(?:$ids[0]|$ids[1])$/,
count(5);
# GroupBy query
$res = jsonResponse( '/sessions/global', 'groupBy=substr(uid,1)' );
$res = &client->jsonResponse( '/sessions/global', 'groupBy=substr(uid,1)' );
ok( $res->{result} == 1, 'Result code = 1' );
ok( $res->{count} == 1, 'Found 1 entry' );
ok( $res->{values}->[0]->{value} && $res->{values}->[0]->{value} eq 'd',
......@@ -62,25 +61,25 @@ ok( $res->{values}->[0]->{count} == 2, 'Found 2 sessions starting with "d"' );
count(4);
$ids[2] = newSession( 'foo', '127.3.0.3' );
$res = jsonResponse( '/sessions/global', 'groupBy=substr(uid,1)' );
$res = &client->jsonResponse( '/sessions/global', 'groupBy=substr(uid,1)' );
ok( $res->{count} == 2, 'Found 2 entries' );
count(1);
# Filtered queries
$res = jsonResponse( '/sessions/global', 'uid=d*' );
$res = &client->jsonResponse( '/sessions/global', 'uid=d*' );
ok( $res->{count} == 2, 'Found 2 sessions' );
ok( $res->{values}->[$_]->{session} =~ /^(?:$ids[0]|$ids[1])$/,
'Good session id' )
foreach ( 0 .. 1 );
count(3);
$res = jsonResponse( '/sessions/global', 'uid=f*' );
$res = &client->jsonResponse( '/sessions/global', 'uid=f*' );
ok( $res->{count} == 1, 'Found 1 sessions' );
ok( $res->{values}->[0]->{session} eq $ids[2], 'Good session id' );
count(2);
# DoubleIp
$ids[3] = newSession( 'foo', '127.3.0.4' );
$res = jsonResponse( '/sessions/global', 'doubleIp' );
$res = &client->jsonResponse( '/sessions/global', 'doubleIp' );
ok( $res->{count} == 1, 'Found 1 user' );
ok( $res->{values}->[0]->{value} eq 'foo', 'User is foo' );
ok(
......@@ -90,7 +89,7 @@ ok(
count(4);
# New GroupBy query test with 4 sessions
$res = jsonResponse( '/sessions/global', 'groupBy=uid' );
$res = &client->jsonResponse( '/sessions/global', 'groupBy=uid' );
ok(
(
$res->{values}->[0]->{value} eq 'dwho'
......@@ -115,7 +114,7 @@ ok(
count(3);
# Ordered queries
$res = jsonResponse( '/sessions/global', 'orderBy=uid' );
$res = &client->jsonResponse( '/sessions/global', 'orderBy=uid' );
ok( $res->{values}->[0]->{uid} eq 'dwho', '1st user is dwho' );
ok( $res->{values}->[1]->{uid} eq 'dwho2', '2nd user is dwho2' );
ok( $res->{values}->[2]->{uid} eq 'foo', '3rd user is foo' );
......@@ -123,15 +122,15 @@ ok( $res->{values}->[3]->{uid} eq 'foo', '4rd user is foo' );
count(4);
# IPv4 networks
$res = jsonResponse( '/sessions/global', 'groupBy=net4(ipAddr,1)' );
$res = &client->jsonResponse( '/sessions/global', 'groupBy=net4(ipAddr,1)' );
ok( $res->{count} == 1, 'One A subnet' );
ok( $res->{values}->[0]->{count} == 4, 'All sessions found' );
$res = jsonResponse( '/sessions/global', 'groupBy=net4(ipAddr,2)' );
$res = &client->jsonResponse( '/sessions/global', 'groupBy=net4(ipAddr,2)' );
ok( $res->{count} == 3, 'Three B subnet' );
ok( $res->{values}->[2]->{count} == 2, 'All sessions found' );
count(4);
$res = jsonResponse( '/sessions/global', 'orderBy=net4(ipAddr)' );
$res = &client->jsonResponse( '/sessions/global', 'orderBy=net4(ipAddr)' );
ok( $res->{count} == 4, '4 sessions ordered' );
ok( $res->{values}->[0]->{session} eq $ids[1], '1st is id[1]' );
ok( $res->{values}->[1]->{session} eq $ids[2], '2nd is id[2]' );
......@@ -144,7 +143,7 @@ count(5);
# Delete sessions
foreach (@ids) {
my $res;
ok( $res = del("/sessions/global/$_"), "Delete $_" );
ok( $res = &client->del("/sessions/global/$_"), "Delete $_" );
ok( $res->[0] == 200, 'Result code is 200' );
ok( decode_json( $res->[2]->[0] )->{result} == 1,
'Body is JSON and result==1' );
......
lemonldap-ng-manager/t/50-notifications.t
View file @ 5dedd384
......@@ -2,7 +2,6 @@
use Test::More;
use strict;
use 5.10.0;
use IO::String;
eval { mkdir 't/notifications' };
......@@ -13,7 +12,8 @@ require 't/test-lib.pm';
my $notif =
'{"date":"2015-05-03","uid":"dwho","reference":"Test","xml":"<title>Test</title>"}';
my $res =
jsonPostResponse( 'notifications/actives', '', IO::String->new($notif),
&client->jsonPostResponse( 'notifications/actives', '',
IO::String->new($notif),
'application/json', length($notif) );
ok( $res->{result}, 'Result is true' );
......@@ -24,7 +24,7 @@ displayTests('actives');
# Mark notification as done
$notif = '{"done":1}';
$res = jsonPutResponse(
$res = &client->jsonPutResponse(
'notifications/actives/dwho_Test',
'', IO::String->new($notif),
'application/json', length($notif)
......@@ -32,7 +32,8 @@ $res = jsonPutResponse(
ok( $res->{result} == 1, 'Result = 1' );
# Test that notification is not active now
$res = jsonResponse( 'notifications/actives', 'groupBy=substr(uid,1)' );
$res =
&client->jsonResponse( 'notifications/actives', 'groupBy=substr(uid,1)' );
ok( $res->{result} == 1, 'Result = 1' );
ok( $res->{count} == 0, 'Count = 0' );
count(3);
......@@ -41,8 +42,8 @@ count(3);
displayTests('done');
# Delete notification
$res = del('notifications/done/20150503_dwho_VGVzdA==.done');
$res = jsonResponse( 'notifications/done', 'groupBy=substr(uid,1)' );
$res = &client->del('notifications/done/20150503_dwho_VGVzdA==.done');
$res = &client->jsonResponse( 'notifications/done', 'groupBy=substr(uid,1)' );
ok( $res->{result} == 1, 'Result = 1' );
ok( $res->{count} == 0, 'Count = 0' );
count(2);
......@@ -55,38 +56,39 @@ done_testing( count() );
sub displayTests {
my $type = shift;
$res = jsonResponse( "notifications/$type", 'groupBy=substr(uid,1)' );
$res =
&client->jsonResponse( "notifications/$type", 'groupBy=substr(uid,1)' );
ok( $res->{result} == 1, 'Result = 1' );
ok( $res->{count} == 1, 'Count = 1' );
ok( $res->{values}->[0]->{value} eq 'd', 'Value is "d"' );
count(3);
$res = jsonResponse( "notifications/$type", 'groupBy=uid' );
$res = &client->jsonResponse( "notifications/$type", 'groupBy=uid' );
ok( $res->{result} == 1, 'Result = 1' );
ok( $res->{count} == 1, 'Count = 1' );
ok( $res->{values}->[0]->{value} eq 'dwho', 'Value is "dwho"' );
count(3);
$res = jsonResponse( "notifications/$type", 'uid=d*&groupBy=uid' );
$res = &client->jsonResponse( "notifications/$type", 'uid=d*&groupBy=uid' );
ok( $res->{result} == 1, 'Result = 1' );
ok( $res->{count} == 1, 'Count = 1' );
ok( $res->{values}->[0]->{value} eq 'dwho', 'Value is "dwho"' );
count(3);
$res = jsonResponse( "notifications/$type", 'uid=d*' );
$res = &client->jsonResponse( "notifications/$type", 'uid=d*' );
ok( $res->{result} == 1, 'Result = 1' );
ok( $res->{count} == 1, 'Count = 1' );
ok( $res->{values}->[0]->{uid} eq 'dwho', 'Value is "dwho"' );
count(3);
$res = jsonResponse( "notifications/$type", 'uid=dwho' );
$res = &client->jsonResponse( "notifications/$type", 'uid=dwho' );
ok( $res->{result} == 1, 'Result = 1' );
ok( $res->{count} == 1, 'Count = 1' );
ok( $res->{values}->[0]->{uid} eq 'dwho', 'Value is "dwho"' );
count(3);
if ( $type eq 'actives' ) {
$res = jsonResponse( "notifications/$type/dwho_Test", '' );
$res = &client->jsonResponse( "notifications/$type/dwho_Test", '' );
ok( $res->{result} == 1, 'Result = 1' );
ok( $res->{count} == 1, 'Count = 1' );
ok( $res->{notifications}->[0] =~ /^<\?xml/, 'Response is XML' );
......
lemonldap-ng-manager/t/90-translations.t
View file @ 5dedd384
......@@ -3,7 +3,6 @@
use Test::More;
use JSON::MaybeXS;
use strict;
use 5.10.0;
my $langDir = 'site/static/languages';
......
lemonldap-ng-manager/t/test-lib.pm
View file @ 5dedd384
# Common tests lib
# Base library for tests
use JSON::MaybeXS;
use strict;
use 5.10.0;
use Data::Dumper;
use_ok('Lemonldap::NG::Manager::Cli::Lib');
use_ok('Lemonldap::NG::Manager');
my $app;
our $client;
ok(
$app = Lemonldap::NG::Manager->run(
{
configStorage => { confFile => 't/lemonldap-ng.ini' },
protection => 'none',
}
),
'New app'
$client =
Lemonldap::NG::Manager::Cli::Lib->new( iniFile => 't/lemonldap-ng.ini' ),
'Client object'
);
ok( ref($app) eq 'CODE', 'app is a subroutine' );
sub client {
return $client;
}
our $count = 3;
our $count = 2;
sub count {
my $c = shift;
......@@ -28,153 +24,4 @@ sub count {
return $count;
}
sub get {
my ( $path, $query ) = splice @_;
$query //= '';
return $app->(
{
'HTTP_ACCEPT' => 'application/json, text/plain, */*',
'SCRIPT_NAME' => '',
'HTTP_ACCEPT_ENCODING' => 'gzip, deflate',
'SERVER_NAME' => '127.0.0.1',
'QUERY_STRING' => $query,
'HTTP_CACHE_CONTROL' => 'max-age=0',
'HTTP_ACCEPT_LANGUAGE' => 'fr,fr-FR;q=0.8,en-US;q=0.5,en;q=0.3',
'PATH_INFO' => $path,
'REQUEST_METHOD' => 'GET',
'REQUEST_URI' => $path . ( $query ? "?$query" : '' ),
'SERVER_PORT' => '8002',
'SERVER_PROTOCOL' => 'HTTP/1.1',
'HTTP_USER_AGENT' =>
'Mozilla/5.0 (VAX-4000; rv:36.0) Gecko/20350101 Firefox',
'REMOTE_ADDR' => '127.0.0.1',
'HTTP_HOST' => '127.0.0.1:8002'
}
);
}
sub post {
my ( $path, $query, $body, $type, $len ) = splice @_;
die "$body must be a IO::Handle"
unless ( ref($body) and $body->can('read') );
return $app->(
{
'HTTP_ACCEPT' => 'application/json, text/plain, */*',
'SCRIPT_NAME' => '',
'HTTP_ACCEPT_ENCODING' => 'gzip, deflate',
'SERVER_NAME' => '127.0.0.1',
'QUERY_STRING' => $query,
'HTTP_CACHE_CONTROL' => 'max-age=0',
'HTTP_ACCEPT_LANGUAGE' => 'fr,fr-FR;q=0.8,en-US;q=0.5,en;q=0.3',
'PATH_INFO' => $path,
'REQUEST_METHOD' => 'POST',
'REQUEST_URI' => $path . ( $query ? "?$query" : '' ),
'SERVER_PORT' => '8002',
'SERVER_PROTOCOL' => 'HTTP/1.1',
'HTTP_USER_AGENT' =>
'Mozilla/5.0 (VAX-4000; rv:36.0) Gecko/20350101 Firefox',
'REMOTE_ADDR' => '127.0.0.1',
'HTTP_HOST' => '127.0.0.1:8002',
'psgix.input.buffered' => 1,
'psgi.input' => $body,
'CONTENT_LENGTH' => $len // scalar( ( stat $body )[7] ),
'CONTENT_TYPE' => $type,
}
);
}
sub put {
my ( $path, $query, $body, $type, $len ) = splice @_;
die "$body must be a IO::Handle"
unless ( ref($body) and $body->can('read') );
return $app->(
{
'HTTP_ACCEPT' => 'application/json, text/plain, */*',
'SCRIPT_NAME' => '',
'HTTP_ACCEPT_ENCODING' => 'gzip, deflate',
'SERVER_NAME' => '127.0.0.1',
'QUERY_STRING' => $query,
'HTTP_CACHE_CONTROL' => 'max-age=0',
'HTTP_ACCEPT_LANGUAGE' => 'fr,fr-FR;q=0.8,en-US;q=0.5,en;q=0.3',
'PATH_INFO' => $path,
'REQUEST_METHOD' => 'PUT',
'REQUEST_URI' => $path . ( $query ? "?$query" : '' ),
'SERVER_PORT' => '8002',
'SERVER_PROTOCOL' => 'HTTP/1.1',
'HTTP_USER_AGENT' =>
'Mozilla/5.0 (VAX-4000; rv:36.0) Gecko/20350101 Firefox',
'REMOTE_ADDR' => '127.0.0.1',
'HTTP_HOST' => '127.0.0.1:8002',
'psgix.input.buffered' => 1,
'psgi.input' => $body,
'CONTENT_LENGTH' => $len // scalar( ( stat $body )[7] ),
'CONTENT_TYPE' => $type,
}
);
}
sub del {
my ( $path, $query ) = splice @_;
return $app->(
{
'HTTP_ACCEPT' => 'application/json, text/plain, */*',
'SCRIPT_NAME' => '',
'HTTP_ACCEPT_ENCODING' => 'gzip, deflate',
'SERVER_NAME' => '127.0.0.1',
'QUERY_STRING' => $query,
'HTTP_CACHE_CONTROL' => 'max-age=0',
'HTTP_ACCEPT_LANGUAGE' => 'fr,fr-FR;q=0.8,en-US;q=0.5,en;q=0.3',
'PATH_INFO' => $path,
'REQUEST_METHOD' => 'DELETE',
'REQUEST_URI' => $path . ( $query ? "?$query" : '' ),
'SERVER_PORT' => '8002',
'SERVER_PROTOCOL' => 'HTTP/1.1',
'HTTP_USER_AGENT' =>
'Mozilla/5.0 (VAX-4000; rv:36.0) Gecko/20350101 Firefox',
'REMOTE_ADDR' => '127.0.0.1',
'HTTP_HOST' => '127.0.0.1:8002',
}
);
}
sub jsonResponse {
my ( $path, $query ) = splice @_;
my $res;
ok( $res = get( $path, $query ),
"Succeed to get $path" . ( $query ? "?$query" : "" ) );
ok( $res->[0] == 200, "Return code eq 200" );
my $href;
ok( $href = decode_json( $res->[2]->[0] ), 'Response is JSON' );
count(3);
return $href;
}
sub jsonPostResponse {
my ( $path, $query, $body, $type, $len ) = splice @_;
my $res;
ok(
$res = post( $path, $query, $body, $type, $len ),
"Succeed to post to $path" . ( $query ? "?$query" : "" )
);
ok( $res->[0] == 200, "Return code eq 200" ) or print STDERR Dumper($res);
my $href;
ok( $href = decode_json( $res->[2]->[0] ), 'Response is JSON' );