← Back to branch summary

~ubuntu-branches/ubuntu/wily/libpithub-perl/wily-proposed

« back to all changes in this revision

Viewing changes to t/lib/Pithub/Test/UA.pm

  • Committer: Package Import Robot
  • Author(s): Dominique Dumont, Salvatore Bonaccorso, Dominique Dumont
  • Date: 2015-06-03 16:22:00 UTC
  • mfrom: (1.1.8)
  • Revision ID: package-import@ubuntu.com-20150603162200-bladhkpfuti7sdo5
Tags: 0.01028-1
[ Salvatore Bonaccorso ]
* Update Vcs-Browser URL to cgit web frontend

[ Dominique Dumont ]
* Imported Upstream version 0.01028
* control:
  * updated Standards-Version to 3.9.6
  - removed dep on libfile-slurp-perl, libjson-perl
  + added dep on libjson-maybexs-perl libpath-tiny-perl
    libimport-into-perl libarray-iterator-perl libcache-lru-perl

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/lib/Pithub/Test/UA.pm
2
2
  Pithub::Test::UA;
3
3
 
4
4
use Moo;
5
 
use File::Basename qw(dirname);
6
 
use File::Slurp qw(read_file);
 
5
use Path::Tiny;
7
6
use HTTP::Response;
8
7
use Test::More;
9
8
 
 
9
my @responses;
 
10
 
 
11
sub add_response {
 
12
    my ( $self, $path ) = @_;
 
13
    my $full_path = sprintf '%s/http_response/api.github.com/%s', path(__FILE__)->dirname, $path;
 
14
    my $response_string = path($full_path)->slurp;
 
15
    my $response = HTTP::Response->parse($response_string);
 
16
    push @responses, $response;
 
17
}
 
18
 
10
19
sub request {
11
20
    my ( $self, $request ) = @_;
12
 
    my $path = sprintf '%s/http_response/%s/%s.%s', dirname(__FILE__), $request->uri->host, $request->uri->path, $request->method;
13
 
    my %query_form = $request->uri->query_form;
14
 
    foreach my $k ( sort keys %query_form ) {
15
 
        $path .= sprintf '.%s-%s', $k, $query_form{$k};
16
 
    }
17
 
    my $response = HTTP::Response->new;
18
 
    if ( -f $path ) {
19
 
        my $res = read_file($path);
20
 
        $response = HTTP::Response->parse($res);
21
 
    }
22
 
    $response->request($request);
23
 
    return $response;
 
21
    my $result = HTTP::Response->new;
 
22
    if ( my $response = shift(@responses) ) {
 
23
        $result = $response;
 
24
    }
 
25
    $result->request($request);
 
26
    return $result;
24
27
}
25
28
 
26
29
1;