Future-HTTP-0.17/0000755000175000017500000000000014606027037013041 5ustar corioncorionFuture-HTTP-0.17/MANIFEST.SKIP0000644000175000017500000000035014606027035014733 0ustar corioncorion^\.git\/ maint ^tags$ .last_cover_stats .travis.yml .appveyor.yml .prove ^\.github Makefile$ ^blib ^pm_to_blib ^.*.bak ^.*.old ^t.*sessions ^t/.*\.disabled$ ^cover_db ^.*\.log ^.*\.swp$ ^jar/ ^cpan/ ^MYMETA ^.releaserc ^Future-HTTP Future-HTTP-0.17/Makefile.PL0000644000175000017500000001776214606027035015026 0ustar corioncorion# -*- mode: perl; c-basic-offset: 4; indent-tabs-mode: nil; -*- use strict; use ExtUtils::MakeMaker qw(WriteMakefile); # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. # Normalize version strings like 6.30_02 to 6.3002, # so that we can do numerical comparisons on it. my $eumm_version = $ExtUtils::MakeMaker::VERSION; $eumm_version =~ s/_//; my $module = 'Future::HTTP'; (my $main_file = "lib/$module.pm" ) =~ s!::!/!g; (my $distbase = $module) =~ s!::!-!g; my $distlink = $distbase; my @tests = map { glob $_ } 't/*.t', 't/*/*.t'; my %module = ( NAME => $module, AUTHOR => q{Max Maischein }, VERSION_FROM => $main_file, ABSTRACT_FROM => $main_file, META_MERGE => { "meta-spec" => { version => 2 }, resources => { repository => { web => "https://github.com/Corion/$distlink", url => "git://github.com/Corion/$distlink.git", type => 'git', }, bugtracker => "https://rt.cpan.org/Public/Dist/Display.html?Name=$distbase", license => "https://dev.perl.org/licenses/", }, prereqs => { runtime => { recommends => { # For decoding the various content encodings 'IO::Uncompress::Gunzip' => 0, 'IO::Uncompress::Bunzip2' => 0, 'IO::Uncompress::Inflate' => 0, 'IO::Uncompress::RawInflate' => 0, 'MIME::QuotedPrint' => 0, 'MIME::Base64' => 0, } }, develop => { requires => { 'AnyEvent::HTTP' => 0, 'Net::Async::HTTP' => 0, 'Mojo::UserAgent' => 0, 'HTTP::Tiny::Paranoid' => 0, 'HTTP::Tiny' => 0, }, }, }, dynamic_config => 0, # we promise to keep META.* up-to-date x_static_install => 1, # we are pure Perl and don't do anything fancy }, MIN_PERL_VERSION => '5.020', 'LICENSE'=> 'perl', PL_FILES => {}, BUILD_REQUIRES => { 'ExtUtils::MakeMaker' => 0, }, PREREQ_PM => { 'experimental' => '0.031', # signatures 'Moo' => 2, # yeah, not all that great, but ... 'Future' => '0.49', # Future 0.49 is mostly compatible with Future::XS 'HTTP::Tiny' => 0, # our fallback, even distributed with Perl 5.14+ 'HTTP::Headers' => '6.07', # we want the ->flatten() method }, TEST_REQUIRES => { 'Test::More' => 0, 'Data::Dumper' => 0, 'Test::HTTP::LocalServer' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => "$distbase-*" }, test => { TESTS => join( ' ', @tests ) }, ); # This is so that we can do # require 'Makefile.PL' # and then call get_module_info sub get_module_info { %module } if( ! caller ) { # I should maybe use something like Shipwright... regen_README($main_file); regen_EXAMPLES() if -d 'examples'; WriteMakefile1(get_module_info); }; 1; sub WriteMakefile1 { #Written by Alexandr Ciornii, version 0.21. Added by eumm-upgrade. my %params=@_; my $eumm_version=$ExtUtils::MakeMaker::VERSION; $eumm_version=eval $eumm_version; die "EXTRA_META is deprecated" if exists $params{EXTRA_META}; die "License not specified" if not exists $params{LICENSE}; if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) { #EUMM 6.5502 has problems with BUILD_REQUIRES $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} }; delete $params{BUILD_REQUIRES}; } if ($params{TEST_REQUIRES} and $eumm_version < 6.64) { $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{TEST_REQUIRES}} }; delete $params{TEST_REQUIRES}; } delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52; delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; delete $params{META_MERGE} if $eumm_version < 6.46; delete $params{META_ADD} if $eumm_version < 6.46; delete $params{LICENSE} if $eumm_version < 6.31; delete $params{AUTHOR} if $] < 5.005; delete $params{ABSTRACT_FROM} if $] < 5.005; delete $params{BINARY_LOCATION} if $] < 5.005; WriteMakefile(%params); } sub regen_README { # README is the short version that just tells people what this is # and how to install it eval { # Get description my $readme = join "\n", pod_section($_[0], 'NAME', 'no heading' ), pod_section($_[0], 'DESCRIPTION' ), <new(); # Read POD from Module.pm and write to README $parser->parse_from_file($_[0]); my $readme_mkdn = <as_markdown; [![Travis Build Status](https://travis-ci.org/Corion/$distlink.svg?branch=master)](https://travis-ci.org/Corion/$distlink) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/Corion/$distlink?branch=master&svg=true)](https://ci.appveyor.com/project/Corion/$distlink) STATUS update_file( 'README.mkdn', $readme_mkdn ); }; } sub pod_section { my( $filename, $section, $remove_heading ) = @_; open my $fh, '<', $filename or die "Couldn't read '$filename': $!"; my @section = grep { /^=head1\s+$section/.../^=/ } <$fh>; # Trim the section if( @section ) { pop @section if $section[-1] =~ /^=/; shift @section if $remove_heading; pop @section while @section and $section[-1] =~ /^\s*$/; shift @section while @section and $section[0] =~ /^\s*$/; }; @section = map { $_ =~ s!^=\w+\s+!!; $_ } @section; return join "", @section; } sub regen_EXAMPLES { my $perl = $^X; if ($perl =~/\s/) { $perl = qq{"$perl"}; }; (my $example_file = $main_file) =~ s!\.pm$!/Examples.pm!; my $examples = `$perl -w examples/gen_examples_pod.pl`; if ($examples) { warn "(Re)Creating $example_file\n"; $examples =~ s/\r\n/\n/g; update_file( $example_file, $examples ); }; }; sub update_file { my( $filename, $new_content ) = @_; my $content; if( -f $filename ) { open my $fh, '<', $filename or die "Couldn't read '$filename': $!"; binmode $fh; local $/; $content = <$fh>; }; if( $content ne $new_content ) { if( open my $fh, '>', $filename ) { binmode $fh; print $fh $new_content; } else { warn "Couldn't (re)write '$filename': $!"; }; }; } Future-HTTP-0.17/t/0000755000175000017500000000000014606027037013304 5ustar corioncorionFuture-HTTP-0.17/t/00-load.t0000644000175000017500000000057514606027035014632 0ustar corioncorion#!perl -T use strict; use warnings; use Test::More tests => 1; require './Makefile.PL'; my %module = get_module_info(); my $module = $module{ NAME }; require_ok( $module ); diag( sprintf "Testing %s %s, Perl %s", $module, $module->VERSION, $] ); for (sort grep /\.pm\z/, keys %INC) { s/\.pm\z//; s!/!::!g; eval { diag(join(' ', $_, $_->VERSION || '')) }; } Future-HTTP-0.17/t/01-http-tiny.t0000644000175000017500000000455414606027035015655 0ustar corioncorion#!perl -w use strict; use warnings; use Data::Dumper; use Test::More; use Test::HTTP::LocalServer; use Future::HTTP::Tiny; use HTTP::Tiny; plan tests => 11; my $server = Test::HTTP::LocalServer->spawn( #debug => 1 ); delete @ENV{ qw[ HTTP_PROXY http_proxy HTTP_PROXY_ALL http_proxy_all HTTPS_PROXY https_proxy CGI_HTTP_PROXY ALL_PROXY all_proxy ] }; diag( "Version of HTTP::Tiny: " . HTTP::Tiny->VERSION ); my $ua = Future::HTTP::Tiny->new(); ok !$ua->is_async, 'is_async is false'; my $url = $server->url; my ($body,$headers) = $ua->http_get($url)->get; like $headers->{Status}, qr/2../, "Retrieve URL using HTTP::Tiny backend"; is $headers->{URL}, $server->url, "We arrive at the expected URL" or diag Dumper $headers; my $u = $server->redirect( 'foo' ); ($body,$headers) = $ua->http_get($u)->get; like $headers->{Status}, qr/2../, "Retrieve URL using redirect for a single redirection"; # HTTP::Tiny 0.017 didn't record the final URL SKIP: { if( $HTTP::Tiny::VERSION < 0.018 ) { skip "HTTP::Tiny before 0.018 doesn't record the final URL", 1; }; is $headers->{URL}, $url . 'foo', "We arrive at the expected URL" or diag Dumper $headers; }; # The redirect detection only came with HTTP::Tiny 0.058+ SKIP: { if( $HTTP::Tiny::VERSION < 0.058 ) { skip "HTTP::Tiny before 0.058 doesn't handle redirects", 2; }; ok exists $headers->{Redirect}, "We were redirected here"; ok !exists $headers->{Redirect}->[1]->{Redirect}, "... once"; }; $u = $server->redirect( 'redirect/foo' ); ($body,$headers) = $ua->http_get($u)->get; like $headers->{Status}, qr/2../, "Retrieve URL using redirect for a double redirection"; # HTTP::Tiny 0.017 didn't record the final URL SKIP: { if( $HTTP::Tiny::VERSION < 0.018 ) { skip "HTTP::Tiny before 0.018 doesn't record the final URL", 1; }; is $headers->{URL}, $url . 'foo', "We arrive at the expected URL" or diag Dumper $headers; }; # The redirect detection only came with HTTP::Tiny 0.058+ SKIP: { if( $HTTP::Tiny::VERSION < 0.058 ) { skip "HTTP::Tiny before 0.058 doesn't handle redirects", 2; }; ok exists $headers->{Redirect}, "We were redirected here"; is $headers->{Redirect}->[1]->{Redirect}->[1]->{URL}, $u, "... twice, starting from $u" or diag Dumper $headers->{Redirect}->[1]; }; $server->stop; done_testing; Future-HTTP-0.17/t/01-http-tiny-paranoid.t0000644000175000017500000000470614606027035017447 0ustar corioncorion#!perl -w use strict; use warnings; use Data::Dumper; use Test::More; use Test::HTTP::LocalServer; my $ok = eval { require HTTP::Tiny::Paranoid; require Future::HTTP::Tiny::Paranoid; 1; }; my $err = $@; if( !$ok) { plan skip_all => "Couldn't load Future::HTTP::Tiny::Paranoid: $err"; }; plan tests => 11; delete @ENV{ qw[ HTTP_PROXY http_proxy HTTP_PROXY_ALL http_proxy_all HTTPS_PROXY https_proxy CGI_HTTP_PROXY ALL_PROXY all_proxy ] }; my $server = Test::HTTP::LocalServer->spawn( #debug => 1 ); diag( "Version of HTTP::Tiny::Paranoid: " . HTTP::Tiny::Paranoid->VERSION ); my $url = $server->url; # Check that the local / internal URL is whitelisted, for testing my $h = $url->host; #my $dns = Net::DNS::Paranoid->new( # whitelisted_hosts => [ $h, '127.0.0.1' ], #); HTTP::Tiny::Paranoid->whitelisted_hosts([ $h, '127.0.0.1' ]); my $ua = Future::HTTP::Tiny::Paranoid->new(); ok !$ua->is_async, 'is_async is false'; my ($body,$headers) = $ua->http_get($url)->get; like $headers->{Status}, qr/2../, "Retrieve URL using HTTP::Tiny::Paranoid backend"; is $headers->{URL}, $server->url, "We arrive at the expected URL" or diag Dumper $headers; my $u = $server->redirect( 'foo' ); ($body,$headers) = $ua->http_get($u)->get; like $headers->{Status}, qr/2../, "Retrieve URL using redirect for a single redirection"; # HTTP::Tiny 0.017 didn't record the final URL if( $HTTP::Tiny::VERSION >= 0.018 ) { is $headers->{URL}, $url . 'foo', "We arrive at the expected URL" or diag Dumper $headers; }; # The redirect detection only came with HTTP::Tiny 0.058+ if( $HTTP::Tiny::VERSION >= 0.058 ) { ok exists $headers->{Redirect}, "We were redirected here"; ok !exists $headers->{Redirect}->[1]->{Redirect}, "... once"; }; $u = $server->redirect( 'redirect/foo' ); ($body,$headers) = $ua->http_get($u)->get; like $headers->{Status}, qr/2../, "Retrieve URL using redirect for a double redirection"; # HTTP::Tiny 0.017 didn't record the final URL if( $HTTP::Tiny::VERSION >= 0.018 ) { is $headers->{URL}, $url . 'foo', "We arrive at the expected URL" or diag Dumper $headers; }; # The redirect detection only came with HTTP::Tiny 0.058+ if( HTTP::Tiny->VERSION >= 0.058 ) { ok exists $headers->{Redirect}, "We were redirected here"; is $headers->{Redirect}->[1]->{Redirect}->[1]->{URL}, $u, "... twice, starting from $u" or diag Dumper $headers->{Redirect}->[1]; }; $server->stop; done_testing; Future-HTTP-0.17/t/01-anyevent-http.t0000644000175000017500000000336114606027035016516 0ustar corioncorion#!perl -w use strict; use warnings; use Data::Dumper; use Test::More; use Test::HTTP::LocalServer; my $ok = eval { require Future::HTTP::AnyEvent; 1; }; my $err = $@; if( !$ok) { plan skip_all => "Couldn't load Future::HTTP::AnyEvent: $err"; exit; }; delete @ENV{ qw[ HTTP_PROXY http_proxy HTTP_PROXY_ALL http_proxy_all HTTPS_PROXY https_proxy CGI_HTTP_PROXY ALL_PROXY all_proxy ] }; diag( "Version of AnyEvent::HTTP: " . AnyEvent::HTTP->VERSION ); my $server = Test::HTTP::LocalServer->spawn( #debug => 1 ); my $ua = Future::HTTP::AnyEvent->new(); ok $ua->is_async, 'is_async is true'; my $url = $server->url; my ($body,$headers) = $ua->http_get($url)->get; like $headers->{Status}, qr/2../, "Retrieve URL using AnyEvent::HTTP backend"; is $headers->{URL}, $server->url, "We arrive at the expected URL" or diag Dumper $headers; my $u = $server->redirect( 'foo' ); ($body,$headers) = $ua->http_get($u)->get; like $headers->{Status}, qr/2../, "Retrieve URL using redirect for a single redirection"; is $headers->{URL}, $url . 'foo', "We arrive at the expected URL" or diag Dumper $headers; ok exists $headers->{Redirect}, "We were redirected here"; ok !exists $headers->{Redirect}->[1]->{Redirect}, "... once"; $u = $server->redirect( 'redirect/foo' ); ($body,$headers) = $ua->http_get($u)->get; like $headers->{Status}, qr/2../, "Retrieve URL using redirect for a double redirection"; is $headers->{URL}, $url . 'foo', "We arrive at the expected URL" or diag Dumper $headers; ok exists $headers->{Redirect}, "We were redirected here"; is $headers->{Redirect}->[1]->{Redirect}->[1]->{URL}, $u, "... twice, starting from $u" or diag Dumper $headers->{Redirect}->[1]; $server->stop; done_testing; Future-HTTP-0.17/t/01-netasync.t0000644000175000017500000000343514606027035015536 0ustar corioncorion#!perl -w use strict; use warnings; use Data::Dumper; use Test::More; use Test::HTTP::LocalServer; my $ok = eval { require Net::Async::HTTP; require Future::HTTP::NetAsync; 1; }; my $err = $@; if( !$ok) { plan skip_all => "Couldn't load Net::Async::HTTP: $err"; exit; }; plan tests => 11; delete @ENV{ qw[ HTTP_PROXY http_proxy HTTP_PROXY_ALL http_proxy_all HTTPS_PROXY https_proxy CGI_HTTP_PROXY ALL_PROXY all_proxy ] }; diag( "Version of Net::Async::HTTP: " . Net::Async::HTTP->VERSION ); my $server = Test::HTTP::LocalServer->spawn( #debug => 1 ); my $ua = Future::HTTP::NetAsync->new(); ok $ua->is_async, 'is_async is true'; my $url = $server->url; my ($body,$headers) = $ua->http_get($url)->get; like $headers->{Status}, qr/2../, "Retrieve URL using Net::Async::HTTP backend"; is $headers->{URL}, $server->url, "We arrive at the expected URL" or diag Dumper $headers; my $u = $server->redirect( 'foo' ); ($body,$headers) = $ua->http_get($u)->get; like $headers->{Status}, qr/2../, "Retrieve URL using redirect for a single redirection"; is $headers->{URL}, $url . 'foo', "We arrive at the expected URL" or diag Dumper $headers; ok exists $headers->{Redirect}, "We were redirected here"; ok !exists $headers->{Redirect}->[1]->{Redirect}, "... once"; $u = $server->redirect( 'redirect/foo' ); ($body,$headers) = $ua->http_get($u)->get; like $headers->{Status}, qr/2../, "Retrieve URL using redirect for a double redirection"; is $headers->{URL}, $url . 'foo', "We arrive at the expected URL" or diag Dumper $headers; ok exists $headers->{Redirect}, "We were redirected here"; is $headers->{Redirect}->[1]->{Redirect}->[1]->{URL}, $u, "... twice, starting from $u" or diag Dumper $headers->{Redirect}->[1]; $server->stop; done_testing; Future-HTTP-0.17/t/01-backends-anyevent.t0000644000175000017500000000175514606027035017316 0ustar corioncorion#!perl -w use strict; use warnings; use Test::More; use Future::HTTP; is( Future::HTTP->best_implementation(), 'Future::HTTP::Tiny', "The default backend is HTTP::Tiny"); # If we can load a backend, also make sure it can be chosen: for my $known_implementation (['AnyEvent.pm' => 'Future::HTTP::AnyEvent']) { my( $module_file, $implementation ) = @$known_implementation; if( eval { require $module_file; 1 } ) { if( eval "require $implementation; 1" ) { my $backend = Future::HTTP->best_implementation( $known_implementation, ['strict.pm' => 'fallback reached'], ); is( $backend, $implementation, "$implementation is chosen and loadable if $module_file is loaded" ); } else { my $err = $@; diag "Skipped check for $implementation backend: $err"; }; } else { my $err = $@; diag "Skipped check for $implementation backend: $err"; }; }; done_testing(); Future-HTTP-0.17/t/01-mojo.t0000644000175000017500000000444014606027035014653 0ustar corioncorion#!perl -w use strict; use warnings; use Data::Dumper; use Test::More; use Test::HTTP::LocalServer; my $ok = eval { require Mojolicious; require Future::HTTP::Mojo; 1; }; my $err = $@; if( !$ok) { plan skip_all => "Couldn't load Future::HTTP::Mojo: $err"; exit; }; plan tests => 12; delete @ENV{ qw[ HTTP_PROXY http_proxy HTTP_PROXY_ALL http_proxy_all HTTPS_PROXY https_proxy CGI_HTTP_PROXY ALL_PROXY all_proxy ] }; diag( "Version of Mojolicious: " . Mojolicious->VERSION ); my $server = Test::HTTP::LocalServer->spawn( #debug => 1 ); my $ua = Future::HTTP::Mojo->new(); ok $ua->is_async, 'is_async is true'; my $url = "" . $server->url; # Mojolicious wants a string or a Mojo::URL, not a URI::URL :-/ my ($body,$headers) = $ua->http_get($url)->get; like $headers->{Status}, qr/2../, "Retrieve URL using Mojo::UserAgent backend"; is $headers->{URL}, $server->url, "We arrive at the expected URL" or diag Dumper $headers; my $u = $server->redirect( 'foo' ); ($body,$headers) = $ua->http_get($u)->get; like $headers->{Status}, qr/2../, "Retrieve URL using redirect for a single redirection"; is $headers->{URL}, $url . 'foo', "We arrive at the expected URL" or diag Dumper $headers; ok exists $headers->{Redirect}, "We were redirected here"; ok !exists $headers->{Redirect}->[1]->{Redirect}, "... once"; $u = $server->redirect( 'redirect/foo' ); ($body,$headers) = $ua->http_get($u)->get; like $headers->{Status}, qr/2../, "Retrieve URL using redirect for a double redirection"; is $headers->{URL}, $url . 'foo', "We arrive at the expected URL" or diag Dumper $headers; ok exists $headers->{Redirect}, "We were redirected here"; is $headers->{Redirect}->[1]->{Redirect}->[1]->{URL}, $u, "... twice, starting from $u" or diag Dumper $headers->{Redirect}->[1]; { my @warnings; local $SIG{__WARN__} = sub { push @warnings, $_[0]; diag $_[0]; }; my $ua = Future::HTTP::Mojo->new(); my $f = $ua->http_head( $url, )->then(sub { my $body = shift; Future->done($body); }); my $result = $f->get; is 0+grep({/\b\QUse of uninitialized value \$chunk in concatenation\E\b/} @warnings), 0, "No warnings when running (issue #2)" or diag Dumper \@warnings; } $server->stop; done_testing; Future-HTTP-0.17/t/01-backends-mojolicious.t0000644000175000017500000000175214606027035020016 0ustar corioncorion#!perl -w use strict; use warnings; use Test::More; use Future::HTTP; is( Future::HTTP->best_implementation(), 'Future::HTTP::Tiny', "The default backend is HTTP::Tiny"); # If we can load a backend, also make sure it can be chosen: for my $known_implementation (['Mojo/IOLoop.pm' => 'Future::HTTP::Mojo' ]) { my( $module_file, $implementation ) = @$known_implementation; if( eval { require $module_file; 1 } ) { if( eval "require $implementation; 1" ) { my $backend = Future::HTTP->best_implementation( $known_implementation, ['strict.pm' => 'fallback reached'], ); is( $backend, $implementation, "$implementation is chosen and loadable if $module_file is loaded" ); } else { my $err = $@; diag "Skipped check for $implementation backend: $err"; }; } else { my $err = $@; diag "Skipped check for $implementation backend: $err"; }; }; done_testing(); Future-HTTP-0.17/t/01-backends-default.t0000644000175000017500000000027614606027035017106 0ustar corioncorion#!perl -w use strict; use warnings; use Test::More; use Future::HTTP; is( Future::HTTP->best_implementation(), 'Future::HTTP::Tiny', "The default backend is HTTP::Tiny"); done_testing(); Future-HTTP-0.17/t/01-backends-tiny-paranoid.t0000644000175000017500000000177514606027035020245 0ustar corioncorion#!perl -w use strict; use warnings; use Test::More; use Future::HTTP; is( Future::HTTP->best_implementation(), 'Future::HTTP::Tiny', "The default backend is HTTP::Tiny"); # If we can load a backend, also make sure it can be chosen: for my $known_implementation (['HTTP/Tiny/Paranoid.pm' => 'Future::HTTP::Tiny::Paranoid']) { my( $module_file, $implementation ) = @$known_implementation; if( eval { require $module_file; 1 } ) { if( eval "require $implementation; 1" ) { my $backend = Future::HTTP->best_implementation( $known_implementation, ['strict.pm' => 'fallback reached'], ); is( $backend, $implementation, "$implementation is chosen and loadable if $module_file is loaded" ); } else { my $err = $@; diag "Skipped check for $implementation backend: $err"; }; } else { my $err = $@; diag "Skipped check for $implementation backend: $err"; }; }; done_testing(); Future-HTTP-0.17/t/02-changedefault1.t0000644000175000017500000000036114606027035016561 0ustar corioncorion#!perl -w use strict; use warnings; use Test::More tests=>1; BEGIN { unshift @Future::HTTP::loops, ['Test/More.pm' => 'Config']; } use Future::HTTP; is( Future::HTTP->best_implementation(), 'Config', "changed default backend (pre)"); Future-HTTP-0.17/t/01-backend-selection.t0000644000175000017500000000127514606027035017264 0ustar corioncorion#!perl -w use strict; use Test::More; use Data::Dumper; use Future::HTTP; my $ok = eval { require Test::Without::Module; require Future::HTTP::AnyEvent; 1; } || eval { require Test::Without::Module; require Future::HTTP::Mojo; 1; }; if( $ok ) { plan( tests => 2 ); } else { plan( skip_all => "No backend other than IO::Async available" ); }; Test::Without::Module->import( qw( HTTP::Tiny ) ); isnt( Future::HTTP->best_implementation, 'Future::HTTP::Tiny', "We select a different socket backend if HTTP::Tiny is unavailable"); isnt( Future::HTTP->best_implementation, 'Future::HTTP::Tiny', "We select a different pipe backend if HTTP::Tiny is unavailable"); Future-HTTP-0.17/t/01-backends-netasync.t0000644000175000017500000000175514606027035017311 0ustar corioncorion#!perl -w use strict; use warnings; use Test::More; use Future::HTTP; is( Future::HTTP->best_implementation(), 'Future::HTTP::Tiny', "The default backend is HTTP::Tiny"); # If we can load a backend, also make sure it can be chosen: for my $known_implementation (['IO/Async.pm' => 'Future::HTTP::NetAsync']) { my( $module_file, $implementation ) = @$known_implementation; if( eval { require $module_file; 1 } ) { if( eval "require $implementation; 1" ) { my $backend = Future::HTTP->best_implementation( $known_implementation, ['strict.pm' => 'fallback reached'], ); is( $backend, $implementation, "$implementation is chosen and loadable if $module_file is loaded" ); } else { my $err = $@; diag "Skipped check for $implementation backend: $err"; }; } else { my $err = $@; diag "Skipped check for $implementation backend: $err"; }; }; done_testing(); Future-HTTP-0.17/t/02-changedefault2.t0000644000175000017500000000036214606027035016563 0ustar corioncorion#!perl -w use strict; use warnings; use Test::More tests=>1; use Future::HTTP; BEGIN { unshift @Future::HTTP::loops, ['Test/More.pm' => 'Config']; } is( Future::HTTP->best_implementation(), 'Config', "changed default backend (post)"); Future-HTTP-0.17/README.mkdn0000644000175000017500000001007314606027035014650 0ustar corioncorion [![Travis Build Status](https://travis-ci.org/Corion/Future-HTTP.svg?branch=master)](https://travis-ci.org/Corion/Future-HTTP) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/Corion/Future-HTTP?branch=master&svg=true)](https://ci.appveyor.com/project/Corion/Future-HTTP) # NAME Future::HTTP - provide the most appropriate HTTP client with a Future API # SYNOPSIS my $ua = Future::HTTP->new(); my $res = $ua->http_get('http://www.nethype.de/')->then(sub { my( $body, $data ) = @_; # ... handle the response return $body })->get(); This module is a wrapper combining [Future](https://metacpan.org/pod/Future) with the API provided by [AnyEvent::HTTP](https://metacpan.org/pod/AnyEvent%3A%3AHTTP). The backend used for the HTTP protocols depends on whether one of the event loops is loaded. ## Supported event loops Currently, the following backends are supported: - [HTTP::Tiny](https://metacpan.org/pod/HTTP%3A%3ATiny) - [HTTP::Tiny::Paranoid](https://metacpan.org/pod/HTTP%3A%3ATiny%3A%3AParanoid) - [Mojolicious](https://metacpan.org/pod/Mojolicious) - [AnyEvent](https://metacpan.org/pod/AnyEvent) - [IO::Async](https://metacpan.org/pod/IO%3A%3AAsync) Support is planned for [LWP::UserAgent](https://metacpan.org/pod/LWP%3A%3AUserAgent) and [POE](https://metacpan.org/pod/POE) but has not materialized yet. # METHODS ## `Future::HTTP->new()` my $ua = Future::HTTP->new(); Creates a new instance of the HTTP client. ## `$ua->is_async()` Returns true if the selected backend is asynchronous, false if it is synchronous. ## `$ua->http_get($url, %options)` my $res = $ua->http_get('http://example.com/', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; # ... handle the response })->get; Retrieves the URL and returns the body and headers, like the function in [AnyEvent::HTTP](https://metacpan.org/pod/AnyEvent%3A%3AHTTP). ## `$ua->http_head($url, %options)` my $res = $ua->http_head('http://example.com/', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; ... })->get; Retrieves the header of the URL and returns the headers, like the function in [AnyEvent::HTTP](https://metacpan.org/pod/AnyEvent%3A%3AHTTP). ## `$ua->http_post($url, $body, %options)` my $res = $ua->http_post('http://example.com/api', '{token:"my_json_token"}', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; ... })->get; Posts the content to the URL and returns the body and headers, like the function in [AnyEvent::HTTP](https://metacpan.org/pod/AnyEvent%3A%3AHTTP). ## `$ua->http_request($method, $url, %options)` my $res = $ua->http_request('PUT' => 'http://example.com/api', headers => { 'Accept' => 'text/json', }, body => '{token:"my_json_token"}', )->then(sub { my( $body, $headers ) = @_; ... })->get; Posts the content to the URL and returns the body and headers, like the function in [AnyEvent::HTTP](https://metacpan.org/pod/AnyEvent%3A%3AHTTP). # SEE ALSO [Future](https://metacpan.org/pod/Future) [AnyEvent::HTTP](https://metacpan.org/pod/AnyEvent%3A%3AHTTP) for the details of the API # REPOSITORY The public repository of this module is [https://github.com/Corion/future-http](https://github.com/Corion/future-http). # SUPPORT The public support forum of this module is [https://perlmonks.org/](https://perlmonks.org/). # BUG TRACKER Please report bugs in this module via the RT CPAN bug queue at [https://rt.cpan.org/Public/Dist/Display.html?Name=Future-HTTP](https://rt.cpan.org/Public/Dist/Display.html?Name=Future-HTTP) or via mail to [future-http-Bugs@rt.cpan.org](https://metacpan.org/pod/future-http-Bugs%40rt.cpan.org). # AUTHOR Max Maischein `corion@cpan.org` # COPYRIGHT (c) Copyright 2016-2024 by Max Maischein `corion@cpan.org`. # LICENSE This module is released under the same terms as Perl itself. Future-HTTP-0.17/.gitignore0000644000175000017500000000021114606027035015021 0ustar corioncorionMakefile Makefile.old *.tar.gz *.bak *.swp pm_to_blib blib/ Future-HTTP-* Future-HTTP-*/ .releaserc cover_db MYMETA.* *.pl .prove .patch Future-HTTP-0.17/META.yml0000644000175000017500000000203714606027037014314 0ustar corioncorion--- abstract: 'provide the most appropriate HTTP client with a Future API' author: - 'Max Maischein ' build_requires: Data::Dumper: '0' ExtUtils::MakeMaker: '0' Test::HTTP::LocalServer: '0' Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Future-HTTP no_index: directory: - t - inc recommends: IO::Uncompress::Bunzip2: '0' IO::Uncompress::Gunzip: '0' IO::Uncompress::Inflate: '0' IO::Uncompress::RawInflate: '0' MIME::Base64: '0' MIME::QuotedPrint: '0' requires: Future: '0.49' HTTP::Headers: '6.07' HTTP::Tiny: '0' Moo: '2' experimental: '0.031' perl: '5.020' resources: license: https://dev.perl.org/licenses/ repository: git://github.com/Corion/Future-HTTP.git version: '0.17' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' x_static_install: 1 Future-HTTP-0.17/lib/0000755000175000017500000000000014606027037013607 5ustar corioncorionFuture-HTTP-0.17/lib/Future/0000755000175000017500000000000014606027037015061 5ustar corioncorionFuture-HTTP-0.17/lib/Future/HTTP.pm0000644000175000017500000001217214606027035016177 0ustar corioncorionpackage Future::HTTP; use strict; use experimental 'signatures'; =head1 NAME Future::HTTP - provide the most appropriate HTTP client with a Future API =head1 SYNOPSIS my $ua = Future::HTTP->new(); my $res = $ua->http_get('http://www.nethype.de/')->then(sub { my( $body, $data ) = @_; # ... handle the response return $body })->get(); This module is a wrapper combining L with the API provided by L. The backend used for the HTTP protocols depends on whether one of the event loops is loaded. =head2 Supported event loops Currently, the following backends are supported: =over 4 =item * L =item * L =item * L =item * L =item * L =back Support is planned for L and L but has not materialized yet. =cut our $VERSION = '0.17'; our @loops; push @loops, ( ['IO/Async.pm' => 'Future::HTTP::NetAsync' ], ['Mojo/IOLoop.pm' => 'Future::HTTP::Mojo' ], ['AnyEvent.pm' => 'Future::HTTP::AnyEvent'], ['AE.pm' => 'Future::HTTP::AnyEvent'], # POE support would be nice # LWP::UserAgent support would be nice # A threaded backend would also be nice but likely brings in other # interesting problems. How will we load this? We have two prerequisites # now, threads.pm and HTTP::Tiny... #['threads.pm' => 'Future::HTTP::Tiny::threaded' ], ['HTTP/Tiny/Paranoid.pm' => 'Future::HTTP::Tiny::Paranoid'], # The fallback, will always catch due to loading Future::HTTP ['Future/HTTP.pm' => 'Future::HTTP::Tiny'], ); our $implementation; our $default = 'Future::HTTP::Tiny'; =head1 METHODS =head2 C<< Future::HTTP->new() >> my $ua = Future::HTTP->new(); Creates a new instance of the HTTP client. =cut sub new($factoryclass, @args) { $implementation ||= $factoryclass->best_implementation(); # return a new instance $implementation->new(@args); } sub best_implementation( $class, @candidates ) { if(! @candidates) { @candidates = @loops; }; # Find the currently running/loaded event loop(s) #use Data::Dumper; #warn Dumper \%INC; #warn Dumper \@candidates; my @applicable_implementations = map { $_->[1] } grep { $INC{$_->[0]} } @candidates; if( ! @applicable_implementations ) { @applicable_implementations = map {$_->[1]} @candidates; } # Check which one we can load: for my $impl (@applicable_implementations) { if( eval "require $impl; 1" ) { return $impl; }; }; # This will crash and burn, but that's how it is return $default; }; =head2 C<< $ua->is_async() >> Returns true if the selected backend is asynchronous, false if it is synchronous. =cut sub is_async { die "method is_async must be overloaded by subclass\n"; } # We support the L API first =head2 C<< $ua->http_get($url, %options) >> my $res = $ua->http_get('http://example.com/', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; # ... handle the response })->get; Retrieves the URL and returns the body and headers, like the function in L. =head2 C<< $ua->http_head($url, %options) >> my $res = $ua->http_head('http://example.com/', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; ... })->get; Retrieves the header of the URL and returns the headers, like the function in L. =head2 C<< $ua->http_post($url, $body, %options) >> my $res = $ua->http_post('http://example.com/api', '{token:"my_json_token"}', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; ... })->get; Posts the content to the URL and returns the body and headers, like the function in L. =head2 C<< $ua->http_request($method, $url, %options) >> my $res = $ua->http_request('PUT' => 'http://example.com/api', headers => { 'Accept' => 'text/json', }, body => '{token:"my_json_token"}', )->then(sub { my( $body, $headers ) = @_; ... })->get; Posts the content to the URL and returns the body and headers, like the function in L. =head1 SEE ALSO L L for the details of the API =head1 REPOSITORY The public repository of this module is L. =head1 SUPPORT The public support forum of this module is L. =head1 BUG TRACKER Please report bugs in this module via the RT CPAN bug queue at L or via mail to L. =head1 AUTHOR Max Maischein C =head1 COPYRIGHT (c) Copyright 2016-2024 by Max Maischein C. =head1 LICENSE This module is released under the same terms as Perl itself. =cut # We should support more APIs like HTTP::Tiny, later # See L. 1; Future-HTTP-0.17/lib/Future/HTTP/0000755000175000017500000000000014606027037015640 5ustar corioncorionFuture-HTTP-0.17/lib/Future/HTTP/Mojo.pm0000644000175000017500000001207614606027035017106 0ustar corioncorionpackage Future::HTTP::Mojo; use strict; use Future::Mojo 1.003; # only 1.003+ is compatible with Future::XS use Mojo::UserAgent; use Moo 2; # or Moo::Lax if you can't have Moo v2 use experimental 'signatures'; our $VERSION = '0.17'; with 'Future::HTTP::Handler'; has ua => ( is => 'lazy', default => sub { Mojo::UserAgent->new( %{ $_[0]->_ua_args } ) } ); has _ua_args => ( is => 'ro', default => sub { +{ max_redirects => 10, } } , ); =head1 NAME Future::HTTP::Mojo - asynchronous HTTP client with a Future interface =head1 DESCRIPTION This is the backend when running with L. It will execute the requests asynchronously. =cut sub BUILDARGS { my( $class, %options ) = @_; my @ua_args = keys %options ? (_ua_args => \%options) : (); return +{ @ua_args } } sub is_async { !0 } sub _ae_from_mojolicious( $self, $tx ) { # Convert the result back to a future my $res = $tx->res; my( $body ) = $res->body; my $headers = $res->headers->to_hash; # This means only a single header is allowed! Multiple cookies will vanish! $headers->{Status} = $res->code; $headers->{Reason} = ''; $headers->{URL} = $tx->req->url; if( $tx->redirects) { my $r = $headers; for my $mojolicious_result ( reverse @{ $tx->redirects } ) { $r->{Redirect} = [ $self->_ae_from_mojolicious( $mojolicious_result ) ]; $r = $r->{Redirect}->[1]; # point to the new result headers }; }; return ($body, $headers) }; sub _request($self, $method, $url, %options) { # Munge the parameters from AnyEvent::HTTP to Mojolicious::UserAgent # we should handle on_body parts here with the 'on read' callback my $body = defined $options{ body } ? $options{ body } : ''; # Execute the request (asynchronously) my $_tx = $self->ua->build_tx( $method => $url, $options{ headers } || {}, $body, ); my $res = Future::Mojo->new(); $_tx = $self->ua->start($_tx, sub( $ua, $tx ) { my( $body, $headers ) = $self->_ae_from_mojolicious( $tx ); $self->http_response_received( $res, $body, $headers ); }); $res } sub http_request($self,$method,$url,%options) { $self->_request( $method => $url, %options ) } sub http_get($self,$url,%options) { $self->_request( 'GET' => $url, %options, ) } sub http_head($self,$url,%options) { $self->_request( 'HEAD' => $url, %options ) } sub http_post($self,$url,$body,%options) { $self->_request( 'POST' => $url, body => $body, %options ) } =head1 METHODS =head2 C<< Future::HTTP::Mojo->new() >> my $ua = Future::HTTP::Mojo->new(); Creates a new instance of the HTTP client. =head2 C<< $ua->is_async() >> Returns true, because this backend is asynchronous. =head2 C<< $ua->http_get($url, %options) >> $ua->http_get('http://example.com/', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; ... }); Retrieves the URL and returns the body and headers, like the function in L. =head2 C<< $ua->http_head($url, %options) >> $ua->http_head('http://example.com/', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; ... }); Retrieves the header of the URL and returns the headers, like the function in L. =head2 C<< $ua->http_post($url, $body, %options) >> $ua->http_post('http://example.com/api', '{token:"my_json_token"}', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; ... }); Posts the content to the URL and returns the body and headers, like the function in L. =head2 C<< $ua->http_request($method, $url, %options) >> $ua->http_request('PUT' => 'http://example.com/api', headers => { 'Accept' => 'text/json', }, body => '{token:"my_json_token"}', )->then(sub { my( $body, $headers ) = @_; ... }); Posts the content to the URL and returns the body and headers, like the function in L. Note that this subclass will automatically collect cookies. This may or may not be the behaviour you want. =head1 SEE ALSO L L for the details of the API L for the backend =head1 REPOSITORY The public repository of this module is L. =head1 SUPPORT The public support forum of this module is L. =head1 BUG TRACKER Please report bugs in this module via the RT CPAN bug queue at L or via mail to L. =head1 AUTHOR Max Maischein C =head1 COPYRIGHT (c) Copyright 2016-2024 by Max Maischein C. =head1 LICENSE This module is released under the same terms as Perl itself. =cut 1; Future-HTTP-0.17/lib/Future/HTTP/Tiny/0000755000175000017500000000000014606027037016563 5ustar corioncorionFuture-HTTP-0.17/lib/Future/HTTP/Tiny/Paranoid.pm0000644000175000017500000000735514606027035020666 0ustar corioncorionpackage Future::HTTP::Tiny::Paranoid; use strict; use Future; use HTTP::Tiny::Paranoid 0.07; # 0.04 had spurious CPAN tester failures use Moo 2; # or Moo::Lax if you can't have Moo v2 use experimental 'signatures'; our $VERSION = '0.17'; extends 'Future::HTTP::Tiny'; has '+ua' => ( is => 'lazy', default => sub { HTTP::Tiny::Paranoid->new( %{ $_[0]->_ua_args } ) } ); =head1 NAME Future::HTTP::Tiny::Paranoid - synchronous HTTP client with a Future interface =head1 DESCRIPTION This is the default backend. It is chosen if no supported event loop could be detected. It will execute the requests synchronously as they are made in C<< ->http_request >> . =head1 Whitelist / Blacklist You can set up the whitelist and blacklist through the global accessors: # Allow access to localhost HTTP::Tiny::Paranoid->whitelisted_hosts([ 'localhost', '127.0.0.1' ]); # Deny access to localhost HTTP::Tiny::Paranoid->blacklisted_hosts([ 'localhost', '127.0.0.1' ]); =cut =head1 METHODS =head2 C<< Future::HTTP::Tiny::Paranoid->new() >> my $ua = Future::HTTP::Tiny::Paranoid->new(); Creates a new instance of the HTTP client. =head2 C<< $ua->is_async() >> Returns false, because this backend is synchronous. =head2 C<< $ua->http_get($url, %options) >> $ua->http_get('http://example.com/', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; ... }); Retrieves the URL and returns the body and headers, like the function in L. =head2 C<< $ua->http_head($url, %options) >> $ua->http_head('http://example.com/', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; ... }); Retrieves the header of the URL and returns the headers, like the function in L. =head2 C<< $ua->http_post($url, $body, %options) >> $ua->http_post('http://example.com/api', '{token:"my_json_token"}', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; ... }); Posts the content to the URL and returns the body and headers, like the function in L. =head2 C<< $ua->http_request($method, $url, %options) >> $ua->http_request('PUT' => 'http://example.com/api', headers => { 'Accept' => 'text/json', }, body => '{token:"my_json_token"}', )->then(sub { my( $body, $headers ) = @_; ... }); Posts the content to the URL and returns the body and headers, like the function in L. =head1 COMPATIBILITY L is a good backend because it is distributed with many versions of Perl. The drawback is that not all versions of L support all features. The following features are unsupported on older versions of L: =over 4 =item C<< ->{URL} >> HTTP::Tiny versions before 0.018 didn't tell about 30x redirections. =item C<< ->{redirects} >> HTTP::Tiny versions before 0.058 didn't record the chain of redirects. =back =head1 SEE ALSO L L for the details of the API =head1 REPOSITORY The public repository of this module is L. =head1 SUPPORT The public support forum of this module is L. =head1 BUG TRACKER Please report bugs in this module via the RT CPAN bug queue at L or via mail to L. =head1 AUTHOR Max Maischein C =head1 COPYRIGHT (c) Copyright 2016-2024 by Max Maischein C. =head1 LICENSE This module is released under the same terms as Perl itself. =cut 1; Future-HTTP-0.17/lib/Future/HTTP/Handler.pm0000644000175000017500000001214314606027035017552 0ustar corioncorionpackage Future::HTTP::Handler; use Moo::Role; use experimental 'signatures'; our $VERSION = '0.17'; =head1 NAME Future::HTTP::Handler - common role for handling HTTP responses =cut has 'on_http_response' => ( is => 'rw', ); sub http_response_received( $self, $res, $body, $headers ) { $self->on_http_response( $res, $body, $headers ) if $self->on_http_response; if( $headers->{Status} =~ /^[23]../ ) { $body = $self->decode_content( $body, $headers ); $res->done($body, $headers); } else { $res->fail('error when connecting', $headers); } } no warnings 'once'; sub decode_content { my($self, $body, $headers) = @_; my $content_ref = \$body; my $content_ref_iscopy = 1; if (my $h = $headers->{'content-encoding'}) { $h =~ s/^\s+//; $h =~ s/\s+$//; for my $ce (reverse split(/\s*,\s*/, lc($h))) { next unless $ce; next if $ce eq "identity" || $ce eq "none"; if ($ce eq "gzip" || $ce eq "x-gzip") { require IO::Uncompress::Gunzip; my $output; IO::Uncompress::Gunzip::gunzip($content_ref, \$output, Transparent => 0) or die "Can't gunzip content: $IO::Uncompress::Gunzip::GunzipError"; $content_ref = \$output; $content_ref_iscopy++; } elsif ($ce eq "x-bzip2" or $ce eq "bzip2") { require IO::Uncompress::Bunzip2; my $output; IO::Uncompress::Bunzip2::bunzip2($content_ref, \$output, Transparent => 0) or die "Can't bunzip content: $IO::Uncompress::Bunzip2::Bunzip2Error"; $content_ref = \$output; $content_ref_iscopy++; } elsif ($ce eq "deflate") { require IO::Uncompress::Inflate; my $output; my $status = IO::Uncompress::Inflate::inflate($content_ref, \$output, Transparent => 0); my $error = $IO::Uncompress::Inflate::InflateError; unless ($status) { # "Content-Encoding: deflate" is supposed to mean the # "zlib" format of RFC 1950, but Microsoft got that # wrong, so some servers sends the raw compressed # "deflate" data. This tries to inflate this format. $output = undef; require IO::Uncompress::RawInflate; unless (IO::Uncompress::RawInflate::rawinflate($content_ref, \$output)) { #$self->push_header("Client-Warning" => #"Could not raw inflate content: $IO::Uncompress::RawInflate::RawInflateError"); $output = undef; } } die "Can't inflate content: $error" unless defined $output; $content_ref = \$output; $content_ref_iscopy++; } elsif ($ce eq "compress" || $ce eq "x-compress") { die "Can't uncompress content"; } elsif ($ce eq "base64") { # not really C-T-E, but should be harmless require MIME::Base64; $content_ref = \MIME::Base64::decode($$content_ref); $content_ref_iscopy++; } elsif ($ce eq "quoted-printable") { # not really C-T-E, but should be harmless require MIME::QuotedPrint; $content_ref = \MIME::QuotedPrint::decode($$content_ref); $content_ref_iscopy++; } else { die "Don't know how to decode Content-Encoding '$ce'"; } } } return $$content_ref } sub mirror( $self, $url, $outfile, $args ) { if ( exists $args->{headers} ) { my $headers = {}; while ( my ($key, $value) = each %{$args->{headers} || {}} ) { $headers->{lc $key} = $value; } $args->{headers} = $headers; } if ( -e $outfile and my $mtime = (stat($outfile))[9] ) { $args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime); } my $tempfile = $outfile . int(rand(2**31)); require Fcntl; sysopen my $fh, $tempfile, Fcntl::O_CREAT()|Fcntl::O_EXCL()|Fcntl::O_WRONLY() or croak(qq/Error: Could not create temporary file $tempfile for downloading: $!\n/); binmode $fh; $args->{on_body} = sub { print {$fh} $_[0] }; my $response_f = $self->request('GET', $url, $args)->on_done(sub( $response_f ) { close $fh or croak(qq/Error: Caught error closing temporary file $tempfile: $!\n/); if ( $response_f->is_success ) { my $response = $response_f->get; rename $tempfile, $outfile or _croak(qq/Error replacing $outfile with $tempfile: $!\n/); my $lm = $response->{headers}{'last-modified'}; if ( $lm and my $mtime = $self->_parse_http_date($lm) ) { utime $mtime, $mtime, $outfile; } } $response_f->{success} ||= $response_f->{status} eq '304'; unlink $tempfile; $response_f }); return $response_f; } 1; Future-HTTP-0.17/lib/Future/HTTP/NetAsync.pm0000644000175000017500000001222614606027035017723 0ustar corioncorionpackage Future::HTTP::NetAsync; use strict; use Net::Async::HTTP; use Moo 2; # or Moo::Lax if you can't have Moo v2 use experimental 'signatures'; use HTTP::Request; use IO::Async::Future 0.802; # for Future::XS support our $VERSION = '0.17'; with 'Future::HTTP::Handler'; has ua => ( is => 'lazy', default => sub { my $ua = Net::Async::HTTP->new( %{ $_[0]->_ua_args } ); $_[0]->loop->add($ua); $ua } ); has _ua_args => ( is => 'ro', default => sub { +{ max_redirects => 10, } } , ); has loop => ( is => 'lazy', default => sub { require IO::Async::Loop; IO::Async::Loop->new() } ); =head1 NAME Future::HTTP::NetAsync - asynchronous HTTP client with a Future interface =head1 DESCRIPTION This is the backend when running with L. It will execute the requests asynchronously. =cut sub BUILDARGS { my( $class, %options ) = @_; my @ua_args = keys %options ? (_ua_args => \%options) : (); return +{ @ua_args } } sub is_async { !0 } sub _ae_from_netasync( $self, $res ) { # Convert the result back to the AnyEvent format my( $body ) = $res->content; my $headers = +{ $res->headers->flatten }; # This means only a single header is allowed! Multiple cookies will vanish! $headers->{Status} = $res->code; $headers->{Reason} = ''; $headers->{URL} = $res->request->url; if( $res->redirects) { my $r = $headers; for my $netasync_result ( reverse $res->redirects ) { $r->{Redirect} = [ $self->_ae_from_netasync( $netasync_result ) ]; $r = $r->{Redirect}->[1]; # point to the new result headers }; }; return ($body, $headers) }; sub _request($self, $method, $url, %options) { # Munge the parameters from AnyEvent::HTTP to Net::Async::HTTP my $h = HTTP::Headers->new( %{ $options{ headers } || {} }); my $req = HTTP::Request->new( $method => $url, $h, $options{ body }, ); # Execute the request (asynchronously) $self->ua->do_request( request => $req )->then( sub( $resp ) { my ($body, $headers) = $self->_ae_from_netasync( $resp ); my $f = IO::Async::Future->new(); $self->http_response_received( $f, $body, $headers ); }); } sub http_request($self,$method,$url,%options) { $self->_request( $method => $url, %options ) } sub http_get($self,$url,%options) { $self->_request( 'GET' => $url, %options, ) } sub http_head($self,$url,%options) { $self->_request( 'HEAD' => $url, %options ) } sub http_post($self,$url,$body,%options) { $self->_request( 'POST' => $url, body => $body, %options ) } =head1 METHODS =head2 C<< Future::HTTP::NetAsync->new() >> my $ua = Future::HTTP::NetAsync->new(); Creates a new instance of the HTTP client. =head2 C<< $ua->is_async() >> Returns true, because this backend is asynchronous. =head2 C<< $ua->http_get($url, %options) >> $ua->http_get('http://example.com/', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; ... }); Retrieves the URL and returns the body and headers, like the function in L. =head2 C<< $ua->http_head($url, %options) >> $ua->http_head('http://example.com/', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; ... }); Retrieves the header of the URL and returns the headers, like the function in L. =head2 C<< $ua->http_post($url, $body, %options) >> $ua->http_post('http://example.com/api', '{token:"my_json_token"}', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; ... }); Posts the content to the URL and returns the body and headers, like the function in L. =head2 C<< $ua->http_request($method, $url, %options) >> $ua->http_request('PUT' => 'http://example.com/api', headers => { 'Accept' => 'text/json', }, body => '{token:"my_json_token"}', )->then(sub { my( $body, $headers ) = @_; ... }); Posts the content to the URL and returns the body and headers, like the function in L. Note that this subclass will automatically collect cookies. This may or may not be the behaviour you want. =head1 SEE ALSO L L for the details of the API L for the backend =head1 REPOSITORY The public repository of this module is L. =head1 SUPPORT The public support forum of this module is L. =head1 BUG TRACKER Please report bugs in this module via the RT CPAN bug queue at L or via mail to L. =head1 AUTHOR Max Maischein C =head1 COPYRIGHT (c) Copyright 2016-2024 by Max Maischein C. =head1 LICENSE This module is released under the same terms as Perl itself. =cut 1; Future-HTTP-0.17/lib/Future/HTTP/Tiny.pm0000644000175000017500000001260514606027035017123 0ustar corioncorionpackage Future::HTTP::Tiny; use strict; use Future; use HTTP::Tiny; use Moo 2; # or Moo::Lax if you can't have Moo v2 use experimental 'signatures'; our $VERSION = '0.17'; with 'Future::HTTP::Handler'; has ua => ( is => 'lazy', default => sub { HTTP::Tiny->new( %{ $_[0]->_ua_args } ) } ); has _ua_args => ( is => 'ro', default => sub { +{} } , ); =head1 NAME Future::HTTP::Tiny - synchronous HTTP client with a Future interface =head1 DESCRIPTION This is the default backend. It is chosen if no supported event loop could be detected. It will execute the requests synchronously as they are made in C<< ->http_request >> . =cut sub BUILDARGS { my( $class, %options ) = @_; my @ua_args = keys %options ? (_ua_args => \%options) : (); return +{ @ua_args } } sub is_async { !1 } sub _ae_from_http_tiny( $self, $result, $url ) { # Convert the result back to a future my( $body ) = delete $result->{content}; my( $headers ) = delete $result->{headers}; $headers->{Status} = delete $result->{status}; $headers->{Reason} = delete $result->{reason}; $headers->{URL} = delete $result->{url} || $url; # Only filled with HTTP::Tiny 0.058+! if( $result->{redirects}) { my $r = $headers; for my $http_tiny_result ( reverse @{ $result->{redirects}}) { $r->{Redirect} = [ $self->_ae_from_http_tiny( $http_tiny_result, $url ) ]; $r = $r->{Redirect}->[1]; # point to the new result headers }; }; return ($body, $headers) }; sub _request($self, $method, $url, %options) { # Munge the parameters for AnyEvent::HTTP to HTTP::Tiny for my $rename ( ['body' => 'content'], ['body_cb' => 'data_callback'] ) { my( $from, $to ) = @$rename; if( $options{ $from }) { $options{ $to } = delete $options{ $from }; }; }; # Execute the request (synchronously) my $result = $self->ua->request( $method => $url, \%options ); my $res = Future->new; my( $body, $headers ) = $self->_ae_from_http_tiny( $result, $url ); $self->http_response_received( $res, $body, $headers ); $res } sub http_request($self,$method,$url,%options) { $self->_request( $method => $url, %options ) } sub http_get($self,$url,%options) { $self->_request( 'GET' => $url, %options, ) } sub http_head($self,$url,%options) { $self->_request( 'HEAD' => $url, %options ) } sub http_post($self,$url,$body,%options) { $self->_request( 'POST' => $url, body => $body, %options ) } =head1 METHODS =head2 C<< Future::HTTP::Tiny->new() >> my $ua = Future::HTTP::Tiny->new(); Creates a new instance of the HTTP client. =head2 C<< $ua->is_async() >> Returns false, because this backend is synchronous. =head2 C<< $ua->http_get($url, %options) >> $ua->http_get('http://example.com/', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; ... }); Retrieves the URL and returns the body and headers, like the function in L. =head2 C<< $ua->http_head($url, %options) >> $ua->http_head('http://example.com/', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; ... }); Retrieves the header of the URL and returns the headers, like the function in L. =head2 C<< $ua->http_post($url, $body, %options) >> $ua->http_post('http://example.com/api', '{token:"my_json_token"}', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; ... }); Posts the content to the URL and returns the body and headers, like the function in L. =head2 C<< $ua->http_request($method, $url, %options) >> $ua->http_request('PUT' => 'http://example.com/api', headers => { 'Accept' => 'text/json', }, body => '{token:"my_json_token"}', )->then(sub { my( $body, $headers ) = @_; ... }); Posts the content to the URL and returns the body and headers, like the function in L. =head1 COMPATIBILITY L is a good backend because it is distributed with many versions of Perl. The drawback is that not all versions of L support all features. The following features are unsupported on older versions of L: =over 4 =item C<< ->{URL} >> HTTP::Tiny versions before 0.018 didn't tell about 30x redirections. =item C<< ->{redirects} >> HTTP::Tiny versions before 0.058 didn't record the chain of redirects. =back =head1 SEE ALSO L L for the details of the API =head1 REPOSITORY The public repository of this module is L. =head1 SUPPORT The public support forum of this module is L. =head1 BUG TRACKER Please report bugs in this module via the RT CPAN bug queue at L or via mail to L. =head1 AUTHOR Max Maischein C =head1 COPYRIGHT (c) Copyright 2016-2024 by Max Maischein C. =head1 LICENSE This module is released under the same terms as Perl itself. =cut 1; Future-HTTP-0.17/lib/Future/HTTP/AnyEvent.pm0000644000175000017500000000737714606027035017743 0ustar corioncorionpackage Future::HTTP::AnyEvent; use strict; use Future; use AnyEvent::HTTP (); use AnyEvent::Future; use Moo 2; # or Moo::Lax if you can't have Moo v2 use experimental 'signatures'; our $VERSION = '0.17'; with 'Future::HTTP::Handler'; =head1 NAME Future::HTTP::AnyEvent - asynchronous HTTP client with a Future interface =cut sub BUILDARGS( $class, %options ) { return {} } sub is_async { !0 } sub future_from_result { my( $self, $body, $headers ) = @_; $body ||= $headers->{Reason}; # just in case we didn't get a body at all my $res = Future->new(); $self->http_response_received( $res, $body, $headers ); $res } sub http_request($self,$method,$url,%options) { my $res1 = AnyEvent::Future->new(); my $res = $res1->then(sub ($body, $headers) { $self->future_from_result($body, $headers); }); my $r; $r = AnyEvent::HTTP::http_request($method => $url, %options, sub ($body, $headers) { undef $r; $res1->done( $body,$headers ); }); return $res } sub http_get($self,$url,%options) { $self->http_request('GET',$url, %options) } sub http_head($self,$url,%options) { $self->http_request('HEAD',$url, %options) } sub http_post($self,$url,$body, %options) { $self->http_request('POST',$url, body => $body, %options) } =head1 DESCRIPTION This is the backend chosen if L or L are detected in C<%INC>. It will execute the requests asynchronously using L. =head1 METHODS =head2 C<< Future::HTTP::AnyEvent->new() >> my $ua = Future::HTTP::AnyEvent->new(); Creates a new instance of the HTTP client. =head2 C<< $ua->is_async() >> Returns true, because this backend is asynchronous. =head2 C<< $ua->http_get($url, %options) >> $ua->http_get('http://example.com/', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; ... }); Retrieves the URL and returns the body and headers, like the function in L. =head2 C<< $ua->http_head($url, %options) >> $ua->http_head('http://example.com/', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; ... }); Retrieves the header of the URL and returns the headers, like the function in L. =head2 C<< $ua->http_post($url, $body, %options) >> $ua->http_post('http://example.com/api', '{token:"my_json_token"}', headers => { 'Accept' => 'text/json', }, )->then(sub { my( $body, $headers ) = @_; ... }); Posts the content to the URL and returns the body and headers, like the function in L. =head2 C<< $ua->http_request($method, $url, %options) >> $ua->http_request('PUT' => 'http://example.com/api', headers => { 'Accept' => 'text/json', }, body => '{token:"my_json_token"}', )->then(sub { my( $body, $headers ) = @_; ... }); Posts the content to the URL and returns the body and headers, like the function in L. =head1 SEE ALSO L L for the details of the API =head1 REPOSITORY The public repository of this module is L. =head1 SUPPORT The public support forum of this module is L. =head1 BUG TRACKER Please report bugs in this module via the RT CPAN bug queue at L or via mail to L. =head1 AUTHOR Max Maischein C =head1 COPYRIGHT (c) Copyright 2016-2024 by Max Maischein C. =head1 LICENSE This module is released under the same terms as Perl itself. =cut 1; Future-HTTP-0.17/lib/Future/HTTP/API/0000755000175000017500000000000014606027037016251 5ustar corioncorionFuture-HTTP-0.17/lib/Future/HTTP/API/HTTPTiny.pm0000644000175000017500000000671514606027035020241 0ustar corioncorionpackage # hide from indexer as it's not really ready Future::HTTP::API::HTTPTiny; use strict; use experimental 'signatures'; require HTTP::Tiny; require URI; our $VERSION = '0.17'; =head1 NAME Future::HTTP::API::HTTPTiny - Future::HTTP with an API like HTTP::Tiny =cut sub as_http_tiny( $self, $body, $headers ) { # Reformat the AnyEvent style into HTTP::Tiny style my $status = delete $headers->{Status}; my $result = { success => ($status =~ /^2../ ? 1 : undef), url => delete $headers->{URL}, status => $status, reason => (delete $headers->{Reason}), content => $body, headers => $headers, }; # Convert the redirects from the recursive structure of AnyEvent to # a flat list: if( my $r = delete $headers->{Redirect} ) { my $previous = $self->as_http_tiny( $r->[0], $r->[1] ); # Convert previous redirects to a flat array my @redirects; if( $previous->{redirects}) { push @redirects, @{ $previous->{redirects} }; }; push @redirects, $r; $result->{redirects} = \@redirects; }; $result } sub munge_ht_options($self, $url, %options) { $options{ on_body } = delete $options{ data_callback } if $options{ data_callback }; $options{ body } = delete $options{ content } if $options{ content }; die "Sorry, (code) references for the 'content' parameter are not yet supported" if ref $options{ body }; my $parsed_url = URI->new( $url ); my $auth = $parsed_url->userinfo; # if we have Basic auth parameters, add them if ( length $auth && $auth ne ':' and ! defined $options{headers}->{authorization} ) { # Recover percent-encoded stuff from URL $auth =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; require MIME::Base64; $options{ headers }->{authorization} = 'Basic ' . MIME::Base64::encode_base64($auth, ''); }; # Should we convert the case of the headers here?! # Add the cookie jar # Convert the case of the headers %options } sub mirror($self, $url, $file, $args) { if ( -e $file and my $mtime = (stat($file))[9] ) { $args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime); } my $tempfile = $file . int(rand(2**31)); require Fcntl; sysopen my $fh, $tempfile, Fcntl::O_CREAT()|Fcntl::O_EXCL()|Fcntl::O_WRONLY() or Carp::croak(qq/Error: Could not create temporary file $tempfile for downloading: $!\n/); binmode $fh; $args->{data_callback} = sub { print {$fh} $_[0] }; my $response = $self->request('GET', $url, $args); $response->then(sub( $result ) { use Data::Dumper; warn Dumper $result; close $fh or Carp::croak(qq/Error: Caught error closing temporary file '$tempfile': $!\n/); if ( $result->{success} ) { rename $tempfile, $file or Carp::croak(qq/Error replacing '$file' with '$tempfile': $!\n/); my $lm = $result->{headers}{'last-modified'}; if ( $lm and my $mtime = $self->_parse_http_date($lm) ) { utime $mtime, $mtime, $file; } } $result->{success} ||= $result->{status} eq '304'; unlink $tempfile; }); } # Replace HTTP::Tiny::Request, keep all the other methods no warnings 'once'; *www_form_urlencode = \&HTTP::Tiny::www_form_urlencode; *_http_date = \&HTTP::Tiny::_http_date; *_parse_http_date = \&HTTP::Tiny::_parse_http_date; 1; Future-HTTP-0.17/META.json0000644000175000017500000000411714606027037014465 0ustar corioncorion{ "abstract" : "provide the most appropriate HTTP client with a Future API", "author" : [ "Max Maischein " ], "dynamic_config" : 0, "generated_by" : "ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Future-HTTP", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "AnyEvent::HTTP" : "0", "HTTP::Tiny" : "0", "HTTP::Tiny::Paranoid" : "0", "Mojo::UserAgent" : "0", "Net::Async::HTTP" : "0" } }, "runtime" : { "recommends" : { "IO::Uncompress::Bunzip2" : "0", "IO::Uncompress::Gunzip" : "0", "IO::Uncompress::Inflate" : "0", "IO::Uncompress::RawInflate" : "0", "MIME::Base64" : "0", "MIME::QuotedPrint" : "0" }, "requires" : { "Future" : "0.49", "HTTP::Headers" : "6.07", "HTTP::Tiny" : "0", "Moo" : "2", "experimental" : "0.031", "perl" : "5.020" } }, "test" : { "requires" : { "Data::Dumper" : "0", "Test::HTTP::LocalServer" : "0", "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "license" : [ "https://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "git://github.com/Corion/Future-HTTP.git", "web" : "https://github.com/Corion/Future-HTTP" } }, "version" : "0.17", "x_serialization_backend" : "JSON::PP version 4.07", "x_static_install" : 1 } Future-HTTP-0.17/xt/0000755000175000017500000000000014606027037013474 5ustar corioncorionFuture-HTTP-0.17/xt/99-todo.t0000644000175000017500000000216414606027035015066 0ustar corioncorionuse Test::More; use File::Spec; use File::Find; use strict; # Check that all files do not contain any # lines with "XXX" - such markers should # either have been converted into Todo-stuff # or have been resolved. # The test was provided by Andy Lester. require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib)); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; plan tests => 2* @files; foreach my $file (@files) { source_file_ok($file); } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } sub source_file_ok { my $file = shift; open( my $fh, "<$file" ) or die "Can't open $file: $!"; my @lines = <$fh>; close $fh; my $n = 0; for ( @lines ) { ++$n; s/^/$file ($n): /; } my @x = grep /XXX/, @lines; if ( !is( scalar @x, 0, "Looking for XXXes in $file" ) ) { diag( $_ ) for @x; } @x = grep /<<<|>>>/, @lines; if ( !is( scalar @x, 0, "Looking for <<<<|>>>> in $file" ) ) { diag( $_ ) for @x; } } Future-HTTP-0.17/xt/99-changes.t0000644000175000017500000000133714606027035015532 0ustar corioncorion#!perl -w use warnings; use strict; use File::Find; use Test::More tests => 2; =head1 PURPOSE This test ensures that the Changes file mentions the current version and that a release date is mentioned as well =cut require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my $module = $module{NAME}; (my $file = $module) =~ s!::!/!g; require "$file.pm"; my $version = sprintf '%0.2f', $module->VERSION; my $changes = do { local $/; open my $fh, 'Changes' or die $!; <$fh> }; ok $changes =~ /^(.*$version.*)$/m, "We find version $version for $module"; my $changes_line = $1; ok $changes_line =~ /$version\s+20\d\d-[01]\d-[0123]\d\b/, "We find a release date on the same line" or diag $changes_line; Future-HTTP-0.17/xt/99-manifest.t0000644000175000017500000000203114606027035015720 0ustar corioncorionuse strict; use Test::More; # Check that MANIFEST and MANIFEST.skip are sane : use File::Find; use File::Spec; my @files = qw( MANIFEST MANIFEST.SKIP ); plan tests => scalar @files * 4 +1 # MANIFEST existence check +1 # MYMETA.* non-existence check ; for my $file (@files) { ok(-f $file, "$file exists"); open F, "<$file" or die "Couldn't open $file : $!"; my @lines = ; is_deeply([grep(/^$/, @lines)],[], "No empty lines in $file"); is_deeply([grep(/^\s+$/, @lines)],[], "No whitespace-only lines in $file"); is_deeply([grep(/^\s*\S\s+$/, @lines)],[],"No trailing whitespace on lines in $file"); if ($file eq 'MANIFEST') { chomp @lines; is_deeply([grep { s/\s.*//; ! -f } @lines], [], "All files in $file exist") or do { diag "$_ is mentioned in $file but doesn't exist on disk" for grep { ! -f } @lines }; # Exclude some files from shipping is_deeply([grep(/^MYMETA\.(yml|json)$/, @lines)],[],"We don't try to ship MYMETA.* $file"); }; close F; }; Future-HTTP-0.17/xt/99-unix-text.t0000644000175000017500000000173114606027035016065 0ustar corioncorionuse Test::More; # Check that all released module files are in # UNIX text format use File::Spec; use File::Find; use strict; my @files = ('Makefile.PL', 'MANIFEST', 'MANIFEST.SKIP', glob 't/*.t'); require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib)); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; plan tests => scalar @files; foreach my $file (@files) { unix_file_ok($file); } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } sub unix_file_ok { my ($filename) = @_; local $/; open F, "< $filename" or die "Couldn't open '$filename' : $!\n"; binmode F; my $content = ; my $i; my @lines = grep { /\x0D\x0A$/sm } map { sprintf "%s: %s\x0A", $i++, $_ } split /\x0A/, $content; unless (is(scalar @lines, 0,"'$filename' contains no windows newlines")) { diag $_ for @lines; }; close F; }; Future-HTTP-0.17/xt/99-test-prerequisites.t0000644000175000017500000000660014606027035020001 0ustar corioncorion#!perl -w use warnings; use strict; use Test::More; use Data::Dumper; use File::Find; =head1 DESCRIPTION This test checks whether all tests still pass when the optional test prerequisites for the test are not present. This is done by using L to rerun the test while excluding the optional prerequisite. =cut BEGIN { eval { require CPAN::Meta::Prereqs; require Parse::CPAN::Meta; require Perl::PrereqScanner::Lite; require Module::CoreList; require Test::Without::Module; require Capture::Tiny; Capture::Tiny->import('capture'); require Path::Class; Path::Class->import('dir'); }; if (my $err = $@) { warn "# $err"; plan skip_all => "Prerequisite needed for testing is missing"; exit 0; }; }; my @tests; if( @ARGV ) { @tests = @ARGV; } else { open my $manifest, '<', 'MANIFEST' or die "Couldn't read MANIFEST: $!"; @tests = grep { -f $_ } grep { m!^(t/.*\.t|scripts/.*\.pl)$! } map { s!\s*$!!; $_ } <$manifest> } plan tests => 0+@tests; my $meta = Parse::CPAN::Meta->load_file('META.json'); # Find what META.* declares my $explicit_test_prereqs = CPAN::Meta::Prereqs->new( $meta->{prereqs} )->merged_requirements->as_string_hash; my $minimum_perl = $meta->{prereqs}->{runtime}->{requires}->{perl} || 5.006; sub distributed_packages { my @modules; for( @_ ) { dir($_)->recurse( callback => sub { my( $child ) = @_; if( !$child->is_dir and $child =~ /\.pm$/) { push @modules, ((scalar $child->slurp()) =~ m/^\s*package\s+(?:#.*?\n\s+)*(\w+(?:::\w+)*)\b/msg); } }); }; map { $_ => $_ } @modules; } # Find what we distribute: my %distribution = distributed_packages('blib','t'); my $scanner = Perl::PrereqScanner::Lite->new; for my $test_file (@tests) { my $implicit_test_prereqs = $scanner->scan_file($test_file)->as_string_hash; my %missing = %{ $implicit_test_prereqs }; #warn Dumper \%missing; for my $p ( keys %missing ) { # remove core modules if( Module::CoreList::is_core( $p, undef, $minimum_perl)) { delete $missing{ $p }; #diag "$p is core for $minimum_perl"; } else { #diag "$p is not in core for $minimum_perl"; }; # remove explicit (test) prerequisites for my $k (keys %$explicit_test_prereqs) { delete $missing{ $k }; }; #warn Dumper $explicit_test_prereqs->as_string_hash; # Remove stuff from our distribution for my $k (keys %distribution) { delete $missing{ $k }; }; } # If we have no apparent missing prerequisites, we're good my @missing = sort keys %missing; # Rerun the test without these modules and see whether it crashes my @failed; for my $candidate (@missing) { diag "Checking that $candidate is not essential"; my @cmd = ($^X, "-MTest::Without::Module=$candidate", "-Mblib", '-w', $test_file); my $cmd = join " ", @cmd; my ($stdout, $stderr, $exit) = capture { system( @cmd ); }; if( $exit != 0 ) { push @failed, [ $candidate, [@cmd]]; } elsif( $? != 0 ) { push @failed, [ $candidate, [@cmd]]; }; }; is 0+@failed, 0, $test_file or diag Dumper \@failed; }; done_testing; Future-HTTP-0.17/xt/99-pod.t0000644000175000017500000000145514606027035014705 0ustar corioncorionuse Test::More; # Check our Pod # The test was provided by Andy Lester, # who stole it from Brian D. Foy # Thanks to both ! use File::Spec; use File::Find; use strict; eval { require Test::Pod; Test::Pod->import; }; require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; if ($@) { plan skip_all => "Test::Pod required for testing POD"; } elsif ($Test::Pod::VERSION < 0.95) { plan skip_all => "Test::Pod 0.95 required for testing POD"; } else { my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib)); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; plan tests => scalar @files; foreach my $file (@files) { pod_file_ok($file); } } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } Future-HTTP-0.17/xt/copyright.t0000644000175000017500000000505014606027035015667 0ustar corioncorion#!perl use warnings; use strict; use File::Find; use Test::More tests => 1; use POSIX 'strftime'; my $this_year = strftime '%Y', localtime; my $last_modified_year = 0; my $is_checkout = -d '.git'; require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; #my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ('lib')); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } sub collect { my( $file ) = @_; note $file; my $modified_ts; if( $is_checkout ) { # diag `git log -1 --pretty="format:%ct" "$file"`; $modified_ts = `git log -1 --pretty="format:%ct" "$file"`; } else { $modified_ts = (stat($file))[9]; } my $modified_year; if( $modified_ts ) { $modified_year = strftime('%Y', localtime($modified_ts)); } else { $modified_year = 1970; }; open my $fh, '<', $file or die "Couldn't read $file: $!"; my @copyright = map { /\bcopyright\b.*?\d{4}-(\d{4})\b/i ? [ $_ => $1 ] : () } <$fh>; my $copyright = 0; for (@copyright) { $copyright = $_->[1] > $copyright ? $_->[1] : $copyright; }; return { file => $file, copyright_lines => \@copyright, copyright => $copyright, modified => $modified_year, }; }; if( !$is_checkout ) { SKIP: { skip "Not a repository checkout, not checking copyright", 1; }; exit; }; my @results; for my $file (@files) { push @results, collect($file); }; for my $file (@results) { $last_modified_year = $last_modified_year < $file->{modified} ? $file->{modified} : $last_modified_year; }; note "Distribution was last modified in $last_modified_year"; my @out_of_date = grep { $_->{copyright} and $_->{copyright} != $last_modified_year } @results; if(! is 0+@out_of_date, 0, "All files have a current copyright year ($last_modified_year)") { for my $file (@out_of_date) { diag sprintf "%s modified %d, but copyright is %d", $file->{file}, $file->{modified}, $file->{copyright}; diag $_ for map {@$_} @{ $file->{copyright_lines}}; }; diag q{To fix (in a rough way, please review) run}; diag sprintf q{ perl -i -ple 's!(\bcopyright\b.*?\d{4}-)(\d{4})\b!${1}%s!i' %s}, $this_year, join ' ', map { $_->{file} } @out_of_date; }; Future-HTTP-0.17/xt/99-compile.t0000644000175000017500000000275514606027035015557 0ustar corioncorion#!perl use warnings; use strict; use File::Find; use Test::More; BEGIN { eval 'use Capture::Tiny ":all"; 1'; if ($@) { plan skip_all => "Capture::Tiny needed for testing"; exit 0; }; }; plan 'no_plan'; require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my $last_version = undef; sub check { #return if (! m{(\.pm|\.pl) \z}xmsi); my ($stdout, $stderr, $exit) = capture(sub { system( $^X, '-Mblib', '-c', $_ ); }); s!\s*\z!! for ($stdout, $stderr); if( $exit ) { diag $stderr; diag "Exit code: ", $exit; fail($_); } elsif( $stderr ne "$_ syntax OK") { diag $stderr; fail($_); } else { pass($_); }; } my %skip = ( 'lib/Future/HTTP/AnyEvent.pm' => 1, 'lib/Future/HTTP/Mojo.pm' => 1, 'lib/Future/HTTP/NetAsync.pm' => 1, 'lib/Future/HTTP/Tiny/Paranoid.pm' => 1, 'blib/lib/Future/HTTP/AnyEvent.pm' => 1, 'blib/lib/Future/HTTP/Mojo.pm' => 1, 'blib/lib/Future/HTTP/NetAsync.pm' => 1, 'blib/lib/Future/HTTP/Tiny/Paranoid.pm' => 1, ); if(( $ENV{USER} || '') eq 'corion' and (`hostname`||'') eq 'outerlimits') { %skip = (); } my @files; find({wanted => \&wanted, no_chdir => 1}, grep { -d $_ } 'blib/lib', 'examples', 'lib' ); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; for (grep {!$skip{$_}} @files) { check($_) } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } Future-HTTP-0.17/xt/99-synopsis.t0000644000175000017500000000301114606027035016000 0ustar corioncorionuse strict; use Test::More; use File::Spec; use File::Find; use File::Temp 'tempfile'; require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib)); #if( my $exe = $module{EXE_FILES}) { # push @files, @$exe; #}; plan tests => scalar @files; foreach my $file (@files) { synopsis_file_ok($file); } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/ and $_ !~ /\bDSL\.pm$/; # we skip that one as it initializes immediately } sub synopsis_file_ok { my( $file ) = @_; my $name = "SYNOPSIS in $file compiles"; open my $fh, '<', $file or die "Couldn't read '$file': $!"; my @synopsis = map { s!^\s\s!!; $_ } # outdent all code for here-docs grep { /^\s\s/ } # extract all verbatim (=code) stuff grep { /^=head1\s+SYNOPSIS$/.../^=/ } # extract Pod synopsis <$fh>; if( @synopsis ) { my($tmpfh,$tempname) = tempfile(); print {$tmpfh} join '', @synopsis; close $tmpfh; # flush it my $output = `$^X -Ilib -c $tempname 2>&1`; if( $output =~ /\ssyntax OK$/ ) { pass $name; } else { fail $name; diag $output; diag $_ for @synopsis; }; unlink $tempname or warn "Couldn't clean up $tempname: $!"; } else { SKIP: { skip "$file has no SYNOPSIS section", 1; }; }; } Future-HTTP-0.17/xt/99-versions.t0000644000175000017500000000272014606027035015767 0ustar corioncorion#!perl -w # Stolen from ChrisDolan on use.perl.org # http://use.perl.org/comments.pl?sid=29264&cid=44309 use warnings; use strict; use File::Find; use Test::More; BEGIN { eval 'use File::Slurp; 1'; if ($@) { plan skip_all => "File::Slurp needed for testing"; exit 0; }; }; require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib)); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } plan tests => 0+@files; my $last_version = undef; sub check { my $content = read_file($_); # only look at perl scripts, not sh scripts return if (m{blib/script/}xms && $content !~ m/\A \#![^\r\n]+?perl/xms); my @version_lines = $content =~ m/ ( [^\n]* \$VERSION \s* = [^=] [^\n]* ) /gxms; if (@version_lines == 0) { fail($_); } for my $line (@version_lines) { $line =~ s/^\s+//; $line =~ s/\s+$//; if (!defined $last_version) { $last_version = shift @version_lines; diag "Checking for $last_version"; pass($_); } else { is($line, $last_version, $_); } } } for (@files) { check(); }; if (! defined $last_version) { fail('Failed to find any files with $VERSION'); } Future-HTTP-0.17/xt/meta-lint.t0000644000175000017500000000212014606027035015544 0ustar corioncorion#!perl -w # Stolen from ChrisDolan on use.perl.org # http://use.perl.org/comments.pl?sid=29264&cid=44309 use warnings; use strict; use File::Find; use Test::More; eval { #require Test::MinimumVersion::Fast; require Parse::CPAN::Meta; require CPAN::Meta::Validator; CPAN::Meta::Validator->VERSION(2.15); }; if ($@) { plan skip_all => "CPAN::Meta::Validator version 2.15 required for testing META files"; } else { plan tests => 4; } use lib '.'; our %module; require 'Makefile.PL'; # Loaded from Makefile.PL %module = get_module_info(); my $module = $module{NAME}; (my $file = $module) =~ s!::!/!g; require "$file.pm"; my $version = sprintf '%0.2f', $module->VERSION; for my $meta_file ('META.yml', 'META.json') { my $meta = Parse::CPAN::Meta->load_file($meta_file); my $cmv = CPAN::Meta::Validator->new( $meta ); if(! ok $cmv->is_valid, "$meta_file is valid" ) { diag $_ for $cmv->errors; }; # Also check that the declared version matches the version in META.* is $meta->{version}, $version, "$meta_file version matches module version ($version)"; }; Future-HTTP-0.17/Changes0000644000175000017500000000544514606027035014342 0ustar corioncorion0.17 2024-04-11 * Require Perl 5.020 * Move prerequisites and used modules to versions that work with Future::XS (diagnosed by CPAN testers) 0.16 2023-07-21 * Update test suite to use Package->VERSION() for version checks, not Package->import('1.23') Thanks to Graham Knop 0.15 2023-04-02 * AnyEvent backend fixes, don't lose an intermediate Future anymore * Switch from Test::More::isn't() to Test::More::isnt() 0.14 2020-06-13 * Fix automatic event loop backend selection * Add ->is_async() method to detect what kind of user agent we have (patch by HAUKEX) * Doc fixes (patch by HAUKEX) 0.13 2019-11-09 * Remove HTTP proxy / CGI environment variables to allow the test suite to run on hosts that have them set 0.12 2018-11-23 * Remove imaginary HTPP::Tiny::threaded This adresses RT #123801 , reported by ANDK 0.11 2018-11-08 * Test stability (contributed by Hauke D) * Allow changing @Future::HTTP::loops more easily (contributed by Hauke D) 0.10 2018-05-20 * We now want HTTP::Tiny::Paranoid 0.07+ 0.04 had errors when testing ( http://www.cpantesters.org/cpan/report/7d410262-5b42-11e8-8d7e-b001725e5915 ) 0.09 2018-05-19 * Silence warning when using Mojolicious Thanks to pplu and Grinnz for reporting it and the diagnosis This addresses https://github.com/Corion/future-http/issues/2 * The response body is now always decoded like HTTP::Message->decoded_content If you need access to the raw, undecoded content, please tell me * Switch from including Test::HTTP::LocalServer to loading it as a test prerequisite 0.08 2017-11-29 * 3xx status codes are not treated as errors anymore * Common code was moved into a Role * Support for HTTP::Tiny::Paranoid * Support for IO::Async / Net::Async::HTTP 0.07 2017-07-03 * Only test changes, no need to upgrade * Split up the backend test into separate files to avoid trying to reload an identical module during the test run(s) 0.06 2017-06-30 * We want AnyEvent::Future 0.02 minimum * Actually return a "true" message when failing in HTTP::Future::Mojo 0.05 2016-05-24 * Old versions of HTTP::Tiny don't have some features, defang the tests appropriately. 0.04 2016-05-23 * Attempt to be more compatible with older versions of HTTP::Tiny Those older versions are distributed with Perl 5.12.x etc, so compatibility with them allows us not to require an upgrade of the core module. 0.03 2016-05-23 * Tighten prerequisites We need Future 0.33 now Actually, likely anything above 0.26 will work, but I'm too lazy to find out which versions work. * Support Mojolicious as backend 0.02 2016-05-20 * Fix test suite 0.01 2016-05-16 * Released on an unsuspecting world Future-HTTP-0.17/README0000644000175000017500000000206714606027035013724 0ustar corioncorionFuture::HTTP - provide the most appropriate HTTP client with a Future API INSTALLATION This is a Perl module distribution. It should be installed with whichever tool you use to manage your installation of Perl, e.g. any of cpanm . cpan . cpanp -i . Consult https://www.cpan.org/modules/INSTALL.html for further instruction. Should you wish to install this module manually, the procedure is perl Makefile.PL make make test make install REPOSITORY The public repository of this module is L. SUPPORT The public support forum of this module is L. BUG TRACKER Please report bugs in this module via the RT CPAN bug queue at L or via mail to L. SEE ALSO L L for the details of the API AUTHOR Max Maischein C LICENSE This module is released under the same terms as Perl itself. COPYRIGHT (c) Copyright 2016-2024 by Max Maischein C. Future-HTTP-0.17/MANIFEST0000644000175000017500000000150614606027035014172 0ustar corioncorion.gitignore Changes lib/Future/HTTP.pm lib/Future/HTTP/AnyEvent.pm lib/Future/HTTP/API/HTTPTiny.pm lib/Future/HTTP/Handler.pm lib/Future/HTTP/Mojo.pm lib/Future/HTTP/NetAsync.pm lib/Future/HTTP/Tiny.pm lib/Future/HTTP/Tiny/Paranoid.pm LICENSE Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.json META.yml README README.mkdn t/00-load.t t/01-anyevent-http.t t/01-backend-selection.t t/01-backends-anyevent.t t/01-backends-default.t t/01-backends-mojolicious.t t/01-backends-netasync.t t/01-backends-tiny-paranoid.t t/01-http-tiny-paranoid.t t/01-http-tiny.t t/01-mojo.t t/01-netasync.t t/02-changedefault1.t t/02-changedefault2.t testrules.yml xt/99-changes.t xt/99-compile.t xt/99-manifest.t xt/99-pod.t xt/99-synopsis.t xt/99-test-prerequisites.t xt/99-todo.t xt/99-unix-text.t xt/99-versions.t xt/copyright.t xt/meta-lint.t Future-HTTP-0.17/LICENSE0000644000175000017500000002127514606027035014053 0ustar corioncorion The Artistic License 2.0 Copyright (c) 2000-2006, The Perl Foundation. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble This license establishes the terms under which a given free software Package may be copied, modified, distributed, and/or redistributed. The intent is that the Copyright Holder maintains some artistic control over the development of that Package while still keeping the Package available as open source and free software. You are always permitted to make arrangements wholly outside of this license directly with the Copyright Holder of a given Package. If the terms of this license do not permit the full use that you propose to make of the Package, you should contact the Copyright Holder and seek a different licensing arrangement. Definitions "Copyright Holder" means the individual(s) or organization(s) named in the copyright notice for the entire Package. "Contributor" means any party that has contributed code or other material to the Package, in accordance with the Copyright Holder's procedures. "You" and "your" means any person who would like to copy, distribute, or modify the Package. "Package" means the collection of files distributed by the Copyright Holder, and derivatives of that collection and/or of those files. A given Package may consist of either the Standard Version, or a Modified Version. "Distribute" means providing a copy of the Package or making it accessible to anyone else, or in the case of a company or organization, to others outside of your company or organization. "Distributor Fee" means any fee that you charge for Distributing this Package or providing support for this Package to another party. It does not mean licensing fees. "Standard Version" refers to the Package if it has not been modified, or has been modified only in ways explicitly requested by the Copyright Holder. "Modified Version" means the Package, if it has been changed, and such changes were not explicitly requested by the Copyright Holder. "Original License" means this Artistic License as Distributed with the Standard Version of the Package, in its current version or as it may be modified by The Perl Foundation in the future. "Source" form means the source code, documentation source, and configuration files for the Package. "Compiled" form means the compiled bytecode, object code, binary, or any other form resulting from mechanical transformation or translation of the Source form. Permission for Use and Modification Without Distribution (1) You are permitted to use the Standard Version and create and use Modified Versions for any purpose without restriction, provided that you do not Distribute the Modified Version. Permissions for Redistribution of the Standard Version (2) You may Distribute verbatim copies of the Source form of the Standard Version of this Package in any medium without restriction, either gratis or for a Distributor Fee, provided that you duplicate all of the original copyright notices and associated disclaimers. At your discretion, such verbatim copies may or may not include a Compiled form of the Package. (3) You may apply any bug fixes, portability changes, and other modifications made available from the Copyright Holder. The resulting Package will still be considered the Standard Version, and as such will be subject to the Original License. Distribution of Modified Versions of the Package as Source (4) You may Distribute your Modified Version as Source (either gratis or for a Distributor Fee, and with or without a Compiled form of the Modified Version) provided that you clearly document how it differs from the Standard Version, including, but not limited to, documenting any non-standard features, executables, or modules, and provided that you do at least ONE of the following: (a) make the Modified Version available to the Copyright Holder of the Standard Version, under the Original License, so that the Copyright Holder may include your modifications in the Standard Version. (b) ensure that installation of your Modified Version does not prevent the user installing or running the Standard Version. In addition, the Modified Version must bear a name that is different from the name of the Standard Version. (c) allow anyone who receives a copy of the Modified Version to make the Source form of the Modified Version available to others under (i) the Original License or (ii) a license that permits the licensee to freely copy, modify and redistribute the Modified Version using the same licensing terms that apply to the copy that the licensee received, and requires that the Source form of the Modified Version, and of any works derived from it, be made freely available in that license fees are prohibited but Distributor Fees are allowed. Distribution of Compiled Forms of the Standard Version or Modified Versions without the Source (5) You may Distribute Compiled forms of the Standard Version without the Source, provided that you include complete instructions on how to get the Source of the Standard Version. Such instructions must be valid at the time of your distribution. If these instructions, at any time while you are carrying out such distribution, become invalid, you must provide new instructions on demand or cease further distribution. If you provide valid instructions or cease distribution within thirty days after you become aware that the instructions are invalid, then you do not forfeit any of your rights under this license. (6) You may Distribute a Modified Version in Compiled form without the Source, provided that you comply with Section 4 with respect to the Source of the Modified Version. Aggregating or Linking the Package (7) You may aggregate the Package (either the Standard Version or Modified Version) with other packages and Distribute the resulting aggregation provided that you do not charge a licensing fee for the Package. Distributor Fees are permitted, and licensing fees for other components in the aggregation are permitted. The terms of this license apply to the use and Distribution of the Standard or Modified Versions as included in the aggregation. (8) You are permitted to link Modified and Standard Versions with other works, to embed the Package in a larger work of your own, or to build stand-alone binary or bytecode versions of applications that include the Package, and Distribute the result without restriction, provided the result does not expose a direct interface to the Package. Items That are Not Considered Part of a Modified Version (9) Works (including, but not limited to, modules and scripts) that merely extend or make use of the Package, do not, by themselves, cause the Package to be a Modified Version. In addition, such works are not considered parts of the Package itself, and are not subject to the terms of this license. General Provisions (10) Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. (11) If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. (12) This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. (13) This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.Future-HTTP-0.17/testrules.yml0000644000175000017500000000012114606027035015606 0ustar corioncorion--- # This test suite can be run fully in parallel par: - t/*.t - xt/*.t