In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/57d69a4016b981268198cf744741335a9b1fbb23?hp=446b89af54d4dd848d5432e339a1456502eaee01>
- Log ----------------------------------------------------------------- commit 57d69a4016b981268198cf744741335a9b1fbb23 Author: Chris 'BinGOs' Williams <[email protected]> Date: Wed Jul 30 09:12:58 2014 +0100 Update HTTP-Tiny to CPAN version 0.047 [DELTA] 0.047 2014-07-29 14:09:05-04:00 America/New_York [CHANGED] - Updated Mozilla::CA module recommendation version to 20130114 [FIXED] - Fixed t/00-report-prereqs.t when CPAN::Meta is not installed 0.046 2014-07-21 10:32:32-04:00 America/New_York [FIXED] - Empty header fields are now allowed; headers with the 'undef' value will be rendered as an empty header. [DOCUMENTED] - Updated HTTP/1.1 spec description from RFC 2616 to RFC 7230-7235 0.045 2014-07-19 23:17:28-04:00 America/New_York (TRIAL RELEASE) [FIXED] - Fixed t/002_croakage.t for various operating systems. M Porting/Maintainers.pl M cpan/HTTP-Tiny/lib/HTTP/Tiny.pm M cpan/HTTP-Tiny/t/002_croakage.t M cpan/HTTP-Tiny/t/020_headers.t M cpan/HTTP-Tiny/t/140_proxy.t commit 5f8324b5a4472646efc8d3efc3e79abd7ca8993f Author: Chris 'BinGOs' Williams <[email protected]> Date: Wed Jul 30 09:05:06 2014 +0100 Update CPAN-Meta to CPAN version 2.142060 [DELTA] 2.142060 2014-07-25 13:30:06-04:00 America/New_York [ADDED] - CPAN::Meta::Merge is a new class for merging two possibly overlapping instances of metadata. It will accept both CPAN::Meta objects and (possibly incomplete) hashrefs of metadata. M MANIFEST M META.json M META.yml M Porting/Maintainers.pl M cpan/CPAN-Meta/lib/CPAN/Meta.pm M cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm M cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm M cpan/CPAN-Meta/lib/CPAN/Meta/History.pm A cpan/CPAN-Meta/lib/CPAN/Meta/Merge.pm M cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm M cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm M cpan/CPAN-Meta/lib/CPAN/Meta/Validator.pm A cpan/CPAN-Meta/t/merge.t commit d79626a55aac49404ed146f9ee6890e0ba43c343 Author: Chris 'BinGOs' Williams <[email protected]> Date: Wed Jul 30 08:57:06 2014 +0100 Sync Module-CoreList version after CPAN release M Porting/Maintainers.pl ----------------------------------------------------------------------- Summary of changes: MANIFEST | 2 + META.json | 2 +- META.yml | 2 +- Porting/Maintainers.pl | 8 +- cpan/CPAN-Meta/lib/CPAN/Meta.pm | 4 +- cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm | 24 +- cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm | 4 +- cpan/CPAN-Meta/lib/CPAN/Meta/History.pm | 4 +- cpan/CPAN-Meta/lib/CPAN/Meta/Merge.pm | 248 +++++++++++ cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm | 4 +- cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm | 4 +- cpan/CPAN-Meta/lib/CPAN/Meta/Validator.pm | 4 +- cpan/CPAN-Meta/t/merge.t | 118 ++++++ cpan/HTTP-Tiny/lib/HTTP/Tiny.pm | 658 +++++++++++++++--------------- cpan/HTTP-Tiny/t/002_croakage.t | 12 + cpan/HTTP-Tiny/t/020_headers.t | 9 + cpan/HTTP-Tiny/t/140_proxy.t | 14 + 17 files changed, 766 insertions(+), 355 deletions(-) create mode 100644 cpan/CPAN-Meta/lib/CPAN/Meta/Merge.pm create mode 100644 cpan/CPAN-Meta/t/merge.t diff --git a/MANIFEST b/MANIFEST index 1bb915f..47a0a8d 100644 --- a/MANIFEST +++ b/MANIFEST @@ -232,6 +232,7 @@ cpan/CPAN/lib/CPAN/Version.pm Simple math with different flavors of version str cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm cpan/CPAN-Meta/lib/CPAN/Meta/History.pm +cpan/CPAN-Meta/lib/CPAN/Meta/Merge.pm cpan/CPAN-Meta/lib/CPAN/Meta.pm cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm @@ -296,6 +297,7 @@ cpan/CPAN-Meta/t/data-valid/META-1_0.yml cpan/CPAN-Meta/t/data-valid/META-1_1.yml cpan/CPAN-Meta/t/data-valid/scalar-meta-spec.yml cpan/CPAN-Meta/t/load-bad.t +cpan/CPAN-Meta/t/merge.t cpan/CPAN-Meta/t/meta-obj.t cpan/CPAN-Meta/t/no-index.t cpan/CPAN-Meta/t/prereqs-finalize.t diff --git a/META.json b/META.json index d639e63..24a4d11 100644 --- a/META.json +++ b/META.json @@ -4,7 +4,7 @@ "[email protected]" ], "dynamic_config" : 1, - "generated_by" : "CPAN::Meta version 2.141520", + "generated_by" : "CPAN::Meta version 2.142060", "license" : [ "perl_5" ], diff --git a/META.yml b/META.yml index 474ba24..f521122 100644 --- a/META.yml +++ b/META.yml @@ -4,7 +4,7 @@ author: - [email protected] build_requires: {} dynamic_config: 1 -generated_by: 'CPAN::Meta version 2.141520, CPAN::Meta::Converter version 2.141520' +generated_by: 'CPAN::Meta version 2.142060, CPAN::Meta::Converter version 2.142060' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index d3d4793..bffd16e 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -282,10 +282,11 @@ use File::Glob qw(:case); # Note: When updating CPAN-Meta the META.* files will need to be regenerated # perl -Icpan/CPAN-Meta/lib Porting/makemeta 'CPAN::Meta' => { - 'DISTRIBUTION' => 'DAGOLDEN/CPAN-Meta-2.141520.tar.gz', + 'DISTRIBUTION' => 'DAGOLDEN/CPAN-Meta-2.142060.tar.gz', 'FILES' => q[cpan/CPAN-Meta], 'EXCLUDED' => [ qw[t/00-report-prereqs.t], + qw[t/00-report-prereqs.dd], qr{t/README-data.txt}, qr{^xt}, qr{^history}, @@ -576,10 +577,11 @@ use File::Glob qw(:case); }, 'HTTP::Tiny' => { - 'DISTRIBUTION' => 'DAGOLDEN/HTTP-Tiny-0.043.tar.gz', + 'DISTRIBUTION' => 'DAGOLDEN/HTTP-Tiny-0.047.tar.gz', 'FILES' => q[cpan/HTTP-Tiny], 'EXCLUDED' => [ 't/00-report-prereqs.t', + 't/00-report-prereqs.dd', 't/200_live.t', 't/200_live_local_ip.t', 't/210_live_ssl.t', @@ -780,7 +782,7 @@ use File::Glob qw(:case); }, 'Module::CoreList' => { - 'DISTRIBUTION' => 'BINGOS/Module-CoreList-5.021001.tar.gz', + 'DISTRIBUTION' => 'BINGOS/Module-CoreList-5.021002.tar.gz', 'FILES' => q[dist/Module-CoreList], }, diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta.pm b/cpan/CPAN-Meta/lib/CPAN/Meta.pm index 1b6723f..0c9048a 100644 --- a/cpan/CPAN-Meta/lib/CPAN/Meta.pm +++ b/cpan/CPAN-Meta/lib/CPAN/Meta.pm @@ -2,7 +2,7 @@ use 5.006; use strict; use warnings; package CPAN::Meta; -our $VERSION = '2.141520'; # VERSION +our $VERSION = '2.142060'; # VERSION #pod =head1 SYNOPSIS #pod @@ -641,7 +641,7 @@ CPAN::Meta - the distribution metadata for a CPAN dist =head1 VERSION -version 2.141520 +version 2.142060 =head1 SYNOPSIS diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm index 0b2d83c..83b6c59 100644 --- a/cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm +++ b/cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm @@ -2,7 +2,7 @@ use 5.006; use strict; use warnings; package CPAN::Meta::Converter; -our $VERSION = '2.141520'; # VERSION +our $VERSION = '2.142060'; # VERSION #pod =head1 SYNOPSIS #pod @@ -741,12 +741,15 @@ sub _provides { } sub _convert { - my ($data, $spec, $to_version) = @_; + my ($data, $spec, $to_version, $is_fragment) = @_; my $new_data = {}; for my $key ( keys %$spec ) { next if $key eq ':custom' || $key eq ':drop'; next unless my $fcn = $spec->{$key}; + if ( $is_fragment && $key eq 'generated_by' ) { + $fcn = \&_keep; + } die "spec for '$key' is not a coderef" unless ref $fcn && ref $fcn eq 'CODE'; my $new_value = $fcn->($data->{$key}, $key, $data, $to_version); @@ -1384,13 +1387,14 @@ sub convert { my $args = { %args }; my $new_version = $args->{version} || $HIGHEST; + my $is_fragment = $args->{is_fragment}; my ($old_version) = $self->{spec}; my $converted = _dclone($self->{data}); if ( $old_version == $new_version ) { - $converted = _convert( $converted, $cleanup{$old_version}, $old_version ); - unless ( $args->{no_validation} ) { + $converted = _convert( $converted, $cleanup{$old_version}, $old_version, $is_fragment ); + unless ( $args->{is_fragment} ) { my $cmv = CPAN::Meta::Validator->new( $converted ); unless ( $cmv->is_valid ) { my $errs = join("\n", $cmv->errors); @@ -1405,8 +1409,8 @@ sub convert { next if $vers[$i] > $old_version; last if $vers[$i+1] < $new_version; my $spec_string = "$vers[$i+1]-from-$vers[$i]"; - $converted = _convert( $converted, $down_convert{$spec_string}, $vers[$i+1] ); - unless ( $args->{no_validation} ) { + $converted = _convert( $converted, $down_convert{$spec_string}, $vers[$i+1], $is_fragment ); + unless ( $args->{is_fragment} ) { my $cmv = CPAN::Meta::Validator->new( $converted ); unless ( $cmv->is_valid ) { my $errs = join("\n", $cmv->errors); @@ -1422,8 +1426,8 @@ sub convert { next if $vers[$i] < $old_version; last if $vers[$i+1] > $new_version; my $spec_string = "$vers[$i+1]-from-$vers[$i]"; - $converted = _convert( $converted, $up_convert{$spec_string}, $vers[$i+1] ); - unless ( $args->{no_validation} ) { + $converted = _convert( $converted, $up_convert{$spec_string}, $vers[$i+1], $is_fragment ); + unless ( $args->{is_fragment} ) { my $cmv = CPAN::Meta::Validator->new( $converted ); unless ( $cmv->is_valid ) { my $errs = join("\n", $cmv->errors); @@ -1453,7 +1457,7 @@ sub upgrade_fragment { grep { defined } map { $fragments_generate{$old_version}{$_} } keys %{ $self->{data} }; - my $converted = $self->convert( version => $HIGHEST, no_validation => 1 ); + my $converted = $self->convert( version => $HIGHEST, is_fragment => 1 ); for my $key ( keys %$converted ) { next if $key =~ /^x_/i || $key eq 'meta-spec'; delete $converted->{$key} unless $expected{$key}; @@ -1475,7 +1479,7 @@ CPAN::Meta::Converter - Convert CPAN distribution metadata structures =head1 VERSION -version 2.141520 +version 2.142060 =head1 SYNOPSIS diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm index 52e3e93..db4f1ce 100644 --- a/cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm +++ b/cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm @@ -2,7 +2,7 @@ use 5.006; use strict; use warnings; package CPAN::Meta::Feature; -our $VERSION = '2.141520'; # VERSION +our $VERSION = '2.142060'; # VERSION use CPAN::Meta::Prereqs; @@ -78,7 +78,7 @@ CPAN::Meta::Feature - an optional feature provided by a CPAN distribution =head1 VERSION -version 2.141520 +version 2.142060 =head1 DESCRIPTION diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta/History.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/History.pm index c28273a..9d6c660 100644 --- a/cpan/CPAN-Meta/lib/CPAN/Meta/History.pm +++ b/cpan/CPAN-Meta/lib/CPAN/Meta/History.pm @@ -3,7 +3,7 @@ use 5.006; use strict; use warnings; package CPAN::Meta::History; -our $VERSION = '2.141520'; # VERSION +our $VERSION = '2.142060'; # VERSION 1; @@ -21,7 +21,7 @@ CPAN::Meta::History - history of CPAN Meta Spec changes =head1 VERSION -version 2.141520 +version 2.142060 =head1 DESCRIPTION diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta/Merge.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/Merge.pm new file mode 100644 index 0000000..5648d77 --- /dev/null +++ b/cpan/CPAN-Meta/lib/CPAN/Meta/Merge.pm @@ -0,0 +1,248 @@ +package CPAN::Meta::Merge; + +use strict; +use warnings; + +our $VERSION = '2.142060'; # VERSION + +use Carp qw/croak/; +use Scalar::Util qw/blessed/; +use CPAN::Meta::Converter; + +sub _identical { + my ($left, $right, $path) = @_; + croak "Can't merge attribute " . join '.', @{$path} unless $left eq $right; + return $left; +} + +sub _merge { + my ($current, $next, $mergers, $path) = @_; + for my $key (keys %{$next}) { + if (not exists $current->{$key}) { + $current->{$key} = $next->{$key}; + } + elsif (my $merger = $mergers->{$key}) { + $current->{$key} = $merger->($current->{$key}, $next->{$key}, [ @{$path}, $key ]); + } + elsif ($merger = $mergers->{':default'}) { + $current->{$key} = $merger->($current->{$key}, $next->{$key}, [ @{$path}, $key ]); + } + else { + croak sprintf "Can't merge unknown attribute '%s'", join '.', @{$path}, $key; + } + } + return $current; +} + +sub _uniq { + my %seen = (); + return grep { not $seen{$_}++ } @_; +} + +sub _set_addition { + my ($left, $right) = @_; + return [ +_uniq(@{$left}, @{$right}) ]; +} + +sub _uniq_map { + my ($left, $right, $path) = @_; + for my $key (keys %{$right}) { + if (not exists $left->{$key}) { + $left->{$key} = $right->{$key}; + } + else { + croak 'Duplication of element ' . join '.', @{$path}, $key; + } + } + return $left; +} + +sub _improvize { + my ($left, $right, $path) = @_; + my ($name) = reverse @{$path}; + if ($name =~ /^x_/) { + if (ref($left) eq 'ARRAY') { + return _set_addition($left, $right, $path); + } + elsif (ref($left) eq 'HASH') { + return _uniq_map($left, $right, $path); + } + else { + return _identical($left, $right, $path); + } + } + croak sprintf "Can't merge '%s'", join '.', @{$path}; +} + +my %default = ( + abstract => \&_identical, + author => \&_set_addition, + dynamic_config => sub { + my ($left, $right) = @_; + return $left || $right; + }, + generated_by => sub { + my ($left, $right) = @_; + return join ', ', _uniq(split(/, /, $left), split(/, /, $right)); + }, + license => \&_set_addition, + 'meta-spec' => { + version => \&_identical, + url => \&_identical + }, + name => \&_identical, + release_status => \&_identical, + version => \&_identical, + description => \&_identical, + keywords => \&_set_addition, + no_index => { map { ($_ => \&_set_addition) } qw/file directory package namespace/ }, + optional_features => \&_uniq_map, + prereqs => sub { + require CPAN::Meta::Prereqs; + my ($left, $right) = map { CPAN::Meta::Prereqs->new($_) } @_[0,1]; + return $left->with_merged_prereqs($right)->as_string_hash; + }, + provides => \&_uniq_map, + resources => { + license => \&_set_addition, + homepage => \&_identical, + bugtracker => \&_uniq_map, + repository => \&_uniq_map, + ':default' => \&_improvize, + }, + ':default' => \&_improvize, +); + +sub new { + my ($class, %arguments) = @_; + croak 'default version required' if not exists $arguments{default_version}; + my %mapping = %default; + my %extra = %{ $arguments{extra_mappings} || {} }; + for my $key (keys %extra) { + if (ref($mapping{$key}) eq 'HASH') { + $mapping{$key} = { %{ $mapping{$key} }, %{ $extra{$key} } }; + } + else { + $mapping{$key} = $extra{$key}; + } + } + return bless { + default_version => $arguments{default_version}, + mapping => _coerce_mapping(\%mapping, []), + }, $class; +} + +my %coderef_for = ( + set_addition => \&_set_addition, + uniq_map => \&_uniq_map, + identical => \&_identical, + improvize => \&_improvize, +); + +sub _coerce_mapping { + my ($orig, $map_path) = @_; + my %ret; + for my $key (keys %{$orig}) { + my $value = $orig->{$key}; + if (ref($orig->{$key}) eq 'CODE') { + $ret{$key} = $value; + } + elsif (ref($value) eq 'HASH') { + my $mapping = _coerce_mapping($value, [ @{$map_path}, $key ]); + $ret{$key} = sub { + my ($left, $right, $path) = @_; + return _merge($left, $right, $mapping, [ @{$path}, $key ]); + }; + } + elsif ($coderef_for{$value}) { + $ret{$key} = $coderef_for{$value}; + } + else { + croak "Don't know what to do with " . join '.', @{$map_path}, $key; + } + } + return \%ret; +} + +sub merge { + my ($self, @items) = @_; + my $current = {}; + for my $next (@items) { + if ( blessed($next) && $next->isa('CPAN::Meta') ) { + $next = $next->as_string_hash; + } + elsif ( ref($next) eq 'HASH' ) { + my $cmc = CPAN::Meta::Converter->new( + $next, default_version => $self->{default_version} + ); + $next = $cmc->upgrade_fragment; + } + else { + croak "Don't know how to merge '$next'"; + } + $current = _merge($current, $next, $self->{mapping}, []); + } + return $current; +} + +1; + +# ABSTRACT: Merging CPAN Meta fragments + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +CPAN::Meta::Merge - Merging CPAN Meta fragments + +=head1 VERSION + +version 2.142060 + +=head1 SYNOPSIS + + my $merger = CPAN::Meta::Merge->new(default_version => "2"); + my $meta = $merger->merge($base, @additional); + +=head1 DESCRIPTION + +=head1 METHODS + +=head2 new + +This creates a CPAN::Meta::Merge object. It takes one mandatory named +argument, C<version>, declaring the version of the meta-spec that must be +used for the merge. It can optionally take an C<extra_mappings> argument +that allows one to add additional merging functions for specific elements. + +=head2 merge(@fragments) + +Merge all C<@fragments> together. It will accept both CPAN::Meta objects and +(possibly incomplete) hashrefs of metadata. + +=head1 AUTHORS + +=over 4 + +=item * + +David Golden <[email protected]> + +=item * + +Ricardo Signes <[email protected]> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2010 by David Golden and Ricardo Signes. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm index 0535f74..60248b9 100644 --- a/cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm +++ b/cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm @@ -2,7 +2,7 @@ use 5.006; use strict; use warnings; package CPAN::Meta::Prereqs; -our $VERSION = '2.141520'; # VERSION +our $VERSION = '2.142060'; # VERSION #pod =head1 DESCRIPTION #pod @@ -286,7 +286,7 @@ CPAN::Meta::Prereqs - a set of distribution prerequisites by phase and type =head1 VERSION -version 2.141520 +version 2.142060 =head1 DESCRIPTION diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm index ce5eafb..873580d 100644 --- a/cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm +++ b/cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm @@ -7,7 +7,7 @@ use 5.006; use strict; use warnings; package CPAN::Meta::Spec; -our $VERSION = '2.141520'; # VERSION +our $VERSION = '2.142060'; # VERSION 1; @@ -28,7 +28,7 @@ CPAN::Meta::Spec - specification for CPAN distribution metadata =head1 VERSION -version 2.141520 +version 2.142060 =head1 SYNOPSIS diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta/Validator.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/Validator.pm index 21cf295..7f08de7 100644 --- a/cpan/CPAN-Meta/lib/CPAN/Meta/Validator.pm +++ b/cpan/CPAN-Meta/lib/CPAN/Meta/Validator.pm @@ -2,7 +2,7 @@ use 5.006; use strict; use warnings; package CPAN::Meta::Validator; -our $VERSION = '2.141520'; # VERSION +our $VERSION = '2.142060'; # VERSION #pod =head1 SYNOPSIS #pod @@ -997,7 +997,7 @@ CPAN::Meta::Validator - validate CPAN distribution metadata structures =head1 VERSION -version 2.141520 +version 2.142060 =head1 SYNOPSIS diff --git a/cpan/CPAN-Meta/t/merge.t b/cpan/CPAN-Meta/t/merge.t new file mode 100644 index 0000000..77ae09f --- /dev/null +++ b/cpan/CPAN-Meta/t/merge.t @@ -0,0 +1,118 @@ +#! perl + +use strict; +use warnings; + +use Test::More; +use CPAN::Meta::Merge; + +my %base = ( + abstract => 'This is a test', + author => ['A.U. Thor'], + generated_by => 'Myself', + license => [ 'perl_5' ], + resources => { + license => [ 'http://dev.perl.org/licenses/' ], + }, + prereqs => { + runtime => { + requires => { + Foo => '0', + }, + }, + }, + dynamic_config => 0, + provides => { + Baz => { + file => 'lib/Baz.pm', + }, + }, + 'meta-spec' => { + url => "http://search.cpan.org/perldoc?CPAN::Meta::Spec";, + version => 2, + }, +); + +my %first = ( + author => [ 'I.M. Poster' ], + generated_by => 'Some other guy', + license => [ 'bsd' ], + resources => { + license => [ 'http://opensource.org/licenses/bsd-license.php' ], + }, + prereqs => { + runtime => { + requires => { + Foo => '< 1', + }, + recommends => { + Bar => '3.14', + }, + }, + test => { + requires => { + 'Test::Bar' => 0, + }, + }, + }, + dynamic_config => 1, + provides => { + Quz => { + file => 'lib/Quz.pm', + }, + }, +); +my %first_expected = ( + abstract => 'This is a test', + author => [ 'A.U. Thor', 'I.M. Poster' ], + generated_by => 'Myself, Some other guy', + license => [ 'perl_5', 'bsd' ], + resources => { + license => [ 'http://dev.perl.org/licenses/', 'http://opensource.org/licenses/bsd-license.php' ], + }, + prereqs => { + runtime => { + requires => { + Foo => '>= 0, < 1', + }, + recommends => { + Bar => '3.14', + }, + }, + test => { + requires => { + 'Test::Bar' => 0, + }, + }, + }, + provides => { + Baz => { + file => 'lib/Baz.pm', + }, + Quz => { + file => 'lib/Quz.pm', + }, + }, + dynamic_config => 1, + 'meta-spec' => { + url => "http://search.cpan.org/perldoc?CPAN::Meta::Spec";, + version => 2, + }, +); + +my $merger = CPAN::Meta::Merge->new(default_version => '2'); + +my $first_result = $merger->merge(\%base, \%first); + +is_deeply($first_result, \%first_expected, 'First result is as expected'); + +is_deeply($merger->merge(\%base, { abstract => 'This is a test' }), \%base, 'Can merge in identical abstract'); +my $failure = eval { $merger->merge(\%base, { abstract => 'And now for something else' }) }; +is($failure, undef, 'Trying to merge different author gives an exception'); +like $@, qr/^Can't merge attribute abstract /, 'Exception looks right'; + +my $failure2 = eval { $merger->merge(\%base, { provides => { Baz => { file => 'Baz.pm' } } }) }; +is($failure2, undef, 'Trying to merge different author gives an exception'); +like $@, qr/^Duplication of element provides\.Baz /, 'Exception looks right'; + +done_testing(); diff --git a/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm b/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm index e348753..06c0961 100644 --- a/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm +++ b/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm @@ -3,60 +3,63 @@ package HTTP::Tiny; use strict; use warnings; # ABSTRACT: A small, simple, correct HTTP/1.1 client -our $VERSION = '0.043'; # VERSION +our $VERSION = '0.047'; # VERSION use Carp (); -# =method new -# -# $http = HTTP::Tiny->new( %attributes ); -# -# This constructor returns a new HTTP::Tiny object. Valid attributes include: -# -# =for :list -# * C<agent> -# A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C<agent> ends in a space character, the default user-agent string is appended. -# * C<cookie_jar> -# An instance of L<HTTP::CookieJar> or equivalent class that supports the C<add> and C<cookie_header> methods -# * C<default_headers> -# A hashref of default headers to apply to requests -# * C<local_address> -# The local IP address to bind to -# * C<keep_alive> -# Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1) -# * C<max_redirect> -# Maximum number of redirects allowed (defaults to 5) -# * C<max_size> -# Maximum response size (only when not using a data callback). If defined, responses larger than this will return an exception. -# * C<http_proxy> -# URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> if set) -# * C<https_proxy> -# URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> if set) -# * C<proxy> -# URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> if set) -# * C<no_proxy> -# List of domain suffixes that should not be proxied. Must be a comma-separated string or an array reference. (default is C<$ENV{no_proxy}>) -# * C<timeout> -# Request timeout in seconds (default is 60) -# * C<verify_SSL> -# A boolean that indicates whether to validate the SSL certificate of an C<https> -# connection (default is false) -# * C<SSL_options> -# A hashref of C<SSL_*> options to pass through to L<IO::Socket::SSL> -# -# Exceptions from C<max_size>, C<timeout> or other errors will result in a -# pseudo-HTTP status code of 599 and a reason of "Internal Exception". The -# content field in the response will contain the text of the exception. -# -# The C<keep_alive> parameter enables a persistent connection, but only to a -# single destination scheme, host and port. Also, if any connection-relevant -# attributes are modified, a persistent connection will be dropped. If you want -# persistent connections across multiple destinations, use multiple HTTP::Tiny -# objects. -# -# See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes. -# -# =cut +#pod =method new +#pod +#pod $http = HTTP::Tiny->new( %attributes ); +#pod +#pod This constructor returns a new HTTP::Tiny object. Valid attributes include: +#pod +#pod =for :list +#pod * C<agent> â +#pod A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C<agent> â ends in a space character, the default user-agent string is appended. +#pod * C<cookie_jar> â +#pod An instance of L<HTTP::CookieJar> â or equivalent class that supports the C<add> and C<cookie_header> methods +#pod * C<default_headers> â +#pod A hashref of default headers to apply to requests +#pod * C<local_address> â +#pod The local IP address to bind to +#pod * C<keep_alive> â +#pod Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1) +#pod * C<max_redirect> â +#pod Maximum number of redirects allowed (defaults to 5) +#pod * C<max_size> â +#pod Maximum response size (only when not using a data callback). If defined, responses larger than this will return an exception. +#pod * C<http_proxy> â +#pod URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> â if set) +#pod * C<https_proxy> â +#pod URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> â if set) +#pod * C<proxy> â +#pod URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> â if set) +#pod * C<no_proxy> â +#pod List of domain suffixes that should not be proxied. Must be a comma-separated string or an array reference. (default is C<$ENV{no_proxy}> â) +#pod * C<timeout> â +#pod Request timeout in seconds (default is 60) +#pod * C<verify_SSL> â +#pod A boolean that indicates whether to validate the SSL certificate of an C<https> â +#pod connection (default is false) +#pod * C<SSL_options> â +#pod A hashref of C<SSL_*> â options to pass through to L<IO::Socket::SSL> +#pod +#pod Passing an explicit C<undef> for C<proxy>, C<http_proxy> or C<https_proxy> will +#pod prevent getting the corresponding proxies from the environment. +#pod +#pod Exceptions from C<max_size>, C<timeout> or other errors will result in a +#pod pseudo-HTTP status code of 599 and a reason of "Internal Exception". The +#pod content field in the response will contain the text of the exception. +#pod +#pod The C<keep_alive> parameter enables a persistent connection, but only to a +#pod single destination scheme, host and port. Also, if any connection-relevant +#pod attributes are modified, a persistent connection will be dropped. If you want +#pod persistent connections across multiple destinations, use multiple HTTP::Tiny +#pod objects. +#pod +#pod See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes. +#pod +#pod =cut my @attributes; BEGIN { @@ -120,36 +123,45 @@ sub new { sub _set_proxies { my ($self) = @_; - if (! $self->{proxy} ) { + # get proxies from %ENV only if not provided; explicit undef will disable + # getting proxies from the environment + + # generic proxy + if (! exists $self->{proxy} ) { $self->{proxy} = $ENV{all_proxy} || $ENV{ALL_PROXY}; - if ( defined $self->{proxy} ) { - $self->_split_proxy( 'generic proxy' => $self->{proxy} ); # validate - } - else { - delete $self->{proxy}; - } } - if (! $self->{http_proxy} ) { + if ( defined $self->{proxy} ) { + $self->_split_proxy( 'generic proxy' => $self->{proxy} ); # validate + } + else { + delete $self->{proxy}; + } + + # http proxy + if (! exists $self->{http_proxy} ) { $self->{http_proxy} = $ENV{http_proxy} || $self->{proxy}; - if ( defined $self->{http_proxy} ) { - $self->_split_proxy( http_proxy => $self->{http_proxy} ); # validate - $self->{_has_proxy}{http} = 1; - } - else { - delete $self->{http_proxy}; - } } - if (! $self->{https_proxy} ) { + if ( defined $self->{http_proxy} ) { + $self->_split_proxy( http_proxy => $self->{http_proxy} ); # validate + $self->{_has_proxy}{http} = 1; + } + else { + delete $self->{http_proxy}; + } + + # https proxy + if (! exists $self->{https_proxy} ) { $self->{https_proxy} = $ENV{https_proxy} || $ENV{HTTPS_PROXY} || $self->{proxy}; - if ( $self->{https_proxy} ) { - $self->_split_proxy( https_proxy => $self->{https_proxy} ); # validate - $self->{_has_proxy}{https} = 1; - } - else { - delete $self->{https_proxy}; - } + } + + if ( $self->{https_proxy} ) { + $self->_split_proxy( https_proxy => $self->{https_proxy} ); # validate + $self->{_has_proxy}{https} = 1; + } + else { + delete $self->{https_proxy}; } # Split no_proxy to array reference if not provided as such @@ -161,19 +173,19 @@ sub _set_proxies { return; } -# =method get|head|put|post|delete -# -# $response = $http->get($url); -# $response = $http->get($url, \%options); -# $response = $http->head($url); -# -# These methods are shorthand for calling C<request()> for the given method. The -# URL must have unsafe characters escaped and international domain names encoded. -# See C<request()> for valid options and a description of the response. -# -# The C<success> field of the response will be true if the status code is 2XX. -# -# =cut +#pod =method get|head|put|post|delete +#pod +#pod $response = $http->get($url); +#pod $response = $http->get($url, \%options); +#pod $response = $http->head($url); +#pod +#pod These methods are shorthand for calling C<request()> for the given method. The +#pod URL must have unsafe characters escaped and international domain names encoded. +#pod See C<request()> for valid options and a description of the response. +#pod +#pod The C<success> field of the response will be true if the status code is 2XX. +#pod +#pod =cut for my $sub_name ( qw/get head put post delete/ ) { my $req_method = uc $sub_name; @@ -188,25 +200,25 @@ for my $sub_name ( qw/get head put post delete/ ) { HERE } -# =method post_form -# -# $response = $http->post_form($url, $form_data); -# $response = $http->post_form($url, $form_data, \%options); -# -# This method executes a C<POST> request and sends the key/value pairs from a -# form data hash or array reference to the given URL with a C<content-type> of -# C<application/x-www-form-urlencoded>. If data is provided as an array -# reference, the order is preserved; if provided as a hash reference, the terms -# are sorted on key and value for consistency. See documentation for the -# C<www_form_urlencode> method for details on the encoding. -# -# The URL must have unsafe characters escaped and international domain names -# encoded. See C<request()> for valid options and a description of the response. -# Any C<content-type> header or content in the options hashref will be ignored. -# -# The C<success> field of the response will be true if the status code is 2XX. -# -# =cut +#pod =method post_form +#pod +#pod $response = $http->post_form($url, $form_data); +#pod $response = $http->post_form($url, $form_data, \%options); +#pod +#pod This method executes a C<POST> request and sends the key/value pairs from a +#pod form data hash or array reference to the given URL with a C<content-type> of +#pod C<application/x-www-form-urlencoded>. If data is provided as an array +#pod reference, the order is preserved; if provided as a hash reference, the terms +#pod are sorted on key and value for consistency. See documentation for the +#pod C<www_form_urlencode> method for details on the encoding. +#pod +#pod The URL must have unsafe characters escaped and international domain names +#pod encoded. See C<request()> for valid options and a description of the response. +#pod Any C<content-type> header or content in the options hashref will be ignored. +#pod +#pod The C<success> field of the response will be true if the status code is 2XX. +#pod +#pod =cut sub post_form { my ($self, $url, $data, $args) = @_; @@ -230,28 +242,28 @@ sub post_form { ); } -# =method mirror -# -# $response = $http->mirror($url, $file, \%options) -# if ( $response->{success} ) { -# print "$file is up to date\n"; -# } -# -# Executes a C<GET> request for the URL and saves the response body to the file -# name provided. The URL must have unsafe characters escaped and international -# domain names encoded. If the file already exists, the request will include an -# C<If-Modified-Since> header with the modification timestamp of the file. You -# may specify a different C<If-Modified-Since> header yourself in the C<< -# $options->{headers} >> hash. -# -# The C<success> field of the response will be true if the status code is 2XX -# or if the status code is 304 (unmodified). -# -# If the file was modified and the server response includes a properly -# formatted C<Last-Modified> header, the file modification time will -# be updated accordingly. -# -# =cut +#pod =method mirror +#pod +#pod $response = $http->mirror($url, $file, \%options) +#pod if ( $response->{success} ) { +#pod print "$file is up to date\n"; +#pod } +#pod +#pod Executes a C<GET> request for the URL and saves the response body to the file +#pod name provided. The URL must have unsafe characters escaped and international +#pod domain names encoded. If the file already exists, the request will include an +#pod C<If-Modified-Since> header with the modification timestamp of the file. You +#pod may specify a different C<If-Modified-Since> header yourself in the C<< +#pod $options->{headers} >> hash. +#pod +#pod The C<success> field of the response will be true if the status code is 2XX +#pod or if the status code is 304 (unmodified). +#pod +#pod If the file was modified and the server response includes a properly +#pod formatted C<Last-Modified> header, the file modification time will +#pod be updated accordingly. +#pod +#pod =cut sub mirror { my ($self, $url, $file, $args) = @_; @@ -284,86 +296,90 @@ sub mirror { return $response; } -# =method request -# -# $response = $http->request($method, $url); -# $response = $http->request($method, $url, \%options); -# -# Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST', -# 'PUT', etc.) on the given URL. The URL must have unsafe characters escaped and -# international domain names encoded. -# -# If the URL includes a "user:password" stanza, they will be used for Basic-style -# authorization headers. (Authorization headers will not be included in a -# redirected request.) For example: -# -# $http->request('GET', 'http://Aladdin:open [email protected]/'); -# -# If the "user:password" stanza contains reserved characters, they must -# be percent-escaped: -# -# $http->request('GET', 'http://john%40example.com:[email protected]/'); -# -# A hashref of options may be appended to modify the request. -# -# Valid options are: -# -# =for :list -# * C<headers> -# A hashref containing headers to include with the request. If the value for -# a header is an array reference, the header will be output multiple times with -# each value in the array. These headers over-write any default headers. -# * C<content> -# A scalar to include as the body of the request OR a code reference -# that will be called iteratively to produce the body of the request -# * C<trailer_callback> -# A code reference that will be called if it exists to provide a hashref -# of trailing headers (only used with chunked transfer-encoding) -# * C<data_callback> -# A code reference that will be called for each chunks of the response -# body received. -# -# If the C<content> option is a code reference, it will be called iteratively -# to provide the content body of the request. It should return the empty -# string or undef when the iterator is exhausted. -# -# If the C<content> option is the empty string, no C<content-type> or -# C<content-length> headers will be generated. -# -# If the C<data_callback> option is provided, it will be called iteratively until -# the entire response body is received. The first argument will be a string -# containing a chunk of the response body, the second argument will be the -# in-progress response hash reference, as described below. (This allows -# customizing the action of the callback based on the C<status> or C<headers> -# received prior to the content body.) -# -# The C<request> method returns a hashref containing the response. The hashref -# will have the following keys: -# -# =for :list -# * C<success> -# Boolean indicating whether the operation returned a 2XX status code -# * C<url> -# URL that provided the response. This is the URL of the request unless -# there were redirections, in which case it is the last URL queried -# in a redirection chain -# * C<status> -# The HTTP status code of the response -# * C<reason> -# The response phrase returned by the server -# * C<content> -# The body of the response. If the response does not have any content -# or if a data callback is provided to consume the response body, -# this will be the empty string -# * C<headers> -# A hashref of header fields. All header field names will be normalized -# to be lower case. If a header is repeated, the value will be an arrayref; -# it will otherwise be a scalar string containing the value -# -# On an exception during the execution of the request, the C<status> field will -# contain 599, and the C<content> field will contain the text of the exception. -# -# =cut +#pod =method request +#pod +#pod $response = $http->request($method, $url); +#pod $response = $http->request($method, $url, \%options); +#pod +#pod Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST', +#pod 'PUT', etc.) on the given URL. The URL must have unsafe characters escaped and +#pod international domain names encoded. +#pod +#pod If the URL includes a "user:password" stanza, they will be used for Basic-style +#pod authorization headers. (Authorization headers will not be included in a +#pod redirected request.) For example: +#pod +#pod $http->request('GET', 'http://Aladdin:open [email protected]/'); +#pod +#pod If the "user:password" stanza contains reserved characters, they must +#pod be percent-escaped: +#pod +#pod $http->request('GET', 'http://john%40example.com:[email protected]/'); +#pod +#pod A hashref of options may be appended to modify the request. +#pod +#pod Valid options are: +#pod +#pod =for :list +#pod * C<headers> â +#pod A hashref containing headers to include with the request. If the value for +#pod a header is an array reference, the header will be output multiple times with +#pod each value in the array. These headers over-write any default headers. +#pod * C<content> â +#pod A scalar to include as the body of the request OR a code reference +#pod that will be called iteratively to produce the body of the request +#pod * C<trailer_callback> â +#pod A code reference that will be called if it exists to provide a hashref +#pod of trailing headers (only used with chunked transfer-encoding) +#pod * C<data_callback> â +#pod A code reference that will be called for each chunks of the response +#pod body received. +#pod +#pod The C<Host> header is generated from the URL in accordance with RFC 2616. It +#pod is a fatal error to specify C<Host> in the C<headers> option. Other headers +#pod may be ignored or overwritten if necessary for transport compliance. +#pod +#pod If the C<content> option is a code reference, it will be called iteratively +#pod to provide the content body of the request. It should return the empty +#pod string or undef when the iterator is exhausted. +#pod +#pod If the C<content> option is the empty string, no C<content-type> or +#pod C<content-length> headers will be generated. +#pod +#pod If the C<data_callback> option is provided, it will be called iteratively until +#pod the entire response body is received. The first argument will be a string +#pod containing a chunk of the response body, the second argument will be the +#pod in-progress response hash reference, as described below. (This allows +#pod customizing the action of the callback based on the C<status> or C<headers> +#pod received prior to the content body.) +#pod +#pod The C<request> method returns a hashref containing the response. The hashref +#pod will have the following keys: +#pod +#pod =for :list +#pod * C<success> â +#pod Boolean indicating whether the operation returned a 2XX status code +#pod * C<url> â +#pod URL that provided the response. This is the URL of the request unless +#pod there were redirections, in which case it is the last URL queried +#pod in a redirection chain +#pod * C<status> â +#pod The HTTP status code of the response +#pod * C<reason> â +#pod The response phrase returned by the server +#pod * C<content> â +#pod The body of the response. If the response does not have any content +#pod or if a data callback is provided to consume the response body, +#pod this will be the empty string +#pod * C<headers> â +#pod A hashref of header fields. All header field names will be normalized +#pod to be lower case. If a header is repeated, the value will be an arrayref; +#pod it will otherwise be a scalar string containing the value +#pod +#pod On an exception during the execution of the request, the C<status> field will +#pod contain 599, and the C<content> field will contain the text of the exception. +#pod +#pod =cut my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/; @@ -404,19 +420,19 @@ sub request { return $response; } -# =method www_form_urlencode -# -# $params = $http->www_form_urlencode( $data ); -# $response = $http->get("http://example.com/query?$params";); -# -# This method converts the key/value pairs from a data hash or array reference -# into a C<x-www-form-urlencoded> string. The keys and values from the data -# reference will be UTF-8 encoded and escaped per RFC 3986. If a value is an -# array reference, the key will be repeated with each of the values of the array -# reference. If data is provided as a hash reference, the key/value pairs in the -# resulting string will be sorted by key and value for consistent ordering. -# -# =cut +#pod =method www_form_urlencode +#pod +#pod $params = $http->www_form_urlencode( $data ); +#pod $response = $http->get("http://example.com/query?$params";); +#pod +#pod This method converts the key/value pairs from a data hash or array reference +#pod into a C<x-www-form-urlencoded> string. The keys and values from the data +#pod reference will be UTF-8 encoded and escaped per RFC 3986. If a value is an +#pod array reference, the key will be repeated with each of the values of the array +#pod reference. If data is provided as a hash reference, the key/value pairs in the +#pod resulting string will be sorted by key and value for consistent ordering. +#pod +#pod =cut sub www_form_urlencode { my ($self, $data) = @_; @@ -641,6 +657,11 @@ sub _prepare_headers_and_cb { $request->{headers}{lc $k} = $v; } } + + if (exists $request->{headers}{'host'}) { + die(qq/The 'Host' header must not be provided as header option\n/); + } + $request->{headers}{'host'} = $request->{host_port}; $request->{headers}{'user-agent'} ||= $self->{agent}; $request->{headers}{'connection'} = "close" @@ -757,31 +778,27 @@ sub _split_url { my $url = pop; # URI regex adapted from the URI module - my ($scheme, $authority, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)> + my ($scheme, $host, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)> or die(qq/Cannot parse URL: '$url'\n/); $scheme = lc $scheme; $path_query = "/$path_query" unless $path_query =~ m<\A/>; - my ($auth,$host); - $authority = (length($authority)) ? $authority : 'localhost'; - if ( $authority =~ /@/ ) { - ($auth,$host) = $authority =~ m/\A([^@]*)@(.*)\z/; # user:pass@host + my $auth = ''; + if ( (my $i = index $host, '@') != -1 ) { + # user:pass@host + $auth = substr $host, 0, $i, ''; # take up to the @ for auth + substr $host, 0, 1, ''; # knock the @ off the host + # userinfo might be percent escaped, so recover real auth info $auth =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; } - else { - $host = $authority; - $auth = ''; - } - $host = lc $host; - my $port = do { - $host =~ s/:([0-9]*)\z// && length $1 - ? $1 - : ($scheme eq 'http' ? 80 : $scheme eq 'https' ? 443 : undef); - }; + my $port = $host =~ s/:(\d*)\z// && length $1 ? $1 + : $scheme eq 'http' ? 80 + : $scheme eq 'https' ? 443 + : undef; - return ($scheme, $host, $port, $path_query, $auth); + return ($scheme, (length $host ? lc $host : "localhost") , $port, $path_query, $auth); } # Date conversions adapted from HTTP::Date @@ -1132,8 +1149,7 @@ sub write_header_lines { $HeaderCase{lc $field_name} = $field_name; } for (ref $v eq 'ARRAY' ? @$v : $v) { - /[^\x0D\x0A]/ - or die(qq/Invalid HTTP header field value ($field_name): / . $Printable->($_). "\n"); + $_ = '' unless defined $_; $buf .= "$field_name: $_\x0D\x0A"; } } @@ -1428,7 +1444,7 @@ HTTP::Tiny - A small, simple, correct HTTP/1.1 client =head1 VERSION -version 0.043 +version 0.047 =head1 SYNOPSIS @@ -1473,91 +1489,65 @@ This constructor returns a new HTTP::Tiny object. Valid attributes include: =item * -C<agent> - -A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C<agent> ends in a space character, the default user-agent string is appended. +C<agent> â A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C<agent> â ends in a space character, the default user-agent string is appended. =item * -C<cookie_jar> - -An instance of L<HTTP::CookieJar> or equivalent class that supports the C<add> and C<cookie_header> methods +C<cookie_jar> â An instance of L<HTTP::CookieJar> â or equivalent class that supports the C<add> and C<cookie_header> methods =item * -C<default_headers> - -A hashref of default headers to apply to requests +C<default_headers> â A hashref of default headers to apply to requests =item * -C<local_address> - -The local IP address to bind to +C<local_address> â The local IP address to bind to =item * -C<keep_alive> - -Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1) +C<keep_alive> â Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1) =item * -C<max_redirect> - -Maximum number of redirects allowed (defaults to 5) +C<max_redirect> â Maximum number of redirects allowed (defaults to 5) =item * -C<max_size> - -Maximum response size (only when not using a data callback). If defined, responses larger than this will return an exception. +C<max_size> â Maximum response size (only when not using a data callback). If defined, responses larger than this will return an exception. =item * -C<http_proxy> - -URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> if set) +C<http_proxy> â URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> â if set) =item * -C<https_proxy> - -URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> if set) +C<https_proxy> â URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> â if set) =item * -C<proxy> - -URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> if set) +C<proxy> â URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> â if set) =item * -C<no_proxy> - -List of domain suffixes that should not be proxied. Must be a comma-separated string or an array reference. (default is C<$ENV{no_proxy}>) +C<no_proxy> â List of domain suffixes that should not be proxied. Must be a comma-separated string or an array reference. (default is C<$ENV{no_proxy}> â) =item * -C<timeout> - -Request timeout in seconds (default is 60) +C<timeout> â Request timeout in seconds (default is 60) =item * -C<verify_SSL> - -A boolean that indicates whether to validate the SSL certificate of an C<https> -connection (default is false) +C<verify_SSL> â A boolean that indicates whether to validate the SSL certificate of an C<https> â connection (default is false) =item * -C<SSL_options> - -A hashref of C<SSL_*> options to pass through to L<IO::Socket::SSL> +C<SSL_options> â A hashref of C<SSL_*> â options to pass through to L<IO::Socket::SSL> =back +Passing an explicit C<undef> for C<proxy>, C<http_proxy> or C<https_proxy> will +prevent getting the corresponding proxies from the environment. + Exceptions from C<max_size>, C<timeout> or other errors will result in a pseudo-HTTP status code of 599 and a reason of "Internal Exception". The content field in the response will contain the text of the exception. @@ -1649,35 +1639,26 @@ Valid options are: =item * -C<headers> - -A hashref containing headers to include with the request. If the value for -a header is an array reference, the header will be output multiple times with -each value in the array. These headers over-write any default headers. +C<headers> â A hashref containing headers to include with the request. If the value for a header is an array reference, the header will be output multiple times with each value in the array. Thes ... [41 chars truncated] =item * -C<content> - -A scalar to include as the body of the request OR a code reference -that will be called iteratively to produce the body of the request +C<content> â A scalar to include as the body of the request OR a code reference that will be called iteratively to produce the body of the request =item * -C<trailer_callback> - -A code reference that will be called if it exists to provide a hashref -of trailing headers (only used with chunked transfer-encoding) +C<trailer_callback> â A code reference that will be called if it exists to provide a hashref of trailing headers (only used with chunked transfer-encoding) =item * -C<data_callback> - -A code reference that will be called for each chunks of the response -body received. +C<data_callback> â A code reference that will be called for each chunks of the response body received. =back +The C<Host> header is generated from the URL in accordance with RFC 2616. It +is a fatal error to specify C<Host> in the C<headers> option. Other headers +may be ignored or overwritten if necessary for transport compliance. + If the C<content> option is a code reference, it will be called iteratively to provide the content body of the request. It should return the empty string or undef when the iterator is exhausted. @@ -1699,45 +1680,27 @@ will have the following keys: =item * -C<success> - -Boolean indicating whether the operation returned a 2XX status code +C<success> â Boolean indicating whether the operation returned a 2XX status code =item * -C<url> - -URL that provided the response. This is the URL of the request unless -there were redirections, in which case it is the last URL queried -in a redirection chain +C<url> â URL that provided the response. This is the URL of the request unless there were redirections, in which case it is the last URL queried in a redirection chain =item * -C<status> - -The HTTP status code of the response +C<status> â The HTTP status code of the response =item * -C<reason> - -The response phrase returned by the server +C<reason> â The response phrase returned by the server =item * -C<content> - -The body of the response. If the response does not have any content -or if a data callback is provided to consume the response body, -this will be the empty string +C<content> â The body of the response. If the response does not have any content or if a data callback is provided to consume the response body, this will be the empty string =item * -C<headers> - -A hashref of header fields. All header field names will be normalized -to be lower case. If a header is repeated, the value will be an arrayref; -it will otherwise be a scalar string containing the value +C<headers> â A hashref of header fields. All header field names will be normalized to be lower case. If a header is repeated, the value will be an arrayref; it will otherwise be a scalar string co ... [18 chars truncated] =back @@ -1775,7 +1738,7 @@ verify_SSL Direct C<https> connections are supported only if L<IO::Socket::SSL> 1.56 or greater and L<Net::SSLeay> 1.49 or greater are installed. An exception will be -thrown if a new enough versions of these modules not installed or if the SSL +thrown if new enough versions of these modules are not installed or if the SSL encryption fails. An C<https> connection may be made via an C<http> proxy that supports the CONNECT command (i.e. RFC 2817). You may not proxy C<https> via a proxy that itself requires C<https> to communicate. @@ -1895,9 +1858,40 @@ environment variables. =head1 LIMITATIONS HTTP::Tiny is I<conditionally compliant> with the -L<HTTP/1.1 specification|http://www.w3.org/Protocols/rfc2616/rfc2616.html>. +L<HTTP/1.1 specifications|http://www.w3.org/Protocols/>: + +=over 4 + +=item * + +"Message Syntax and Routing" [RFC7230] + +=item * + +"Semantics and Content" [RFC7231] + +=item * + +"Conditional Requests" [RFC7232] + +=item * + +"Range Requests" [RFC7233] + +=item * + +"Caching" [RFC7234] + +=item * + +"Authentication" [RFC7235] + +=back + It attempts to meet all "MUST" requirements of the specification, but does not -implement all "SHOULD" requirements. +implement all "SHOULD" requirements. (Note: it was developed against the +earlier RFC 2616 specification and may not yet meet the revised RFC 7230-7235 +spec.) Some particular limitations of note include: @@ -2035,7 +2029,7 @@ Chris Nehren <[email protected]> =item * -Chris Weyl <[email protected]> +Chris Weyl <[email protected]> =item * @@ -2059,6 +2053,10 @@ Edward Zborowski <[email protected]> =item * +James Raspass <[email protected]> + +=item * + Jess Robinson <[email protected]> =item * @@ -2091,6 +2089,10 @@ Syohei YOSHIDA <[email protected]> =item * +Sören Kornetzki <[email protected]> + +=item * + Tony Cook <[email protected]> =back diff --git a/cpan/HTTP-Tiny/t/002_croakage.t b/cpan/HTTP-Tiny/t/002_croakage.t index a243ebc..9e51b5d 100644 --- a/cpan/HTTP-Tiny/t/002_croakage.t +++ b/cpan/HTTP-Tiny/t/002_croakage.t @@ -4,8 +4,12 @@ use strict; use warnings; use Test::More; +use t::Util qw[tmpfile monkey_patch set_socket_source]; + use HTTP::Tiny; +BEGIN { monkey_patch() } + my %usage = ( 'get' => q/Usage: $http->get(URL, [HASHREF])/, 'mirror' => q/Usage: $http->mirror(URL, FILE, [HASHREF])/, @@ -26,7 +30,11 @@ my @cases = ( ['request','GET','http://www.example.com/','extra', 'extra'], ); +my $res_fh = tmpfile(); +my $req_fh = tmpfile(); + my $http = HTTP::Tiny->new; +set_socket_source($req_fh, $res_fh); for my $c ( @cases ) { my ($method, @args) = @$c; @@ -35,5 +43,9 @@ for my $c ( @cases ) { like ($err, qr/\Q$usage{$method}\E/, join("|",@$c) ); } +my $res = eval{ $http->get("http://www.example.com/";, { headers => { host => "www.example2.com" } } ) }; +is( $res->{status}, 599, "Providing a Host header errors with 599" ); +like( $res->{content}, qr/'Host' header/, "Providing a Host header gives right error message" ); + done_testing; diff --git a/cpan/HTTP-Tiny/t/020_headers.t b/cpan/HTTP-Tiny/t/020_headers.t index 970faa6..c10e075 100644 --- a/cpan/HTTP-Tiny/t/020_headers.t +++ b/cpan/HTTP-Tiny/t/020_headers.t @@ -49,3 +49,12 @@ use HTTP::Tiny; is_deeply($handle->read_header_lines, $headers, "roundtrip header lines"); } +{ + my $fh = tmpfile(); + my $handle = HTTP::Tiny::Handle->new(fh => $fh); + my $headers = { foo => ['Foo', 'Baz'], bar => 'Bar', baz => '' }; + $handle->write_header_lines($headers); + rewind($fh); + is_deeply($handle->read_header_lines, $headers, "roundtrip header lines"); +} + diff --git a/cpan/HTTP-Tiny/t/140_proxy.t b/cpan/HTTP-Tiny/t/140_proxy.t index 401f8ae..6ecc6a5 100644 --- a/cpan/HTTP-Tiny/t/140_proxy.t +++ b/cpan/HTTP-Tiny/t/140_proxy.t @@ -31,5 +31,19 @@ for my $proxy ("http://localhost:8080/";, "http://localhost:8080";){ like($@, qr{http_proxy URL must be in format http\[s\]://\[auth\@\]<host>:<port>/}); } +# Explicitly disable proxy +{ + local $ENV{all_proxy} = "http://localhost:8080";; + local $ENV{http_proxy} = "http://localhost:8080";; + local $ENV{https_proxy} = "http://localhost:8080";; + my $c = HTTP::Tiny->new( + proxy => undef, + http_proxy => undef, + https_proxy => undef, + ); + ok(!defined $c->proxy, "proxy => undef disables ENV proxy"); + ok(!defined $c->http_proxy, "http_proxy => undef disables ENV proxy"); + ok(!defined $c->https_proxy, "https_proxy => undef disables ENV proxy"); +} done_testing(); -- Perl5 Master Repository
