[cpanminus] 02/10: Imported Upstream version 1.7004
gregor herrmann
gregoa at debian.org
Tue May 13 17:51:32 UTC 2014
This is an automated email from the git hooks/post-receive script.
gregoa pushed a commit to branch master
in repository cpanminus.
commit 515a24fdf783e49d24ab2e4871a7a9b2547b4b4f
Author: gregor herrmann <gregoa at debian.org>
Date: Tue May 13 18:53:01 2014 +0200
Imported Upstream version 1.7004
---
Changes | 13 +
LICENSE | 2 +-
MANIFEST | 1 +
META.json | 8 +-
META.yml | 18 +-
Makefile.PL | 37 +-
bin/cpanm | 160 ++-
lib/App/cpanminus.pm | 2 +-
lib/App/cpanminus/fatscript.pm | 2695 +++++++++++++++++++++++++++-------------
9 files changed, 1983 insertions(+), 953 deletions(-)
diff --git a/Changes b/Changes
index 77e5b72..a821d47 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,18 @@
See http://github.com/miyagawa/cpanminus/ for the latest development.
+1.7004 2014-04-27 18:22:11 CEST
+ [Bug Fixes]
+ - Downgrade Parse::CPAN::Meta as well #373
+
+1.7003 2014-04-27 17:11:14 CEST
+ [Bug Fixes]
+ - Downgrade CPAN::Meta (moznion) #372
+
+1.7002 2014-04-27 07:45:53 CEST
+ [Bug Fixes]
+ - Bump fatpacked local::lib #364
+ - Fix a bug where build.log files are not properly renamed on the first run on Win32 (haarg) #368
+
1.7001 2013-09-08 13:11:16 PDT
[Bug Fixes]
- Fix bootstrap with perl 5.8 and MakeMaker/Module::Build (haarg) #311
diff --git a/LICENSE b/LICENSE
index c5b9b49..b8ec786 100644
--- a/LICENSE
+++ b/LICENSE
@@ -22,7 +22,7 @@ This is free software, licensed under:
Version 1, February 1989
Copyright (C) 1989 Free Software Foundation, Inc.
- 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA
+ 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
diff --git a/MANIFEST b/MANIFEST
index c0cf93f..fffcd7c 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,3 +1,4 @@
+# This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.015.
Changes
LICENSE
MANIFEST
diff --git a/META.json b/META.json
index d40bcca..b10b937 100644
--- a/META.json
+++ b/META.json
@@ -4,7 +4,7 @@
"- Tatsuhiko Miyagawa"
],
"dynamic_config" : 0,
- "generated_by" : "Dist::Milla version v1.0.4, Dist::Zilla version 4.300038, CPAN::Meta::Converter version 2.132510",
+ "generated_by" : "Dist::Milla version v1.0.4, Dist::Zilla version 5.015, CPAN::Meta::Converter version 2.140640",
"license" : [
"perl_5"
],
@@ -101,7 +101,7 @@
"web" : "https://github.com/miyagawa/cpanminus"
}
},
- "version" : "1.7001",
+ "version" : "1.7004",
"x_contributors" : [
"Alessandro Ghedini <al3xbio at gmail.com>",
"Andrew Rodland <andrew at cleverdomain.org>",
@@ -109,12 +109,13 @@
"Ben Bullock <benkasminbullock at gmail.com>",
"Breno G. de Oliveira <garu at cpan.org>",
"Christian Walde <walde.christian at googlemail.com>",
- "Dagfinn Ilmari Manns\u00e5ker <ilmari at ilmari.org>",
+ "Dagfinn Ilmari Mannsåker <ilmari at ilmari.org>",
"Dave Goodell <davidjgoodell at gmail.com>",
"Dave Rolsky <autarch at urth.org>",
"David Golden <dagolden at cpan.org>",
"David Steinbrunner <dsteinbrunner at pobox.com>",
"Fuji, Goro <g.psy.va at gmail.com>",
+ "Graham Knop <haarg at haarg.org>",
"Ingy dot Net <ingy at ingy.net>",
"J. Nick Koston <nick at cpanel.net>",
"Jan Dubois <jand at activestate.com>",
@@ -155,6 +156,7 @@
"kmx <kmx at cpan.org>",
"lestrrat <lestrrat+github at gmail.com>",
"motemen <motemen at gmail.com>",
+ "moznion <moznion at gmail.com>",
"reezer <kind at gmx.at>",
"robario <webmaster at robario.com>",
"vti <viacheslav.t at gmail.com>",
diff --git a/META.yml b/META.yml
index e169123..60da14c 100644
--- a/META.yml
+++ b/META.yml
@@ -3,15 +3,15 @@ abstract: 'get, unpack, build and install modules from CPAN'
author:
- '- Tatsuhiko Miyagawa'
build_requires:
- Test::More: 0
+ Test::More: '0'
configure_requires:
- ExtUtils::MakeMaker: 6.30
+ ExtUtils::MakeMaker: '6.30'
dynamic_config: 0
-generated_by: 'Dist::Milla version v1.0.4, Dist::Zilla version 4.300038, CPAN::Meta::Converter version 2.132510'
+generated_by: 'Dist::Milla version v1.0.4, Dist::Zilla version 5.015, CPAN::Meta::Converter version 2.140640'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ version: '1.4'
name: App-cpanminus
no_index:
directory:
@@ -24,14 +24,14 @@ no_index:
file:
- lib/App/cpanminus/fatscript.pm
requires:
- ExtUtils::Install: 1.46
- ExtUtils::MakeMaker: 6.31
- Module::Build: 0.36
+ ExtUtils::Install: '1.46'
+ ExtUtils::MakeMaker: '6.31'
+ Module::Build: '0.36'
resources:
bugtracker: https://github.com/miyagawa/cpanminus/issues
homepage: https://github.com/miyagawa/cpanminus
repository: https://github.com/miyagawa/cpanminus.git
-version: 1.7001
+version: '1.7004'
x_contributors:
- 'Alessandro Ghedini <al3xbio at gmail.com>'
- 'Andrew Rodland <andrew at cleverdomain.org>'
@@ -45,6 +45,7 @@ x_contributors:
- 'David Golden <dagolden at cpan.org>'
- 'David Steinbrunner <dsteinbrunner at pobox.com>'
- 'Fuji, Goro <g.psy.va at gmail.com>'
+ - 'Graham Knop <haarg at haarg.org>'
- 'Ingy dot Net <ingy at ingy.net>'
- 'J. Nick Koston <nick at cpanel.net>'
- 'Jan Dubois <jand at activestate.com>'
@@ -85,6 +86,7 @@ x_contributors:
- 'kmx <kmx at cpan.org>'
- 'lestrrat <lestrrat+github at gmail.com>'
- 'motemen <motemen at gmail.com>'
+ - 'moznion <moznion at gmail.com>'
- 'reezer <kind at gmx.at>'
- 'robario <webmaster at robario.com>'
- 'vti <viacheslav.t at gmail.com>'
diff --git a/Makefile.PL b/Makefile.PL
index 00bdb3e..98d5b2b 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -1,4 +1,5 @@
+# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.015.
use strict;
use warnings;
@@ -29,37 +30,25 @@ my %WriteMakefileArgs = (
"TEST_REQUIRES" => {
"Test::More" => 0
},
- "VERSION" => "1.7001",
+ "VERSION" => "1.7004",
"test" => {
"TESTS" => "t/*.t"
}
);
-unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
- my $tr = delete $WriteMakefileArgs{TEST_REQUIRES};
- my $br = $WriteMakefileArgs{BUILD_REQUIRES};
- for my $mod ( keys %$tr ) {
- if ( exists $br->{$mod} ) {
- $br->{$mod} = $tr->{$mod} if $tr->{$mod} > $br->{$mod};
- }
- else {
- $br->{$mod} = $tr->{$mod};
- }
- }
-}
+my %FallbackPrereqs = (
+ "ExtUtils::Install" => "1.46",
+ "ExtUtils::MakeMaker" => "6.31",
+ "Module::Build" => "0.36",
+ "Test::More" => 0
+);
-unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) {
- my $br = delete $WriteMakefileArgs{BUILD_REQUIRES};
- my $pp = $WriteMakefileArgs{PREREQ_PM};
- for my $mod ( keys %$br ) {
- if ( exists $pp->{$mod} ) {
- $pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod};
- }
- else {
- $pp->{$mod} = $br->{$mod};
- }
- }
+
+unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
+ delete $WriteMakefileArgs{TEST_REQUIRES};
+ delete $WriteMakefileArgs{BUILD_REQUIRES};
+ $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
diff --git a/bin/cpanm b/bin/cpanm
index f99130d..1cfbec5 100644
--- a/bin/cpanm
+++ b/bin/cpanm
@@ -18,19 +18,19 @@ our $VERSION = "1.6928";
BEGIN {
my %fatpacked;
-$fatpacked{"App/cpanminus.pm"} = <<'APP_CPANMINUS';
- package App::cpanminus;our$VERSION="1.7001";1;
+$fatpacked{"App/cpanminus.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS';
+ package App::cpanminus;our$VERSION="1.7004";1;
APP_CPANMINUS
-$fatpacked{"App/cpanminus/CPANVersion.pm"} = <<'APP_CPANMINUS_CPANVERSION';
+$fatpacked{"App/cpanminus/CPANVersion.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS_CPANVERSION';
package App::cpanminus::CPANVersion;use strict;sub vcmp {my($self,$l,$r)=@_;local($^W)=0;return 0 if$l eq $r;for ($l,$r){s/_//g}for ($l,$r){next unless tr/.// > 1 || /^v/;s/^v?/v/;1 while s/\.0+(\d)/.$1/}if ($l=~/^v/ <=> $r=~/^v/){for ($l,$r){next if /^v/;$_=$self->float2vv($_)}}my$lvstring="v0";my$rvstring="v0";if ($] >= 5.006 && $l =~ /^v/ && $r =~ /^v/){$lvstring=$self->vstring($l);$rvstring=$self->vstring($r)}return (($l ne "undef")<=> ($r ne "undef")|| $lvstring cmp $rvstring || $ [...]
APP_CPANMINUS_CPANVERSION
-$fatpacked{"App/cpanminus/Dependency.pm"} = <<'APP_CPANMINUS_DEPENDENCY';
+$fatpacked{"App/cpanminus/Dependency.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS_DEPENDENCY';
package App::cpanminus::Dependency;use strict;use CPAN::Meta::Requirements;sub from_prereqs {my($class,$prereq,$phases,$types)=@_;my at deps;for my$type (@$types){my$req=CPAN::Meta::Requirements->new;$req->add_requirements($prereq->requirements_for($_,$type))for @$phases;push at deps,$class->from_versions($req->as_string_hash,$type)}return at deps}sub from_versions {my($class,$versions,$type)=@_;my at deps;while (my($module,$version)=each %$versions){push at deps,$class->new($module,$version,$type)}@ [...]
APP_CPANMINUS_DEPENDENCY
-$fatpacked{"App/cpanminus/ParsePM.pm"} = <<'APP_CPANMINUS_PARSEPM';
+$fatpacked{"App/cpanminus/ParsePM.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS_PARSEPM';
package App::cpanminus::ParsePM;use strict;use warnings;use Safe;use JSON::PP;use Dumpvalue;use version ();use File::Spec ();use File::Temp ();use POSIX ':sys_wait_h';use App::cpanminus::CPANVersion;our$VERSION='0.04';our$VERBOSE=0;our$ALLOW_DEV_VERSION=0;sub new {my ($class,$meta)=@_;bless {META_CONTENT=>$meta},$class}sub parse {my ($self,$pmfile)=@_;$pmfile =~ s|\\|/|g;my($filemtime)=(stat$pmfile)[9];$self->{MTIME}=$filemtime;$self->{PMFILE}=$pmfile;unless ($self->_version_from_meta_ [...]
read the file. It issued the following error: C< $err->{r} >},)}else {$self->_verbose(1,qq{Parse::PMFile was not able to
parse the following line in that file: C< $err->{line} >
@@ -60,8 +60,8 @@ $fatpacked{"App/cpanminus/ParsePM.pm"} = <<'APP_CPANMINUS_PARSEPM';
};local $^W=0;local$SIG{__WARN__}=sub {};$result=eval($eval);if ($@ or!defined$result){die +{eval=>$eval,line=>$current_parsed_line,file=>$parsefile,err=>$@,}}last}close FH;$result="undef" unless defined$result;return$result}}sub _filter_ppps {my($self, at ppps)=@_;my at res;MANI: for my$ppp (@ppps){if ($self->{META_CONTENT}){my$no_index=$self->{META_CONTENT}{no_index}|| $self->{META_CONTENT}{private};if (ref($no_index)eq 'HASH'){my%map=(package=>qr{\z},namespace=>qr{::},);for my$k (qw [...]
APP_CPANMINUS_PARSEPM
-$fatpacked{"App/cpanminus/script.pm"} = <<'APP_CPANMINUS_SCRIPT';
- package App::cpanminus::script;use strict;use Config;use Cwd ();use App::cpanminus;use File::Basename ();use File::Find ();use File::Path ();use File::Spec ();use File::Copy ();use File::Temp ();use Getopt::Long ();use Parse::CPAN::Meta;use Symbol ();use String::ShellQuote ();use version ();use aliased 'App::cpanminus::Dependency';use constant WIN32=>$^O eq 'MSWin32';use constant SUNOS=>$^O eq 'solaris';use constant CAN_SYMLINK=>eval {symlink("","");1};our$VERSION=$App::cpanminus::VERS [...]
+$fatpacked{"App/cpanminus/script.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS_SCRIPT';
+ package App::cpanminus::script;use strict;use Config;use Cwd ();use App::cpanminus;use File::Basename ();use File::Find ();use File::Path ();use File::Spec ();use File::Copy ();use File::Temp ();use Getopt::Long ();use Parse::CPAN::Meta;use Symbol ();use String::ShellQuote ();use version ();use aliased 'App::cpanminus::Dependency';use constant WIN32=>$^O eq 'MSWin32';use constant SUNOS=>$^O eq 'solaris';use constant CAN_SYMLINK=>eval {symlink("","");1};our$VERSION=$App::cpanminus::VERS [...]
It appears your cpanm executable was installed via `perlbrew install-cpanm`.
cpanm --self-upgrade won't upgrade the version of cpanm you're running.
@@ -162,7 +162,7 @@ $fatpacked{"App/cpanminus/script.pm"} = <<'APP_CPANMINUS_SCRIPT';
DIAG
APP_CPANMINUS_SCRIPT
-$fatpacked{"CPAN/DistnameInfo.pm"} = <<'CPAN_DISTNAMEINFO';
+$fatpacked{"CPAN/DistnameInfo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_DISTNAMEINFO';
package CPAN::DistnameInfo;$VERSION="0.12";use strict;sub distname_info {my$file=shift or return;my ($dist,$version)=$file =~ /^
((?:[-+.]*(?:[A-Za-z0-9]+|(?<=\D)_|_(?=\D))*
(?:
@@ -174,45 +174,45 @@ $fatpacked{"CPAN/DistnameInfo.pm"} = <<'CPAN_DISTNAMEINFO';
$/xs or return ($file,undef,undef);if ($dist =~ /-undef\z/ and!length$version){$dist =~ s/-undef\z//}$version =~ s/-withoutworldwriteables$//;if ($version =~ /^(-[Vv].*)-(\d.*)/){$dist .= $1;$version=$2}if ($version =~ /(.+_.*)-(\d.*)/){$dist .= $1;$version=$2}$dist =~ s{\.pm$}{};$version=$1 if!length$version and $dist =~ s/-(\d+\w)$//;$version=$1 .$version if$version =~ /^\d+$/ and $dist =~ s/-(\w+)$//;if ($version =~ /\d\.\d/){$version =~ s/^[-_.]+//}else {$version =~ s/^[-_]+//}my [...]
CPAN_DISTNAMEINFO
-$fatpacked{"CPAN/Meta.pm"} = <<'CPAN_META';
+$fatpacked{"CPAN/Meta.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META';
use 5.006;use strict;use warnings;package CPAN::Meta;our$VERSION='2.132510';use Carp qw(carp croak);use CPAN::Meta::Feature;use CPAN::Meta::Prereqs;use CPAN::Meta::Converter;use CPAN::Meta::Validator;use Parse::CPAN::Meta 1.4403 ();BEGIN {*_dclone=\&CPAN::Meta::Converter::_dclone}BEGIN {my at STRING_READERS=qw(abstract description dynamic_config generated_by name release_status version);no strict 'refs';for my$attr (@STRING_READERS){*$attr=sub {$_[0]{$attr }}}}BEGIN {my at LIST_READERS=qw(au [...]
CPAN_META
-$fatpacked{"CPAN/Meta/Check.pm"} = <<'CPAN_META_CHECK';
+$fatpacked{"CPAN/Meta/Check.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_CHECK';
package CPAN::Meta::Check;{$CPAN::Meta::Check::VERSION='0.007'}use strict;use warnings;use Exporter 5.57 'import';our at EXPORT=qw//;our at EXPORT_OK=qw/check_requirements requirements_for verify_dependencies/;our%EXPORT_TAGS=(all=>[@EXPORT, at EXPORT_OK ]);use CPAN::Meta::Requirements 2.120920;use Module::Metadata;sub _check_dep {my ($reqs,$module,$dirs)=@_;my$version=$module eq 'perl' ? $] : do {my$metadata=Module::Metadata->new_from_module($module,inc=>$dirs);return "Module '$module' is not [...]
CPAN_META_CHECK
-$fatpacked{"CPAN/Meta/Converter.pm"} = <<'CPAN_META_CONVERTER';
+$fatpacked{"CPAN/Meta/Converter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_CONVERTER';
use 5.006;use strict;use warnings;package CPAN::Meta::Converter;our$VERSION='2.132510';use CPAN::Meta::Validator;use CPAN::Meta::Requirements;use version 0.88 ();use Parse::CPAN::Meta 1.4400 ();sub _dclone {my$ref=shift;no warnings 'once';local*UNIVERSAL::TO_JSON=sub {return "$_[0]"};my$backend=Parse::CPAN::Meta->json_backend();return$backend->new->utf8->decode($backend->new->utf8->allow_blessed->convert_blessed->encode($ref))}my%known_specs=('2'=>'http://search.cpan.org/perldoc?CPAN:: [...]
(?:x-?)? # Remove leading x- or x (if present)
/x_/ix;return$key}sub _ucfirst_custom {my$key=shift;$key=ucfirst$key unless$key =~ /[A-Z]/;return$key}sub _no_prefix_ucfirst_custom {my$key=shift;$key =~ s/^x_//;return _ucfirst_custom($key)}sub _change_meta_spec {my ($element,undef,undef,$version)=@_;$element->{version}=$version;$element->{url}=$known_specs{$version};return$element}my at valid_licenses_1=('perl','gpl','apache','artistic','artistic_2','lgpl','bsd','gpl','mit','mozilla','open_source','unrestricted','restrictive' [...]
CPAN_META_CONVERTER
-$fatpacked{"CPAN/Meta/Feature.pm"} = <<'CPAN_META_FEATURE';
+$fatpacked{"CPAN/Meta/Feature.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_FEATURE';
use 5.006;use strict;use warnings;package CPAN::Meta::Feature;our$VERSION='2.132510';use CPAN::Meta::Prereqs;sub new {my ($class,$identifier,$spec)=@_;my%guts=(identifier=>$identifier,description=>$spec->{description},prereqs=>CPAN::Meta::Prereqs->new($spec->{prereqs}),);bless \%guts=>$class}sub identifier {$_[0]{identifier}}sub description {$_[0]{description}}sub prereqs {$_[0]{prereqs}}1;
CPAN_META_FEATURE
-$fatpacked{"CPAN/Meta/History.pm"} = <<'CPAN_META_HISTORY';
+$fatpacked{"CPAN/Meta/History.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_HISTORY';
use 5.006;use strict;use warnings;package CPAN::Meta::History;our$VERSION='2.132510';1;
CPAN_META_HISTORY
-$fatpacked{"CPAN/Meta/Prereqs.pm"} = <<'CPAN_META_PREREQS';
+$fatpacked{"CPAN/Meta/Prereqs.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_PREREQS';
use 5.006;use strict;use warnings;package CPAN::Meta::Prereqs;our$VERSION='2.132510';use Carp qw(confess);use Scalar::Util qw(blessed);use CPAN::Meta::Requirements 2.121;sub __legal_phases {qw(configure build test runtime develop)}sub __legal_types {qw(requires recommends suggests conflicts)}sub new {my ($class,$prereq_spec)=@_;$prereq_spec ||={};my%is_legal_phase=map {;$_=>1}$class->__legal_phases;my%is_legal_type=map {;$_=>1}$class->__legal_types;my%guts;PHASE: for my$phase (keys %$p [...]
CPAN_META_PREREQS
-$fatpacked{"CPAN/Meta/Requirements.pm"} = <<'CPAN_META_REQUIREMENTS';
+$fatpacked{"CPAN/Meta/Requirements.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_REQUIREMENTS';
use strict;use warnings;package CPAN::Meta::Requirements;our$VERSION='2.123';use Carp ();use Scalar::Util ();use version 0.77 ();my at valid_options=qw(bad_version_hook);sub new {my ($class,$options)=@_;$options ||={};Carp::croak "Argument to $class\->new() must be a hash reference" unless ref$options eq 'HASH';my%self=map {;$_=>$options->{$_}}@valid_options;return bless \%self=>$class}sub _version_object {my ($self,$version)=@_;my$vobj;eval {$vobj=(!defined$version)? version->parse(0): ( [...]
CPAN_META_REQUIREMENTS
-$fatpacked{"CPAN/Meta/Spec.pm"} = <<'CPAN_META_SPEC';
+$fatpacked{"CPAN/Meta/Spec.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_SPEC';
use 5.006;use strict;use warnings;package CPAN::Meta::Spec;our$VERSION='2.132510';1;
CPAN_META_SPEC
-$fatpacked{"CPAN/Meta/Validator.pm"} = <<'CPAN_META_VALIDATOR';
+$fatpacked{"CPAN/Meta/Validator.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_VALIDATOR';
use 5.006;use strict;use warnings;package CPAN::Meta::Validator;our$VERSION='2.132510';my%known_specs=('1.4'=>'http://module-build.sourceforge.net/META-spec-v1.4.html','1.3'=>'http://module-build.sourceforge.net/META-spec-v1.3.html','1.2'=>'http://module-build.sourceforge.net/META-spec-v1.2.html','1.1'=>'http://module-build.sourceforge.net/META-spec-v1.1.html','1.0'=>'http://module-build.sourceforge.net/META-spec-v1.0.html');my%known_urls=map {$known_specs{$_}=>$_}keys%known_specs;my$m [...]
CPAN_META_VALIDATOR
-$fatpacked{"CPAN/Meta/YAML.pm"} = <<'CPAN_META_YAML';
+$fatpacked{"CPAN/Meta/YAML.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_YAML';
package CPAN::Meta::YAML;{$CPAN::Meta::YAML::VERSION='0.008'}use strict;sub HAVE_UTF8 () {$] >= 5.007003}BEGIN {if (HAVE_UTF8){eval "require utf8;";die "Failed to load UTF-8 support" if $@}require 5.004;require Exporter;require Carp;@CPAN::Meta::YAML::ISA=qw{Exporter};@CPAN::Meta::YAML::EXPORT=qw{Load Dump};@CPAN::Meta::YAML::EXPORT_OK=qw{LoadFile DumpFile freeze thaw};$CPAN::Meta::YAML::errstr=''}my at UNPRINTABLE=qw(z x01 x02 x03 x04 x05 x06 a x08 t n v f r x0e x0f x10 x11 x12 x13 x14 x [...]
# Scalar::Util failed to load or too old
sub refaddr {
@@ -230,20 +230,20 @@ $fatpacked{"CPAN/Meta/YAML.pm"} = <<'CPAN_META_YAML';
END_PERL
CPAN_META_YAML
-$fatpacked{"Exporter.pm"} = <<'EXPORTER';
+$fatpacked{"Exporter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER';
package Exporter;require 5.006;our$Debug=0;our$ExportLevel=0;our$Verbose ||=0;our$VERSION='5.68';our (%Cache);sub as_heavy {require Exporter::Heavy;my$c=(caller(1))[3];$c =~ s/.*:://;\&{"Exporter::Heavy::heavy_$c"}}sub export {goto &{as_heavy()}}sub import {my$pkg=shift;my$callpkg=caller($ExportLevel);if ($pkg eq "Exporter" and @_ and $_[0]eq "import"){*{$callpkg."::import"}=\&import;return}my$exports=\@{"$pkg\::EXPORT"};my$fail=${$pkg .'::'}{EXPORT_FAIL}&& \@{"$pkg\::EXPORT_FAIL"};ret [...]
EXPORTER
-$fatpacked{"Exporter/Heavy.pm"} = <<'EXPORTER_HEAVY';
+$fatpacked{"Exporter/Heavy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER_HEAVY';
package Exporter::Heavy;use strict;no strict 'refs';require Exporter;our$VERSION=$Exporter::VERSION;sub _rebuild_cache {my ($pkg,$exports,$cache)=@_;s/^&// foreach @$exports;@{$cache}{@$exports}=(1)x @$exports;my$ok=\@{"${pkg}::EXPORT_OK"};if (@$ok){s/^&// foreach @$ok;@{$cache}{@$ok}=(1)x @$ok}}sub heavy_export {local$SIG{__WARN__}=sub {my$text=shift;if ($text =~ s/ at \S*Exporter\S*.pm line \d+.*\n//){require Carp;local$Carp::CarpLevel=1;Carp::carp($text)}else {warn$text}};local$SIG{ [...]
EXPORTER_HEAVY
-$fatpacked{"File/pushd.pm"} = <<'FILE_PUSHD';
+$fatpacked{"File/pushd.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_PUSHD';
use strict;use warnings;package File::pushd;our$VERSION='1.005';our at EXPORT=qw(pushd tempd);our at ISA=qw(Exporter);use Exporter;use Carp;use Cwd qw(getcwd abs_path);use File::Path qw(rmtree);use File::Temp qw();use File::Spec;use overload q{""}=>sub {File::Spec->canonpath($_[0]->{_pushd})},fallback=>1;sub pushd {my ($target_dir,$options)=@_;$options->{untaint_pattern}||=qr{^([-+@\w./]+)$};$target_dir="." unless defined$target_dir;croak "Can't locate directory $target_dir" unless -d $targe [...]
FILE_PUSHD
-$fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
- package HTTP::Tiny;use strict;use warnings;our$VERSION='0.034';use Carp ();my at attributes;BEGIN {@attributes=qw(cookie_jar default_headers local_address max_redirect max_size proxy no_proxy timeout SSL_options verify_SSL);no strict 'refs';for my$accessor (@attributes){*{$accessor}=sub {@_ > 1 ? $_[0]->{$accessor}=$_[1]: $_[0]->{$accessor}}}}sub agent {my($self,$agent)=@_;if(@_ > 1){$self->{agent}=(defined$agent && $agent =~ / $/)? $agent .$self->_agent : $agent}return$self->{agent}}sub [...]
+$fatpacked{"HTTP/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINY';
+ package HTTP::Tiny;use strict;use warnings;our$VERSION='0.043';use Carp ();my at attributes;BEGIN {@attributes=qw(cookie_jar default_headers http_proxy https_proxy keep_alive local_address max_redirect max_size proxy no_proxy timeout SSL_options verify_SSL);my%persist_ok=map {;$_=>1}qw(cookie_jar default_headers max_redirect max_size);no strict 'refs';no warnings 'uninitialized';for my$accessor (@attributes){*{$accessor}=sub {@_ > 1 ? do {delete $_[0]->{handle}if!$persist_ok{$accessor}&& [...]
sub $sub_name {
my (\$self, \$url, \$args) = \@_;
\@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH')
@@ -253,8 +253,8 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
HERE
HTTP_TINY
-$fatpacked{"JSON/PP.pm"} = <<'JSON_PP';
- package JSON::PP;use 5.005;use strict;use base qw(Exporter);use overload ();use Carp ();use B ();$JSON::PP::VERSION='2.27202';@JSON::PP::EXPORT=qw(encode_json decode_json from_json to_json);use constant P_ASCII=>0;use constant P_LATIN1=>1;use constant P_UTF8=>2;use constant P_INDENT=>3;use constant P_CANONICAL=>4;use constant P_SPACE_BEFORE=>5;use constant P_SPACE_AFTER=>6;use constant P_ALLOW_NONREF=>7;use constant P_SHRINK=>8;use constant P_ALLOW_BLESSED=>9;use constant P_CONVERT_BLE [...]
+$fatpacked{"JSON/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_PP';
+ package JSON::PP;use 5.005;use strict;use base qw(Exporter);use overload ();use Carp ();use B ();$JSON::PP::VERSION='2.27203';@JSON::PP::EXPORT=qw(encode_json decode_json from_json to_json);use constant P_ASCII=>0;use constant P_LATIN1=>1;use constant P_UTF8=>2;use constant P_INDENT=>3;use constant P_CANONICAL=>4;use constant P_SPACE_BEFORE=>5;use constant P_SPACE_AFTER=>6;use constant P_ALLOW_NONREF=>7;use constant P_SHRINK=>8;use constant P_ALLOW_BLESSED=>9;use constant P_CONVERT_BLE [...]
sub $name {
my \$enable = defined \$_[1] ? \$_[1] : 1;
@@ -298,18 +298,18 @@ $fatpacked{"JSON/PP.pm"} = <<'JSON_PP';
}
$_[0]->{_incr_parser}->{incr_text};
}
- } if ($] >= 5.006)}BEGIN {eval 'require Scalar::Util';unless($@){*JSON::PP::blessed=\&Scalar::Util::blessed;*JSON::PP::reftype=\&Scalar::Util::reftype;*JSON::PP::refaddr=\&Scalar::Util::refaddr}else{eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';*JSON::PP::blessed=sub {local($@,$SIG{__DIE__},$SIG{__WARN__});ref($_[0])? eval {$_[0]->a_sub_not_likely_to_be_here}: undef};my%tmap=qw(B::NULL SCALAR B::HV HASH B::AV ARRAY B::CV CODE B::IO IO B::GV GLOB B::REGEXP REGEXP) [...]
+ } if ($] >= 5.006)}BEGIN {eval 'require Scalar::Util';unless($@){*JSON::PP::blessed=\&Scalar::Util::blessed;*JSON::PP::reftype=\&Scalar::Util::reftype;*JSON::PP::refaddr=\&Scalar::Util::refaddr}else{eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';*JSON::PP::blessed=sub {local($@,$SIG{__DIE__},$SIG{__WARN__});ref($_[0])? eval {$_[0]->a_sub_not_likely_to_be_here}: undef};my%tmap=qw(B::NULL SCALAR B::HV HASH B::AV ARRAY B::CV CODE B::IO IO B::GV GLOB B::REGEXP REGEXP) [...]
JSON_PP
-$fatpacked{"JSON/PP/Boolean.pm"} = <<'JSON_PP_BOOLEAN';
+$fatpacked{"JSON/PP/Boolean.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_PP_BOOLEAN';
use JSON::PP ();use strict;1;
JSON_PP_BOOLEAN
-$fatpacked{"Module/CPANfile.pm"} = <<'MODULE_CPANFILE';
+$fatpacked{"Module/CPANfile.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE';
package Module::CPANfile;use strict;use warnings;use Cwd;use Carp ();use Module::CPANfile::Environment;use Module::CPANfile::Result;our$VERSION='1.0002';sub new {my($class,$file)=@_;bless {},$class}sub load {my($proto,$file)=@_;my$self=ref$proto ? $proto : $proto->new;$self->parse($file || Cwd::abs_path('cpanfile'));$self}sub save {my($self,$path)=@_;open my$out,">",$path or die "$path: $!";print {$out}$self->to_string}sub parse {my($self,$file)=@_;my$code=do {open my$fh,"<",$file or d [...]
MODULE_CPANFILE
-$fatpacked{"Module/CPANfile/Environment.pm"} = <<'MODULE_CPANFILE_ENVIRONMENT';
+$fatpacked{"Module/CPANfile/Environment.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE_ENVIRONMENT';
package Module::CPANfile::Environment;use strict;use warnings;use Module::CPANfile::Result;use Carp ();my at bindings=qw(on requires recommends suggests conflicts feature osname configure_requires build_requires test_requires author_requires);my$file_id=1;sub new {my($class,$file)=@_;bless {file=>$file,},$class}sub bind {my$class=shift;my$pkg=caller;my$result=Module::CPANfile::Result->new;for my$binding (@bindings){no strict 'refs';*{"$pkg\::$binding"}=sub {$result->$binding(@_)}}return$r [...]
package Module::CPANfile::Sandbox$file_id;
no warnings;
@@ -323,12 +323,12 @@ $fatpacked{"Module/CPANfile/Environment.pm"} = <<'MODULE_CPANFILE_ENVIRONMENT';
EVAL
MODULE_CPANFILE_ENVIRONMENT
-$fatpacked{"Module/CPANfile/Result.pm"} = <<'MODULE_CPANFILE_RESULT';
+$fatpacked{"Module/CPANfile/Result.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE_RESULT';
package Module::CPANfile::Result;use strict;sub from_prereqs {my($class,$spec)=@_;bless {phase=>'runtime',spec=>$spec,},$class}sub new {bless {phase=>'runtime',features=>{},feature=>undef,spec=>{},},shift}sub on {my($self,$phase,$code)=@_;local$self->{phase}=$phase;$code->()}sub feature {my($self,$identifier,$description,$code)=@_;if (@_==3 && ref($description)eq 'CODE'){$code=$description;$description=$identifier}unless (ref$description eq '' && ref$code eq 'CODE'){Carp::croak("Usage: [...]
MODULE_CPANFILE_RESULT
-$fatpacked{"Module/Metadata.pm"} = <<'MODULE_METADATA';
- package Module::Metadata;use strict;use vars qw($VERSION);$VERSION='1.000016';$VERSION=eval$VERSION;use Carp qw/croak/;use File::Spec;use IO::File;use version 0.87;BEGIN {if ($INC{'Log/Contextual.pm'}){Log::Contextual->import('log_info')}else {*log_info=sub (&) {warn $_[0]->()}}}use File::Find qw(find);my$V_NUM_REGEXP=qr{v?[0-9._]+};my$PKG_FIRST_WORD_REGEXP=qr{ # the FIRST word in a package name
+$fatpacked{"Module/Metadata.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_METADATA';
+ package Module::Metadata;use strict;use warnings;our$VERSION='1.000019';$VERSION=eval$VERSION;use Carp qw/croak/;use File::Spec;use IO::File;use version 0.87;BEGIN {if ($INC{'Log/Contextual.pm'}){Log::Contextual->import('log_info')}else {*log_info=sub (&) {warn $_[0]->()}}}use File::Find qw(find);my$V_NUM_REGEXP=qr{v?[0-9._]+};my$PKG_FIRST_WORD_REGEXP=qr{ # the FIRST word in a package name
[a-zA-Z_] # the first word CANNOT start with a digit
(?:
[\w']? # can contain letters, digits, _, or ticks
@@ -363,7 +363,7 @@ $fatpacked{"Module/Metadata.pm"} = <<'MODULE_METADATA';
([\$*]) # sigil - $ or *
(
( # optional leading package name
- (?:::|\')? # possibly starting like just :: (� la $::VERSION)
+ (?:::|\')? # possibly starting like just :: (a la $::VERSION)
(?:\w+(?:::|\'))* # Foo::Bar:: ...
)?
VERSION
@@ -376,10 +376,11 @@ $fatpacked{"Module/Metadata.pm"} = <<'MODULE_METADATA';
)
\s*
=[^=~] # = but not ==, nor =~
- }x;sub new_from_file {my$class=shift;my$filename=File::Spec->rel2abs(shift);return undef unless defined($filename)&& -f $filename;return$class->_init(undef,$filename, at _)}sub new_from_handle {my$class=shift;my$handle=shift;my$filename=shift;return undef unless defined($handle)&& defined($filename);$filename=File::Spec->rel2abs($filename);return$class->_init(undef,$filename, at _,handle=>$handle)}sub new_from_module {my$class=shift;my$module=shift;my%props=@_;$props{inc}||=\@INC;my$filename [...]
+ }x;sub new_from_file {my$class=shift;my$filename=File::Spec->rel2abs(shift);return undef unless defined($filename)&& -f $filename;return$class->_init(undef,$filename, at _)}sub new_from_handle {my$class=shift;my$handle=shift;my$filename=shift;return undef unless defined($handle)&& defined($filename);$filename=File::Spec->rel2abs($filename);return$class->_init(undef,$filename, at _,handle=>$handle)}sub new_from_module {my$class=shift;my$module=shift;my%props=@_;$props{inc}||=\@INC;my$filename [...]
#; package Module::Metadata::_version::p$pn;
use version;
no strict;
+ no warnings;
\$vsub = sub {
local $sigil$var;
@@ -387,27 +388,27 @@ $fatpacked{"Module/Metadata.pm"} = <<'MODULE_METADATA';
$line;
\$$var
};
- }};local $^W;eval$eval;if ($@ =~ /Can't locate/ && -d 'lib'){local at INC=('lib', at INC);eval$eval}warn "Error evaling version line '$eval' in $self->{filename}: $@\n" if $@;(ref($vsub)eq 'CODE')or croak "failed to build version sub for $self->{filename}";my$result=eval {$vsub->()};croak "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n" if $@;my$version=eval {_dwim_version($result)};croak "Version '$result' from $self->{filename} does not app [...]
+ }};$eval=$1 if$eval =~ m{^(.+)}s;local $^W;eval$eval;if ($@ =~ /Can't locate/ && -d 'lib'){local at INC=('lib', at INC);eval$eval}warn "Error evaling version line '$eval' in $self->{filename}: $@\n" if $@;(ref($vsub)eq 'CODE')or croak "failed to build version sub for $self->{filename}";my$result=eval {$vsub->()};croak "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n" if $@;my$version=eval {_dwim_version($result)};croak "Version '$result' from [...]
MODULE_METADATA
-$fatpacked{"Parse/CPAN/Meta.pm"} = <<'PARSE_CPAN_META';
+$fatpacked{"Parse/CPAN/Meta.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARSE_CPAN_META';
use strict;package Parse::CPAN::Meta;our$VERSION='1.4407';use Carp 'croak';sub HAVE_UTF8 () {$] >= 5.007003}sub IO_LAYER () {$] >= 5.008001 ? ":utf8" : ""}BEGIN {if (HAVE_UTF8){eval "require utf8;";die "Failed to load UTF-8 support" if $@}require 5.004;require Exporter;@Parse::CPAN::Meta::ISA=qw{Exporter};@Parse::CPAN::Meta::EXPORT_OK=qw{Load LoadFile}}sub load_file {my ($class,$filename)=@_;if ($filename =~ /\.ya?ml$/){return$class->load_yaml_string(_slurp($filename))}if ($filename =~ [...]
PARSE_CPAN_META
-$fatpacked{"String/ShellQuote.pm"} = <<'STRING_SHELLQUOTE';
+$fatpacked{"String/ShellQuote.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'STRING_SHELLQUOTE';
package String::ShellQuote;use strict;use vars qw($VERSION @ISA @EXPORT);require Exporter;$VERSION='1.04';@ISA=qw(Exporter);@EXPORT=qw(shell_quote shell_quote_best_effort shell_comment_quote);sub croak {require Carp;goto&Carp::croak}sub _shell_quote_backend {my at in=@_;my at err=();if (0){require RS::Handy;print RS::Handy::data_dump(\@in)}return \@err,'' unless at in;my$ret='';my$saw_non_equal=0;for (@in){if (!defined $_ or $_ eq ''){$_="''";next}if (s/\x00//g){push at err,"No way to quote string [...]
STRING_SHELLQUOTE
-$fatpacked{"aliased.pm"} = <<'ALIASED';
+$fatpacked{"aliased.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ALIASED';
package aliased;our$VERSION='0.31';$VERSION=eval$VERSION;require Exporter;@ISA=qw(Exporter);@EXPORT=qw(alias prefix);use strict;sub _croak {require Carp;Carp::croak(@_)}sub import {my ($class,$package,$alias, at import)=@_;if (@_ <= 1){$class->export_to_level(1);return}my$callpack=caller(0);_load_alias($package,$callpack, at import);_make_alias($package,$callpack,$alias)}sub _get_alias {my$package=shift;$package =~ s/.*(?:::|')//;return$package}sub _make_alias {my ($package,$callpack,$alias) [...]
ALIASED
-$fatpacked{"lib/core/only.pm"} = <<'LIB_CORE_ONLY';
+$fatpacked{"lib/core/only.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LIB_CORE_ONLY';
package lib::core::only;use strict;use warnings FATAL=>'all';use Config;sub import {@INC=@Config{qw(privlibexp archlibexp)};return}1;
LIB_CORE_ONLY
-$fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
- use strict;use warnings;package local::lib;use 5.008001;use File::Spec ();use File::Path ();use Config;our$VERSION='1.008011';our at KNOWN_FLAGS=qw(--self-contained --deactivate --deactivate-all);sub DEACTIVATE_ONE () {1}sub DEACTIVATE_ALL () {2}sub INTERPOLATE_ENV () {1}sub LITERAL_ENV () {0}sub import {my ($class, at args)=@_;my$perl5lib=$ENV{PERL5LIB}|| '';my%arg_store;for my$arg (@args){if ($arg =~ /−/){die <<'DEATH'}elsif(grep {$arg eq $_}@KNOWN_FLAGS){(my$flag=$arg)=~ s/--//;$arg_store [...]
+$fatpacked{"local/lib.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOCAL_LIB';
+ package local::lib;use 5.006;use strict;use warnings;use Config;use File::Spec ();our$VERSION='2.000008';$VERSION=eval$VERSION;sub import {my ($class, at args)=@_;push at args, at ARGV if $0 eq '-';my at steps;my%opts;my$shelltype;while (@args){my$arg=shift at args;if ($arg =~ /\xE2\x88\x92/ or $arg =~ /−/){die <<'DEATH'}elsif ($arg eq '--self-contained'){die <<'DEATH'}elsif($arg =~ /^--deactivate(?:=(.*))?$/){my$path=defined $1 ? $1 : shift at args;push at steps,['deactivate',$path]}elsif ($arg eq '--deac [...]
WHOA THERE! It looks like you've got some fancy dashes in your commandline!
These are *not* the traditional -- dashes that software recognizes. You
probably got these by copy-pasting from the perldoc for this module as
@@ -415,48 +416,79 @@ $fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
terminal, but can happen elsewhere too. Please try again after replacing the
dashes with normal minus signs.
DEATH
+ FATAL: The local::lib --self-contained flag has never worked reliably and the
+ original author, Mark Stosberg, was unable or unwilling to maintain it. As
+ such, this flag has been removed from the local::lib codebase in order to
+ prevent misunderstandings and potentially broken builds. The local::lib authors
+ recommend that you look at the lib::core::only module shipped with this
+ distribution in order to create a more robust environment that is equivalent to
+ what --self-contained provided (although quite possibly not what you originally
+ thought it provided due to the poor quality of the documentation, for which we
+ apologise).
+ DEATH
LOCAL_LIB
-$fatpacked{"version.pm"} = <<'VERSION';
- package version;use 5.005_04;use strict;use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);$VERSION=0.9902;$CLASS='version';my$FRACTION_PART=qr/\.[0-9]+/;my$STRICT_INTEGER_PART=qr/0|[1-9][0-9]*/;my$LAX_INTEGER_PART=qr/[0-9]+/;my$STRICT_DOTTED_DECIMAL_PART=qr/\.[0-9]{1,3}/;my$LAX_DOTTED_DECIMAL_PART=qr/\.[0-9]+/;my$LAX_ALPHA_PART=qr/_[0-9]+/;my$STRICT_DECIMAL_VERSION=qr/ $STRICT_INTEGER_PART $FRACTION_PART? /x;my$STRICT_DOTTED_DECIMAL_VERSION=qr/ v $STRICT_INTEGER_PART $STRICT_ [...]
+$fatpacked{"parent.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARENT';
+ package parent;use strict;use vars qw($VERSION);$VERSION='0.225';sub import {my$class=shift;my$inheritor=caller(0);if (@_ and $_[0]eq '-norequire'){shift @_}else {for (my at filename=@_){if ($_ eq $inheritor){warn "Class '$inheritor' tried to inherit from itself\n"};s{::|'}{/}g;require "$_.pm"}}{no strict 'refs';push @{"$inheritor\::ISA"}, at _}};"All your base are belong to us"
+PARENT
+
+$fatpacked{"version.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'VERSION';
+ package version;use 5.006002;use strict;use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);$VERSION=0.9908;$CLASS='version';{local$SIG{'__DIE__'};eval "use version::vxs $VERSION";if ($@){eval "use version::vpp $VERSION";die "$@" if ($@);push at ISA,"version::vpp";local $^W;*version::qv=\&version::vpp::qv;*version::declare=\&version::vpp::declare;*version::_VERSION=\&version::vpp::_VERSION;*version::vcmp=\&version::vpp::vcmp;*version::new=\&version::vpp::new;if ($] >= 5.009000){no [...]
+VERSION
+
+$fatpacked{"version/regex.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'VERSION_REGEX';
+ package version::regex;use strict;use vars qw($VERSION $CLASS $STRICT $LAX);$VERSION=0.9908;my$FRACTION_PART=qr/\.[0-9]+/;my$STRICT_INTEGER_PART=qr/0|[1-9][0-9]*/;my$LAX_INTEGER_PART=qr/[0-9]+/;my$STRICT_DOTTED_DECIMAL_PART=qr/\.[0-9]{1,3}/;my$LAX_DOTTED_DECIMAL_PART=qr/\.[0-9]+/;my$LAX_ALPHA_PART=qr/_[0-9]+/;my$STRICT_DECIMAL_VERSION=qr/ $STRICT_INTEGER_PART $FRACTION_PART? /x;my$STRICT_DOTTED_DECIMAL_VERSION=qr/ v $STRICT_INTEGER_PART $STRICT_DOTTED_DECIMAL_PART{2,} /x;$STRICT=qr/ $S [...]
|
$FRACTION_PART $LAX_ALPHA_PART?
/x;my$LAX_DOTTED_DECIMAL_VERSION=qr/
v $LAX_INTEGER_PART (?: $LAX_DOTTED_DECIMAL_PART+ $LAX_ALPHA_PART? )?
|
$LAX_INTEGER_PART? $LAX_DOTTED_DECIMAL_PART{2,} $LAX_ALPHA_PART?
- /x;$LAX=qr/ undef | $LAX_DECIMAL_VERSION | $LAX_DOTTED_DECIMAL_VERSION /x;{local$SIG{'__DIE__'};eval "use version::vxs $VERSION";if ($@){eval "use version::vpp $VERSION";die "$@" if ($@);push at ISA,"version::vpp";local $^W;*version::qv=\&version::vpp::qv;*version::declare=\&version::vpp::declare;*version::_VERSION=\&version::vpp::_VERSION;*version::vcmp=\&version::vpp::vcmp;*version::new=\&version::vpp::new;if ($] >= 5.009000){no strict 'refs';*version::stringify=\&version::vpp::stri [...]
-VERSION
+ /x;$LAX=qr/ undef | $LAX_DECIMAL_VERSION | $LAX_DOTTED_DECIMAL_VERSION /x;sub is_strict {defined $_[0]&& $_[0]=~ qr/ \A $STRICT \z /x}sub is_lax {defined $_[0]&& $_[0]=~ qr/ \A $LAX \z /x}1;
+VERSION_REGEX
-$fatpacked{"version/vpp.pm"} = <<'VERSION_VPP';
- package charstar;use overload ('""'=>\&thischar,'0+'=>\&thischar,'++'=>\&increment,'--'=>\&decrement,'+'=>\&plus,'-'=>\&minus,'*'=>\&multiply,'cmp'=>\&cmp,'<=>'=>\&spaceship,'bool'=>\&thischar,'='=>\&clone,);sub new {my ($self,$string)=@_;my$class=ref($self)|| $self;my$obj={string=>[split(//,$string)],current=>0,};return bless$obj,$class}sub thischar {my ($self)=@_;my$last=$#{$self->{string}};my$curr=$self->{current};if ($curr >= 0 && $curr <= $last){return$self->{string}->[$curr]}else [...]
+$fatpacked{"version/vpp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'VERSION_VPP';
+ package charstar;use overload ('""'=>\&thischar,'0+'=>\&thischar,'++'=>\&increment,'--'=>\&decrement,'+'=>\&plus,'-'=>\&minus,'*'=>\&multiply,'cmp'=>\&cmp,'<=>'=>\&spaceship,'bool'=>\&thischar,'='=>\&clone,);sub new {my ($self,$string)=@_;my$class=ref($self)|| $self;my$obj={string=>[split(//,$string)],current=>0,};return bless$obj,$class}sub thischar {my ($self)=@_;my$last=$#{$self->{string}};my$curr=$self->{current};if ($curr >= 0 && $curr <= $last){return$self->{string}->[$curr]}else [...]
package
warnings;
sub enabled {return $^W;}
1;
- '}my$VERSION_MAX=0x7FFFFFFF;use constant TRUE=>1;use constant FALSE=>0;sub isDIGIT {my ($char)=shift->thischar();return ($char =~ /\d/)}sub isALPHA {my ($char)=shift->thischar();return ($char =~ /[a-zA-Z]/)}sub isSPACE {my ($char)=shift->thischar();return ($char =~ /\s/)}sub BADVERSION {my ($s,$errstr,$error)=@_;if ($errstr){$$errstr=$error}return$s}sub prescan_version {my ($s,$strict,$errstr,$sqv,$ssaw_decimal,$swidth,$salpha)=@_;my$qv=defined$sqv ? $$sqv : FALSE;my$saw_decimal=de [...]
+ '}sub import {no strict 'refs';my ($class)=shift;unless ($class eq $CLASS){local $^W;*{$class.'::declare'}=\&{$CLASS.'::declare'};*{$class.'::qv'}=\&{$CLASS.'::qv'}}my%args;if (@_){map {$args{$_}=1}@_}else {%args=(qv=>1,'UNIVERSAL::VERSION'=>1,)}my$callpkg=caller();if (exists($args{declare})){*{$callpkg.'::declare'}=sub {return$class->declare(shift)}unless defined(&{$callpkg.'::declare'})}if (exists($args{qv})){*{$callpkg.'::qv'}=sub {return$class->qv(shift)}unless defined(&{$callp [...]
VERSION_VPP
s/^ //mg for values %fatpacked;
-unshift @INC, sub {
- if (my $fat = $fatpacked{$_[1]}) {
- if ($] < 5.008) {
- return sub {
- return 0 unless length $fat;
- $fat =~ s/^([^\n]*\n?)//;
- $_ = $1;
- return 1;
- };
+my $class = 'FatPacked::'.(0+\%fatpacked);
+no strict 'refs';
+*{"${class}::files"} = sub { keys %{$_[0]} };
+
+if ($] < 5.008) {
+ *{"${class}::INC"} = sub {
+ if (my $fat = $_[0]{$_[1]}) {
+ return sub {
+ return 0 unless length $fat;
+ $fat =~ s/^([^\n]*\n?)//;
+ $_ = $1;
+ return 1;
+ };
+ }
+ return;
+ };
+}
+
+else {
+ *{"${class}::INC"} = sub {
+ if (my $fat = $_[0]{$_[1]}) {
+ open my $fh, '<', \$fat
+ or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
+ return $fh;
}
- open my $fh, '<', \$fat
- or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
- return $fh;
- }
- return
-};
+ return;
+ };
+}
-} # END OF FATPACK CODE
+unshift @INC, bless \%fatpacked, $class;
+ } # END OF FATPACK CODE
diff --git a/lib/App/cpanminus.pm b/lib/App/cpanminus.pm
index d09ecf9..04f4ee3 100644
--- a/lib/App/cpanminus.pm
+++ b/lib/App/cpanminus.pm
@@ -1,5 +1,5 @@
package App::cpanminus;
-our $VERSION = "1.7001";
+our $VERSION = "1.7004";
=encoding utf8
diff --git a/lib/App/cpanminus/fatscript.pm b/lib/App/cpanminus/fatscript.pm
index 4b75e9c..4b64abb 100644
--- a/lib/App/cpanminus/fatscript.pm
+++ b/lib/App/cpanminus/fatscript.pm
@@ -18,9 +18,9 @@ our $VERSION = "1.6928";
BEGIN {
my %fatpacked;
-$fatpacked{"App/cpanminus.pm"} = <<'APP_CPANMINUS';
+$fatpacked{"App/cpanminus.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS';
package App::cpanminus;
- our $VERSION = "1.7001";
+ our $VERSION = "1.7004";
=encoding utf8
@@ -307,7 +307,7 @@ $fatpacked{"App/cpanminus.pm"} = <<'APP_CPANMINUS';
1;
APP_CPANMINUS
-$fatpacked{"App/cpanminus/CPANVersion.pm"} = <<'APP_CPANMINUS_CPANVERSION';
+$fatpacked{"App/cpanminus/CPANVersion.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS_CPANVERSION';
package App::cpanminus::CPANVersion;
# copy of CPAN::Version since it's not core on older 5.8
@@ -440,7 +440,7 @@ $fatpacked{"App/cpanminus/CPANVersion.pm"} = <<'APP_CPANMINUS_CPANVERSION';
__END__
APP_CPANMINUS_CPANVERSION
-$fatpacked{"App/cpanminus/Dependency.pm"} = <<'APP_CPANMINUS_DEPENDENCY';
+$fatpacked{"App/cpanminus/Dependency.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS_DEPENDENCY';
package App::cpanminus::Dependency;
use strict;
use CPAN::Meta::Requirements;
@@ -493,7 +493,7 @@ $fatpacked{"App/cpanminus/Dependency.pm"} = <<'APP_CPANMINUS_DEPENDENCY';
1;
APP_CPANMINUS_DEPENDENCY
-$fatpacked{"App/cpanminus/ParsePM.pm"} = <<'APP_CPANMINUS_PARSEPM';
+$fatpacked{"App/cpanminus/ParsePM.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS_PARSEPM';
package App::cpanminus::ParsePM;
# fork of Parse::PMFile, use JSON::PP instead of JSON
@@ -1037,7 +1037,7 @@ $fatpacked{"App/cpanminus/ParsePM.pm"} = <<'APP_CPANMINUS_PARSEPM';
__END__
APP_CPANMINUS_PARSEPM
-$fatpacked{"App/cpanminus/script.pm"} = <<'APP_CPANMINUS_SCRIPT';
+$fatpacked{"App/cpanminus/script.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CPANMINUS_SCRIPT';
package App::cpanminus::script;
use strict;
use Config;
@@ -1450,8 +1450,8 @@ $fatpacked{"App/cpanminus/script.pm"} = <<'APP_CPANMINUS_SCRIPT';
my $self = shift;
my $temp_log = "$home/build.log." . time . ".$$";
File::Copy::copy($log, $temp_log)
- && unlink($final_log)
- && rename($temp_log, $final_log);
+ && unlink($final_log);
+ rename($temp_log, $final_log);
}
}
@@ -1923,7 +1923,8 @@ $fatpacked{"App/cpanminus/script.pm"} = <<'APP_CPANMINUS_SCRIPT';
sub local_lib_target {
my($self, $root) = @_;
- (grep { $_ ne '' } split /\Q$Config{path_sep}/, $root)[-1];
+ # local::lib 1.008025 changed the order of PERL_LOCAL_LIB_ROOT
+ (grep { $_ ne '' } split /\Q$Config{path_sep}/, $root)[0];
}
sub bootstrap_local_lib {
@@ -4096,7 +4097,7 @@ $fatpacked{"App/cpanminus/script.pm"} = <<'APP_CPANMINUS_SCRIPT';
1;
APP_CPANMINUS_SCRIPT
-$fatpacked{"CPAN/DistnameInfo.pm"} = <<'CPAN_DISTNAMEINFO';
+$fatpacked{"CPAN/DistnameInfo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_DISTNAMEINFO';
package CPAN::DistnameInfo;
@@ -4304,7 +4305,7 @@ $fatpacked{"CPAN/DistnameInfo.pm"} = <<'CPAN_DISTNAMEINFO';
CPAN_DISTNAMEINFO
-$fatpacked{"CPAN/Meta.pm"} = <<'CPAN_META';
+$fatpacked{"CPAN/Meta.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META';
use 5.006;
use strict;
use warnings;
@@ -5090,7 +5091,7 @@ $fatpacked{"CPAN/Meta.pm"} = <<'CPAN_META';
=item *
- Olivier Mengu� <dolmen at cpan.org>
+ Olivier Mengué <dolmen at cpan.org>
=item *
@@ -5108,7 +5109,7 @@ $fatpacked{"CPAN/Meta.pm"} = <<'CPAN_META';
=cut
CPAN_META
-$fatpacked{"CPAN/Meta/Check.pm"} = <<'CPAN_META_CHECK';
+$fatpacked{"CPAN/Meta/Check.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_CHECK';
package CPAN::Meta::Check;
{
$CPAN::Meta::Check::VERSION = '0.007';
@@ -5249,7 +5250,7 @@ $fatpacked{"CPAN/Meta/Check.pm"} = <<'CPAN_META_CHECK';
=cut
CPAN_META_CHECK
-$fatpacked{"CPAN/Meta/Converter.pm"} = <<'CPAN_META_CONVERTER';
+$fatpacked{"CPAN/Meta/Converter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_CONVERTER';
use 5.006;
use strict;
use warnings;
@@ -6650,7 +6651,7 @@ $fatpacked{"CPAN/Meta/Converter.pm"} = <<'CPAN_META_CONVERTER';
=cut
CPAN_META_CONVERTER
-$fatpacked{"CPAN/Meta/Feature.pm"} = <<'CPAN_META_FEATURE';
+$fatpacked{"CPAN/Meta/Feature.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_FEATURE';
use 5.006;
use strict;
use warnings;
@@ -6764,7 +6765,7 @@ $fatpacked{"CPAN/Meta/Feature.pm"} = <<'CPAN_META_FEATURE';
=cut
CPAN_META_FEATURE
-$fatpacked{"CPAN/Meta/History.pm"} = <<'CPAN_META_HISTORY';
+$fatpacked{"CPAN/Meta/History.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_HISTORY';
# vi:tw=72
use 5.006;
use strict;
@@ -7082,7 +7083,7 @@ $fatpacked{"CPAN/Meta/History.pm"} = <<'CPAN_META_HISTORY';
=cut
CPAN_META_HISTORY
-$fatpacked{"CPAN/Meta/Prereqs.pm"} = <<'CPAN_META_PREREQS';
+$fatpacked{"CPAN/Meta/Prereqs.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_PREREQS';
use 5.006;
use strict;
use warnings;
@@ -7357,7 +7358,7 @@ $fatpacked{"CPAN/Meta/Prereqs.pm"} = <<'CPAN_META_PREREQS';
=cut
CPAN_META_PREREQS
-$fatpacked{"CPAN/Meta/Requirements.pm"} = <<'CPAN_META_REQUIREMENTS';
+$fatpacked{"CPAN/Meta/Requirements.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_REQUIREMENTS';
use strict;
use warnings;
package CPAN::Meta::Requirements;
@@ -8090,7 +8091,7 @@ $fatpacked{"CPAN/Meta/Requirements.pm"} = <<'CPAN_META_REQUIREMENTS';
=cut
CPAN_META_REQUIREMENTS
-$fatpacked{"CPAN/Meta/Spec.pm"} = <<'CPAN_META_SPEC';
+$fatpacked{"CPAN/Meta/Spec.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_SPEC';
# XXX RULES FOR PATCHING THIS FILE XXX
# Patches that fix typos or formatting are acceptable. Patches
# that change semantics are not acceptable without prior approval
@@ -9236,7 +9237,7 @@ $fatpacked{"CPAN/Meta/Spec.pm"} = <<'CPAN_META_SPEC';
=cut
CPAN_META_SPEC
-$fatpacked{"CPAN/Meta/Validator.pm"} = <<'CPAN_META_VALIDATOR';
+$fatpacked{"CPAN/Meta/Validator.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_VALIDATOR';
use 5.006;
use strict;
use warnings;
@@ -10292,7 +10293,7 @@ $fatpacked{"CPAN/Meta/Validator.pm"} = <<'CPAN_META_VALIDATOR';
=cut
CPAN_META_VALIDATOR
-$fatpacked{"CPAN/Meta/YAML.pm"} = <<'CPAN_META_YAML';
+$fatpacked{"CPAN/Meta/YAML.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CPAN_META_YAML';
package CPAN::Meta::YAML;
{
$CPAN::Meta::YAML::VERSION = '0.008';
@@ -11036,7 +11037,7 @@ $fatpacked{"CPAN/Meta/YAML.pm"} = <<'CPAN_META_YAML';
CPAN_META_YAML
-$fatpacked{"Exporter.pm"} = <<'EXPORTER';
+$fatpacked{"Exporter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER';
package Exporter;
require 5.006;
@@ -11630,7 +11631,7 @@ $fatpacked{"Exporter.pm"} = <<'EXPORTER';
EXPORTER
-$fatpacked{"Exporter/Heavy.pm"} = <<'EXPORTER_HEAVY';
+$fatpacked{"Exporter/Heavy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER_HEAVY';
package Exporter::Heavy;
use strict;
@@ -11881,7 +11882,7 @@ $fatpacked{"Exporter/Heavy.pm"} = <<'EXPORTER_HEAVY';
1;
EXPORTER_HEAVY
-$fatpacked{"File/pushd.pm"} = <<'FILE_PUSHD';
+$fatpacked{"File/pushd.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_PUSHD';
use strict;
use warnings;
package File::pushd;
@@ -12163,24 +12164,87 @@ $fatpacked{"File/pushd.pm"} = <<'FILE_PUSHD';
=cut
FILE_PUSHD
-$fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
+$fatpacked{"HTTP/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINY';
# vim: ts=4 sts=4 sw=4 et:
package HTTP::Tiny;
use strict;
use warnings;
# ABSTRACT: A small, simple, correct HTTP/1.1 client
- our $VERSION = '0.034'; # VERSION
+ our $VERSION = '0.043'; # 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
my @attributes;
BEGIN {
- @attributes = qw(cookie_jar default_headers local_address max_redirect max_size proxy no_proxy timeout SSL_options verify_SSL);
+ @attributes = qw(
+ cookie_jar default_headers http_proxy https_proxy keep_alive
+ local_address max_redirect max_size proxy no_proxy timeout
+ SSL_options verify_SSL
+ );
+ my %persist_ok = map {; $_ => 1 } qw(
+ cookie_jar default_headers max_redirect max_size
+ );
no strict 'refs';
+ no warnings 'uninitialized';
for my $accessor ( @attributes ) {
*{$accessor} = sub {
- @_ > 1 ? $_[0]->{$accessor} = $_[1] : $_[0]->{$accessor};
+ @_ > 1
+ ? do {
+ delete $_[0]->{handle} if !$persist_ok{$accessor} && $_[1] ne $_[0]->{$accessor};
+ $_[0]->{$accessor} = $_[1]
+ }
+ : $_[0]->{$accessor};
};
}
}
@@ -12200,6 +12264,7 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
my $self = {
max_redirect => 5,
timeout => 60,
+ keep_alive => 1,
verify_SSL => $args{verify_SSL} || $args{verify_ssl} || 0, # no verification by default
no_proxy => $ENV{no_proxy},
};
@@ -12214,13 +12279,43 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
$self->agent( exists $args{agent} ? $args{agent} : $class->_agent );
- # Never override proxy argument as this breaks backwards compat.
- if (!exists $self->{proxy} && (my $http_proxy = $ENV{http_proxy})) {
- if ($http_proxy =~ m{\Ahttp://[^/?#:@]+:\d+/?\z}) {
- $self->{proxy} = $http_proxy;
+ $self->_set_proxies;
+
+ return $self;
+ }
+
+ sub _set_proxies {
+ my ($self) = @_;
+
+ if (! $self->{proxy} ) {
+ $self->{proxy} = $ENV{all_proxy} || $ENV{ALL_PROXY};
+ if ( defined $self->{proxy} ) {
+ $self->_split_proxy( 'generic proxy' => $self->{proxy} ); # validate
}
else {
- Carp::croak(qq{Environment 'http_proxy' must be in format http://<host>:<port>/\n});
+ delete $self->{proxy};
+ }
+ }
+
+ if (! $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} ) {
+ $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};
}
}
@@ -12230,9 +12325,22 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
(defined $self->{no_proxy}) ? [ split /\s*,\s*/, $self->{no_proxy} ] : [];
}
- return $self;
+ 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
for my $sub_name ( qw/get head put post delete/ ) {
my $req_method = uc $sub_name;
@@ -12247,6 +12355,25 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
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
sub post_form {
my ($self, $url, $data, $args) = @_;
@@ -12270,6 +12397,28 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
);
}
+ # =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
sub mirror {
my ($self, $url, $file, $args) = @_;
@@ -12279,13 +12428,16 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
$args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime);
}
my $tempfile = $file . int(rand(2**31));
- open my $fh, ">", $tempfile
- or Carp::croak(qq/Error: Could not open temporary file $tempfile for downloading: $!\n/);
+
+ 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);
close $fh
- or Carp::croak(qq/Error: Could not close temporary file $tempfile: $!\n/);
+ or Carp::croak(qq/Error: Caught error closing temporary file $tempfile: $!\n/);
+
if ( $response->{success} ) {
rename $tempfile, $file
or Carp::croak(qq/Error replacing $file with $tempfile: $!\n/);
@@ -12299,6 +12451,86 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
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 sesame at example.com/');
+ #
+ # If the "user:password" stanza contains reserved characters, they must
+ # be percent-escaped:
+ #
+ # $http->request('GET', 'http://john%40example.com:password@example.com/');
+ #
+ # 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
my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/;
@@ -12316,7 +12548,14 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
&& $@ =~ m{^(?:Socket closed|Unexpected end)};
}
- if (my $e = "$@") {
+ if (my $e = $@) {
+ # maybe we got a response hash thrown from somewhere deep
+ if ( ref $e eq 'HASH' && exists $e->{status} ) {
+ return $e;
+ }
+
+ # otherwise, stringify it
+ $e = "$e";
$response = {
url => $url,
success => q{},
@@ -12332,6 +12571,19 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
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
sub www_form_urlencode {
my ($self, $data) = @_;
@@ -12355,7 +12607,7 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
}
}
- return join("&", sort @terms);
+ return join("&", (ref $data eq 'ARRAY') ? (@terms) : (sort @terms) );
}
#--------------------------------------------------------------------------#
@@ -12381,27 +12633,23 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
my $request = {
method => $method,
scheme => $scheme,
+ host => $host,
host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"),
uri => $path_query,
headers => {},
};
- my $handle = HTTP::Tiny::Handle->new(
- timeout => $self->{timeout},
- SSL_options => $self->{SSL_options},
- verify_SSL => $self->{verify_SSL},
- local_address => $self->{local_address},
- );
-
- if ($self->{proxy} && ! grep { $host =~ /\Q$_\E$/ } @{$self->{no_proxy}}) {
- $request->{uri} = "$scheme://$request->{host_port}$path_query";
- die(qq/HTTPS via proxy is not supported\n/)
- if $request->{scheme} eq 'https';
- $handle->connect(($self->_split_url($self->{proxy}))[0..2]);
- }
- else {
- $handle->connect($scheme, $host, $port);
+ # We remove the cached handle so it is not reused in the case of redirect.
+ # If all is well, it will be recached at the end of _request. We only
+ # reuse for the same scheme, host and port
+ my $handle = delete $self->{handle};
+ if ( $handle ) {
+ unless ( $handle->can_reuse( $scheme, $host, $port ) ) {
+ $handle->close;
+ undef $handle;
+ }
}
+ $handle ||= $self->_open_handle( $request, $scheme, $host, $port );
$self->_prepare_headers_and_cb($request, $args, $url, $auth);
$handle->write_request($request);
@@ -12417,20 +12665,140 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
return $self->_request(@redir_args, $args);
}
+ my $known_message_length;
if ($method eq 'HEAD' || $response->{status} =~ /^[23]04/) {
# response has no message body
+ $known_message_length = 1;
}
else {
my $data_cb = $self->_prepare_data_cb($response, $args);
- $handle->read_body($data_cb, $response);
+ $known_message_length = $handle->read_body($data_cb, $response);
+ }
+
+ if ( $self->{keep_alive}
+ && $known_message_length
+ && $response->{protocol} eq 'HTTP/1.1'
+ && ($response->{headers}{connection} || '') ne 'close'
+ ) {
+ $self->{handle} = $handle;
+ }
+ else {
+ $handle->close;
}
- $handle->close;
- $response->{success} = substr($response->{status},0,1) eq '2';
+ $response->{success} = substr( $response->{status}, 0, 1 ) eq '2';
$response->{url} = $url;
return $response;
}
+ sub _open_handle {
+ my ($self, $request, $scheme, $host, $port) = @_;
+
+ my $handle = HTTP::Tiny::Handle->new(
+ timeout => $self->{timeout},
+ SSL_options => $self->{SSL_options},
+ verify_SSL => $self->{verify_SSL},
+ local_address => $self->{local_address},
+ keep_alive => $self->{keep_alive}
+ );
+
+ if ($self->{_has_proxy}{$scheme} && ! grep { $host =~ /\Q$_\E$/ } @{$self->{no_proxy}}) {
+ return $self->_proxy_connect( $request, $handle );
+ }
+ else {
+ return $handle->connect($scheme, $host, $port);
+ }
+ }
+
+ sub _proxy_connect {
+ my ($self, $request, $handle) = @_;
+
+ my @proxy_vars;
+ if ( $request->{scheme} eq 'https' ) {
+ Carp::croak(qq{No https_proxy defined}) unless $self->{https_proxy};
+ @proxy_vars = $self->_split_proxy( https_proxy => $self->{https_proxy} );
+ if ( $proxy_vars[0] eq 'https' ) {
+ Carp::croak(qq{Can't proxy https over https: $request->{uri} via $self->{https_proxy}});
+ }
+ }
+ else {
+ Carp::croak(qq{No http_proxy defined}) unless $self->{http_proxy};
+ @proxy_vars = $self->_split_proxy( http_proxy => $self->{http_proxy} );
+ }
+
+ my ($p_scheme, $p_host, $p_port, $p_auth) = @proxy_vars;
+
+ if ( length $p_auth && ! defined $request->{headers}{'proxy-authorization'} ) {
+ $self->_add_basic_auth_header( $request, 'proxy-authorization' => $p_auth );
+ }
+
+ $handle->connect($p_scheme, $p_host, $p_port);
+
+ if ($request->{scheme} eq 'https') {
+ $self->_create_proxy_tunnel( $request, $handle );
+ }
+ else {
+ # non-tunneled proxy requires absolute URI
+ $request->{uri} = "$request->{scheme}://$request->{host_port}$request->{uri}";
+ }
+
+ return $handle;
+ }
+
+ sub _split_proxy {
+ my ($self, $type, $proxy) = @_;
+
+ my ($scheme, $host, $port, $path_query, $auth) = eval { $self->_split_url($proxy) };
+
+ unless(
+ defined($scheme) && length($scheme) && length($host) && length($port)
+ && $path_query eq '/'
+ ) {
+ Carp::croak(qq{$type URL must be in format http[s]://[auth@]<host>:<port>/\n});
+ }
+
+ return ($scheme, $host, $port, $auth);
+ }
+
+ sub _create_proxy_tunnel {
+ my ($self, $request, $handle) = @_;
+
+ $handle->_assert_ssl;
+
+ my $agent = exists($request->{headers}{'user-agent'})
+ ? $request->{headers}{'user-agent'} : $self->{agent};
+
+ my $connect_request = {
+ method => 'CONNECT',
+ uri => $request->{host_port},
+ headers => {
+ host => $request->{host_port},
+ 'user-agent' => $agent,
+ }
+ };
+
+ if ( $request->{headers}{'proxy-authorization'} ) {
+ $connect_request->{headers}{'proxy-authorization'} =
+ delete $request->{headers}{'proxy-authorization'};
+ }
+
+ $handle->write_request($connect_request);
+ my $response;
+ do { $response = $handle->read_response_header }
+ until (substr($response->{status},0,1) ne '1');
+
+ # if CONNECT failed, throw the response so it will be
+ # returned from the original request() method;
+ unless (substr($response->{status},0,1) eq '2') {
+ die $response;
+ }
+
+ # tunnel established, so start SSL handshake
+ $handle->start_ssl( $request->{host} );
+
+ return;
+ }
+
sub _prepare_headers_and_cb {
my ($self, $request, $args, $url, $auth) = @_;
@@ -12441,8 +12809,9 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
}
}
$request->{headers}{'host'} = $request->{host_port};
- $request->{headers}{'connection'} = "close";
$request->{headers}{'user-agent'} ||= $self->{agent};
+ $request->{headers}{'connection'} = "close"
+ unless $self->{keep_alive};
if ( defined $args->{content} ) {
if (ref $args->{content} eq 'CODE') {
@@ -12475,15 +12844,21 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
}
# if we have Basic auth parameters, add them
- if ( length $auth && ! defined $request->{headers}{authentication} ) {
- require MIME::Base64;
- $request->{headers}{authorization} =
- "Basic " . MIME::Base64::encode_base64($auth, "");
+ if ( length $auth && ! defined $request->{headers}{authorization} ) {
+ $self->_add_basic_auth_header( $request, 'authorization' => $auth );
}
return;
}
+ sub _add_basic_auth_header {
+ my ($self, $request, $header, $auth) = @_;
+ require MIME::Base64;
+ $request->{headers}{$header} =
+ "Basic " . MIME::Base64::encode_base64($auth, "");
+ return;
+ }
+
sub _prepare_data_cb {
my ($self, $response, $args) = @_;
my $data_cb = $args->{data_callback};
@@ -12559,6 +12934,8 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
$authority = (length($authority)) ? $authority : 'localhost';
if ( $authority =~ /@/ ) {
($auth,$host) = $authority =~ m/\A([^@]*)@(.*)\z/; # user:pass at 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;
@@ -12634,6 +13011,14 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
use Errno qw[EINTR EPIPE];
use IO::Socket qw[SOCK_STREAM];
+ # PERL_HTTP_TINY_IPV4_ONLY is a private environment variable to force old
+ # behavior if someone is unable to boostrap CPAN from a new perl install; it is
+ # not intended for general, per-client use and may be removed in the future
+ my $SOCKET_CLASS =
+ $ENV{PERL_HTTP_TINY_IPV4_ONLY} ? 'IO::Socket::INET' :
+ eval { require IO::Socket::IP; IO::Socket::IP->VERSION(0.25) } ? 'IO::Socket::IP' :
+ 'IO::Socket::INET';
+
sub BUFSIZE () { 32768 } ## no critic
my $Printable = sub {
@@ -12665,50 +13050,61 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
my ($self, $scheme, $host, $port) = @_;
if ( $scheme eq 'https' ) {
- # Need IO::Socket::SSL 1.42 for SSL_create_ctx_callback
- die(qq/IO::Socket::SSL 1.42 must be installed for https support\n/)
- unless eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.42)};
- # Need Net::SSLeay 1.49 for MODE_AUTO_RETRY
- die(qq/Net::SSLeay 1.49 must be installed for https support\n/)
- unless eval {require Net::SSLeay; Net::SSLeay->VERSION(1.49)};
+ $self->_assert_ssl;
}
elsif ( $scheme ne 'http' ) {
die(qq/Unsupported URL scheme '$scheme'\n/);
}
- $self->{fh} = 'IO::Socket::INET'->new(
+ $self->{fh} = $SOCKET_CLASS->new(
PeerHost => $host,
PeerPort => $port,
$self->{local_address} ?
( LocalAddr => $self->{local_address} ) : (),
Proto => 'tcp',
Type => SOCK_STREAM,
- Timeout => $self->{timeout}
+ Timeout => $self->{timeout},
+ KeepAlive => !!$self->{keep_alive}
) or die(qq/Could not connect to '$host:$port': $@\n/);
binmode($self->{fh})
or die(qq/Could not binmode() socket: '$!'\n/);
- if ( $scheme eq 'https') {
- my $ssl_args = $self->_ssl_args($host);
- IO::Socket::SSL->start_SSL(
- $self->{fh},
- %$ssl_args,
- SSL_create_ctx_callback => sub {
- my $ctx = shift;
- Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY());
- },
- );
+ $self->start_ssl($host) if $scheme eq 'https';
+
+ $self->{scheme} = $scheme;
+ $self->{host} = $host;
+ $self->{port} = $port;
- unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
+ return $self;
+ }
+
+ sub start_ssl {
+ my ($self, $host) = @_;
+
+ # As this might be used via CONNECT after an SSL session
+ # to a proxy, we shut down any existing SSL before attempting
+ # the handshake
+ if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
+ unless ( $self->{fh}->stop_SSL ) {
my $ssl_err = IO::Socket::SSL->errstr;
- die(qq/SSL connection failed for $host: $ssl_err\n/);
+ die(qq/Error halting prior SSL connection: $ssl_err/);
}
}
- $self->{host} = $host;
- $self->{port} = $port;
+ my $ssl_args = $self->_ssl_args($host);
+ IO::Socket::SSL->start_SSL(
+ $self->{fh},
+ %$ssl_args,
+ SSL_create_ctx_callback => sub {
+ my $ctx = shift;
+ Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY());
+ },
+ );
- return $self;
+ unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
+ my $ssl_err = IO::Socket::SSL->errstr;
+ die(qq/SSL connection failed for $host: $ssl_err\n/);
+ }
}
sub close {
@@ -12884,11 +13280,13 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
'x-xss-protection' => 'X-XSS-Protection',
);
+ # to avoid multiple small writes and hence nagle, you can pass the method line or anything else to
+ # combine writes.
sub write_header_lines {
- (@_ == 2 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers)/ . "\n");
- my($self, $headers) = @_;
+ (@_ == 2 || @_ == 3 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers[,prefix])/ . "\n");
+ my($self, $headers, $prefix_data) = @_;
- my $buf = '';
+ my $buf = (defined $prefix_data ? $prefix_data : '');
while (my ($k, $v) = each %$headers) {
my $field_name = lc $k;
if (exists $HeaderCase{$field_name}) {
@@ -12910,17 +13308,17 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
return $self->write($buf);
}
+ # return value indicates whether message length was defined; this is generally
+ # true unless there was no content-length header and we just read until EOF.
+ # Other message length errors are thrown as exceptions
sub read_body {
@_ == 3 || die(q/Usage: $handle->read_body(callback, response)/ . "\n");
my ($self, $cb, $response) = @_;
my $te = $response->{headers}{'transfer-encoding'} || '';
- if ( grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ) {
- $self->read_chunked_body($cb, $response);
- }
- else {
- $self->read_content_body($cb, $response);
- }
- return;
+ my $chunked = grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ;
+ return $chunked
+ ? $self->read_chunked_body($cb, $response)
+ : $self->read_content_body($cb, $response);
}
sub write_body {
@@ -12946,11 +13344,11 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
$cb->($self->read($read, 0), $response);
$len -= $read;
}
+ return length($self->{rbuf}) == 0;
}
- else {
- my $chunk;
- $cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) );
- }
+
+ my $chunk;
+ $cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) );
return;
}
@@ -12999,7 +13397,7 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
or die(qq/Malformed chunk: missing CRLF after chunk data\n/);
}
$self->read_header_lines($response->{headers});
- return;
+ return 1;
}
sub write_chunked_body {
@@ -13048,10 +13446,10 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
unless $version =~ /0*1\.0*[01]/;
return {
- status => $status,
- reason => $reason,
- headers => $self->read_header_lines,
- protocol => $protocol,
+ status => $status,
+ reason => $reason,
+ headers => $self->read_header_lines,
+ protocol => $protocol,
};
}
@@ -13059,8 +13457,7 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
@_ == 4 || die(q/Usage: $handle->write_request_header(method, request_uri, headers)/ . "\n");
my ($self, $method, $request_uri, $headers) = @_;
- return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
- + $self->write_header_lines($headers);
+ return $self->write_header_lines($headers, "$method $request_uri HTTP/1.1\x0D\x0A");
}
sub _do_timeout {
@@ -13097,6 +13494,9 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
sub can_read {
@_ == 1 || @_ == 2 || die(q/Usage: $handle->can_read([timeout])/ . "\n");
my $self = shift;
+ if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
+ return 1 if $self->{fh}->pending;
+ }
return $self->_do_timeout('read', @_)
}
@@ -13106,6 +13506,27 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
return $self->_do_timeout('write', @_)
}
+ sub _assert_ssl {
+ # Need IO::Socket::SSL 1.42 for SSL_create_ctx_callback
+ die(qq/IO::Socket::SSL 1.42 must be installed for https support\n/)
+ unless eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.42)};
+ # Need Net::SSLeay 1.49 for MODE_AUTO_RETRY
+ die(qq/Net::SSLeay 1.49 must be installed for https support\n/)
+ unless eval {require Net::SSLeay; Net::SSLeay->VERSION(1.49)};
+ }
+
+ sub can_reuse {
+ my ($self,$scheme,$host,$port) = @_;
+ return 0 if
+ length($self->{rbuf})
+ || $scheme ne $self->{scheme}
+ || $host ne $self->{host}
+ || $port ne $self->{port}
+ || eval { $self->can_read(0) }
+ || $@ ;
+ return 1;
+ }
+
# Try to find a CA bundle to validate the SSL cert,
# prefer Mozilla::CA or fallback to a system file
sub _find_CA_file {
@@ -13134,7 +13555,7 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
my ($self, $host) = @_;
my %ssl_args;
-
+
# This test reimplements IO::Socket::SSL::can_client_sni(), which wasn't
# added until IO::Socket::SSL 1.84
if ( Net::SSLeay::OPENSSL_VERSION_NUMBER() >= 0x01000000 ) {
@@ -13166,7 +13587,7 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
=pod
- =encoding utf-8
+ =encoding UTF-8
=head1 NAME
@@ -13174,7 +13595,7 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
=head1 VERSION
- version 0.034
+ version 0.043
=head1 SYNOPSIS
@@ -13196,12 +13617,16 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
=head1 DESCRIPTION
- This is a very simple HTTP/1.1 client, designed for doing simple GET
+ This is a very simple HTTP/1.1 client, designed for doing simple
requests without the overhead of a large framework like L<LWP::UserAgent>.
It is more correct and more complete than L<HTTP::Lite>. It supports
- proxies (currently only non-authenticating ones) and redirection. It
- also correctly resumes after EINTR.
+ proxies and redirection. It also correctly resumes after EINTR.
+
+ If L<IO::Socket::IP> 0.25 or later is installed, HTTP::Tiny will use it instead
+ of L<IO::Socket::INET> for transparent support for both IPv4 and IPv6.
+
+ Cookie support requires L<HTTP::CookieJar> or an equivalent class.
=head1 METHODS
@@ -13239,6 +13664,12 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
=item *
+ 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)
@@ -13247,14 +13678,25 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
C<max_size>
- Maximum response size (only when not using a data callback). If defined,
- responses larger than this will return an exception.
+ 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)
+
+ =item *
+
+ 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 proxy server to use (default is C<$ENV{http_proxy}> if set)
+ URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> if set)
=item *
@@ -13287,6 +13729,12 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
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.
=head2 get|head|put|post|delete
@@ -13308,7 +13756,9 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
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>. See documentation for the
+ 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
@@ -13353,6 +13803,11 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
$http->request('GET', 'http://Aladdin:open sesame at example.com/');
+ If the "user:password" stanza contains reserved characters, they must
+ be percent-escaped:
+
+ $http->request('GET', 'http://john%40example.com:password@example.com/');
+
A hashref of options may be appended to modify the request.
Valid options are:
@@ -13465,28 +13920,32 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
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. The key/value pairs in the resulting string will be sorted by key
- and value.
+ 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.
- =for Pod::Coverage agent
+ =for Pod::Coverage SSL_options
+ agent
cookie_jar
default_headers
+ http_proxy
+ https_proxy
+ keep_alive
local_address
max_redirect
max_size
- proxy
no_proxy
+ proxy
timeout
verify_SSL
- SSL_options
=head1 SSL SUPPORT
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
- encryption fails. There is no support for C<https> connections via proxy (i.e.
- RFC 2817).
+ 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.
SSL provides two distinct capabilities:
@@ -13563,6 +14022,43 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
cipher used for the SSL connection. See L<IO::Socket::SSL> documentation for
details.
+ =head1 PROXY SUPPORT
+
+ HTTP::Tiny can proxy both C<http> and C<https> requests. Only Basic proxy
+ authorization is supported and it must be provided as part of the proxy URL:
+ C<http://user:pass@proxy.example.com/>.
+
+ HTTP::Tiny supports the following proxy environment variables:
+
+ =over 4
+
+ =item *
+
+ http_proxy
+
+ =item *
+
+ https_proxy or HTTPS_PROXY
+
+ =item *
+
+ all_proxy or ALL_PROXY
+
+ =back
+
+ Tunnelling C<https> over an C<http> proxy using the CONNECT method is
+ supported. If your proxy uses C<https> itself, you can not tunnel C<https>
+ over it.
+
+ Be warned that proxying an C<https> connection opens you to the risk of a
+ man-in-the-middle attack by the proxy server.
+
+ The C<no_proxy> environment variable is supported in the format of a
+ comma-separated list of domain extensions proxy should not be used for.
+
+ Proxy arguments passed to C<new> will override their corresponding
+ environment variables.
+
=head1 LIMITATIONS
HTTP::Tiny is I<conditionally compliant> with the
@@ -13596,28 +14092,6 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
=item *
- Persistent connections are not supported. The C<Connection> header will
- always be set to C<close>.
-
- =item *
-
- Cookie support requires L<HTTP::CookieJar> or an equivalent class.
-
- =item *
-
- Only the C<http_proxy> environment variable is supported in the format
- C<http://HOST:PORT/>. If a C<proxy> argument is passed to C<new> (including
- undef), then the C<http_proxy> environment variable is ignored.
-
- =item *
-
- C<no_proxy> environment variable is supported in the format comma-separated
- list of domain extensions proxy should not be used for. If a C<no_proxy>
- argument is passed to C<new>, then the C<no_proxy> environment variable is
- ignored.
-
- =item *
-
There is no provision for delaying a request body using an C<Expect> header.
Unexpected C<1XX> responses are silently ignored as per the specification.
@@ -13629,18 +14103,22 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
There is no support for a Request-URI of '*' for the 'OPTIONS' request.
- =item *
-
- There is no support for IPv6 of any kind.
-
=back
+ Despite the limitations listed above, HTTP::Tiny is considered
+ feature-complete. New feature requests should be directed to
+ L<HTTP::Tiny::UA>.
+
=head1 SEE ALSO
=over 4
=item *
+ L<HTTP::Tiny::UA> - Higher level UA features for HTTP::Tiny
+
+ =item *
+
L<HTTP::Thin> - HTTP::Tiny wrapper with L<HTTP::Request>/L<HTTP::Response> compatibility
=item *
@@ -13649,6 +14127,10 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
=item *
+ L<IO::Socket::IP> - Required for IPv6 support
+
+ =item *
+
L<IO::Socket::SSL> - Required for SSL support
=item *
@@ -13682,7 +14164,7 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
L<https://github.com/chansen/p5-http-tiny>
- git clone git://github.com/chansen/p5-http-tiny.git
+ git clone https://github.com/chansen/p5-http-tiny.git
=head1 AUTHORS
@@ -13728,6 +14210,10 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
=item *
+ Clinton Gormley <clint at traveljury.com>
+
+ =item *
+
Craig Berry <cberry at cpan.org>
=item *
@@ -13748,6 +14234,10 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
=item *
+ Martin J. Evans <mjegh at ntlworld.com>
+
+ =item *
+
Martin-Louis Bright <mlbright at gmail.com>
=item *
@@ -13756,6 +14246,10 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
=item *
+ Petr Písař <ppisar at redhat.com>
+
+ =item *
+
Serguei Trouchelle <stro at cpan.org>
=item *
@@ -13770,7 +14264,7 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
=head1 COPYRIGHT AND LICENSE
- This software is copyright (c) 2013 by Christian Hansen.
+ This software is copyright (c) 2014 by Christian Hansen.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
@@ -13778,7 +14272,7 @@ $fatpacked{"HTTP/Tiny.pm"} = <<'HTTP_TINY';
=cut
HTTP_TINY
-$fatpacked{"JSON/PP.pm"} = <<'JSON_PP';
+$fatpacked{"JSON/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_PP';
package JSON::PP;
# JSON-2.0
@@ -13792,7 +14286,7 @@ $fatpacked{"JSON/PP.pm"} = <<'JSON_PP';
use B ();
#use Devel::Peek;
- $JSON::PP::VERSION = '2.27202';
+ $JSON::PP::VERSION = '2.27203';
@JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json);
@@ -15345,7 +15839,7 @@ $fatpacked{"JSON/PP.pm"} = <<'JSON_PP';
$self->{incr_text} = substr( $self->{incr_text}, $p );
$self->{incr_p} = 0;
- return $obj or '';
+ return $obj || '';
}
@@ -16580,7 +17074,7 @@ $fatpacked{"JSON/PP.pm"} = <<'JSON_PP';
=cut
JSON_PP
-$fatpacked{"JSON/PP/Boolean.pm"} = <<'JSON_PP_BOOLEAN';
+$fatpacked{"JSON/PP/Boolean.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_PP_BOOLEAN';
=head1 NAME
JSON::PP::Boolean - dummy module providing JSON::PP::Boolean
@@ -16609,7 +17103,7 @@ $fatpacked{"JSON/PP/Boolean.pm"} = <<'JSON_PP_BOOLEAN';
JSON_PP_BOOLEAN
-$fatpacked{"Module/CPANfile.pm"} = <<'MODULE_CPANFILE';
+$fatpacked{"Module/CPANfile.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE';
package Module::CPANfile;
use strict;
use warnings;
@@ -16905,7 +17399,7 @@ $fatpacked{"Module/CPANfile.pm"} = <<'MODULE_CPANFILE';
=cut
MODULE_CPANFILE
-$fatpacked{"Module/CPANfile/Environment.pm"} = <<'MODULE_CPANFILE_ENVIRONMENT';
+$fatpacked{"Module/CPANfile/Environment.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE_ENVIRONMENT';
package Module::CPANfile::Environment;
use strict;
use warnings;
@@ -16972,7 +17466,7 @@ $fatpacked{"Module/CPANfile/Environment.pm"} = <<'MODULE_CPANFILE_ENVIRONMENT';
MODULE_CPANFILE_ENVIRONMENT
-$fatpacked{"Module/CPANfile/Result.pm"} = <<'MODULE_CPANFILE_RESULT';
+$fatpacked{"Module/CPANfile/Result.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_CPANFILE_RESULT';
package Module::CPANfile::Result;
use strict;
@@ -17068,7 +17562,7 @@ $fatpacked{"Module/CPANfile/Result.pm"} = <<'MODULE_CPANFILE_RESULT';
1;
MODULE_CPANFILE_RESULT
-$fatpacked{"Module/Metadata.pm"} = <<'MODULE_METADATA';
+$fatpacked{"Module/Metadata.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_METADATA';
# -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
# vim:ts=8:sw=2:et:sta:sts=2
package Module::Metadata;
@@ -17081,8 +17575,9 @@ $fatpacked{"Module/Metadata.pm"} = <<'MODULE_METADATA';
# parrot future to look at other types of modules).
use strict;
- use vars qw($VERSION);
- $VERSION = '1.000016';
+ use warnings;
+
+ our $VERSION = '1.000019';
$VERSION = eval $VERSION;
use Carp qw/croak/;
@@ -17143,7 +17638,7 @@ $fatpacked{"Module/Metadata.pm"} = <<'MODULE_METADATA';
([\$*]) # sigil - $ or *
(
( # optional leading package name
- (?:::|\')? # possibly starting like just :: (� la $::VERSION)
+ (?:::|\')? # possibly starting like just :: (a la $::VERSION)
(?:\w+(?:::|\'))* # Foo::Bar:: ...
)?
VERSION
@@ -17720,10 +18215,11 @@ $fatpacked{"Module/Metadata.pm"} = <<'MODULE_METADATA';
# compiletime/runtime issues with local()
my $vsub;
$pn++; # everybody gets their own package
- my $eval = qq{BEGIN { q# Hide from _packages_inside()
+ my $eval = qq{BEGIN { my \$dummy = q# Hide from _packages_inside()
#; package Module::Metadata::_version::p$pn;
use version;
no strict;
+ no warnings;
\$vsub = sub {
local $sigil$var;
@@ -17733,6 +18229,8 @@ $fatpacked{"Module/Metadata.pm"} = <<'MODULE_METADATA';
};
}};
+ $eval = $1 if $eval =~ m{^(.+)}s;
+
local $^W;
# Try to get the $VERSION
eval $eval;
@@ -18083,7 +18581,7 @@ $fatpacked{"Module/Metadata.pm"} = <<'MODULE_METADATA';
MODULE_METADATA
-$fatpacked{"Parse/CPAN/Meta.pm"} = <<'PARSE_CPAN_META';
+$fatpacked{"Parse/CPAN/Meta.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARSE_CPAN_META';
use strict;
package Parse::CPAN::Meta;
# ABSTRACT: Parse META.yml and META.json CPAN metadata files
@@ -18401,7 +18899,7 @@ $fatpacked{"Parse/CPAN/Meta.pm"} = <<'PARSE_CPAN_META';
=item *
- Steffen M�ller <smueller at cpan.org>
+ Steffen Müller <smueller at cpan.org>
=back
@@ -18415,7 +18913,7 @@ $fatpacked{"Parse/CPAN/Meta.pm"} = <<'PARSE_CPAN_META';
=cut
PARSE_CPAN_META
-$fatpacked{"String/ShellQuote.pm"} = <<'STRING_SHELLQUOTE';
+$fatpacked{"String/ShellQuote.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'STRING_SHELLQUOTE';
# $Id: ShellQuote.pm,v 1.11 2010-06-11 20:08:57 roderick Exp $
#
# Copyright (c) 1997 Roderick Schertler. All rights reserved. This
@@ -18614,7 +19112,7 @@ $fatpacked{"String/ShellQuote.pm"} = <<'STRING_SHELLQUOTE';
=cut
STRING_SHELLQUOTE
-$fatpacked{"aliased.pm"} = <<'ALIASED';
+$fatpacked{"aliased.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'ALIASED';
package aliased;
our $VERSION = '0.31';
@@ -18946,7 +19444,7 @@ $fatpacked{"aliased.pm"} = <<'ALIASED';
=cut
ALIASED
-$fatpacked{"lib/core/only.pm"} = <<'LIB_CORE_ONLY';
+$fatpacked{"lib/core/only.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LIB_CORE_ONLY';
package lib::core::only;
use strict;
@@ -18968,12 +19466,17 @@ $fatpacked{"lib/core/only.pm"} = <<'LIB_CORE_ONLY';
To get only the core directories plus the ones for the local::lib in scope:
- $ perl -Mlib::core::only -Mlocal::lib=~/perl5 myscript.pl
+ $ perl -mlocal::lib -Mlib::core::only -Mlocal::lib=~/perl5 myscript.pl
To attempt to do a self-contained build (but note this will not reliably
propagate into subprocesses, see the CAVEATS below):
- $ PERL5OPT='-Mlib::core::only -Mlocal::lib=~/perl5' cpan
+ $ PERL5OPT='-mlocal::lib -Mlib::core::only -Mlocal::lib=~/perl5' cpan
+
+ Please note that it is necessary to use C<local::lib> twice for this to work.
+ First so that C<lib::core::only> doesn't prevent C<local::lib> from loading
+ (it's not currently in core) and then again after C<lib::core::only> so that
+ the local paths are not removed.
=head1 DESCRIPTION
@@ -19044,39 +19547,31 @@ $fatpacked{"lib/core/only.pm"} = <<'LIB_CORE_ONLY';
1;
LIB_CORE_ONLY
-$fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
+$fatpacked{"local/lib.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LOCAL_LIB';
+ package local::lib;
+ use 5.006;
use strict;
use warnings;
+ use Config;
+ use File::Spec ();
- package local::lib;
+ our $VERSION = '2.000008'; # 2.0.8
+ $VERSION = eval $VERSION;
- use 5.008001; # probably works with earlier versions but I'm not supporting them
- # (patches would, of course, be welcome)
+ sub import {
+ my ($class, @args) = @_;
+ push @args, @ARGV
+ if $0 eq '-';
- use File::Spec ();
- use File::Path ();
- use Config;
-
- our $VERSION = '1.008011'; # 1.8.11
-
- our @KNOWN_FLAGS = qw(--self-contained --deactivate --deactivate-all);
-
- sub DEACTIVATE_ONE () { 1 }
- sub DEACTIVATE_ALL () { 2 }
-
- sub INTERPOLATE_ENV () { 1 }
- sub LITERAL_ENV () { 0 }
-
- sub import {
- my ($class, @args) = @_;
+ my @steps;
+ my %opts;
+ my $shelltype;
- # Remember what PERL5LIB was when we started
- my $perl5lib = $ENV{PERL5LIB} || '';
-
- my %arg_store;
- for my $arg (@args) {
+ while (@args) {
+ my $arg = shift @args;
# check for lethal dash first to stop processing before causing problems
- if ($arg =~ /−/) {
+ # the fancy dash is U+2212 or \xE2\x88\x92
+ if ($arg =~ /\xE2\x88\x92/ or $arg =~ /−/) {
die <<'DEATH';
WHOA THERE! It looks like you've got some fancy dashes in your commandline!
These are *not* the traditional -- dashes that software recognizes. You
@@ -19086,514 +19581,550 @@ $fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
dashes with normal minus signs.
DEATH
}
- elsif(grep { $arg eq $_ } @KNOWN_FLAGS) {
- (my $flag = $arg) =~ s/--//;
- $arg_store{$flag} = 1;
+ elsif ($arg eq '--self-contained') {
+ die <<'DEATH';
+ FATAL: The local::lib --self-contained flag has never worked reliably and the
+ original author, Mark Stosberg, was unable or unwilling to maintain it. As
+ such, this flag has been removed from the local::lib codebase in order to
+ prevent misunderstandings and potentially broken builds. The local::lib authors
+ recommend that you look at the lib::core::only module shipped with this
+ distribution in order to create a more robust environment that is equivalent to
+ what --self-contained provided (although quite possibly not what you originally
+ thought it provided due to the poor quality of the documentation, for which we
+ apologise).
+ DEATH
+ }
+ elsif( $arg =~ /^--deactivate(?:=(.*))?$/ ) {
+ my $path = defined $1 ? $1 : shift @args;
+ push @steps, ['deactivate', $path];
+ }
+ elsif ( $arg eq '--deactivate-all' ) {
+ push @steps, ['deactivate_all'];
}
- elsif($arg =~ /^--/) {
+ elsif ( $arg =~ /^--shelltype(?:=(.*))?$/ ) {
+ $shelltype = defined $1 ? $1 : shift @args;
+ }
+ elsif ( $arg eq '--no-create' ) {
+ $opts{no_create} = 1;
+ }
+ elsif ( $arg =~ /^--/ ) {
die "Unknown import argument: $arg";
}
else {
- # assume that what's left is a path
- $arg_store{path} = $arg;
+ push @steps, ['activate', $arg];
}
}
-
- if($arg_store{'self-contained'}) {
- die "FATAL: The local::lib --self-contained flag has never worked reliably and the original author, Mark Stosberg, was unable or unwilling to maintain it. As such, this flag has been removed from the local::lib codebase in order to prevent misunderstandings and potentially broken builds. The local::lib authors recommend that you look at the lib::core::only module shipped with this distribution in order to create a more robust environment that is equivalent to what --self-contained [...]
- }
-
- my $deactivating = 0;
- if ($arg_store{deactivate}) {
- $deactivating = DEACTIVATE_ONE;
- }
- if ($arg_store{'deactivate-all'}) {
- $deactivating = DEACTIVATE_ALL;
+ if (!@steps) {
+ push @steps, ['activate', undef];
}
- $arg_store{path} = $class->resolve_path($arg_store{path});
- $class->setup_local_lib_for($arg_store{path}, $deactivating);
+ my $self = $class->new(%opts);
- for (@INC) { # Untaint @INC
- next if ref; # Skip entry if it is an ARRAY, CODE, blessed, etc.
- m/(.*)/ and $_ = $1;
+ for (@steps) {
+ my ($method, @args) = @$_;
+ $self = $self->$method(@args);
}
- }
-
- sub pipeline;
- sub pipeline {
- my @methods = @_;
- my $last = pop(@methods);
- if (@methods) {
- \sub {
- my ($obj, @args) = @_;
- $obj->${pipeline @methods}(
- $obj->$last(@args)
- );
- };
- } else {
- \sub {
- shift->$last(@_);
- };
+ if ($0 eq '-') {
+ print $self->environment_vars_string($shelltype);
+ exit 0;
+ }
+ else {
+ $self->setup_local_lib;
}
}
- =begin testing
-
- #:: test pipeline
-
- package local::lib;
+ sub new {
+ my $class = shift;
+ bless {@_}, $class;
+ }
- { package Foo; sub foo { -$_[1] } sub bar { $_[1]+2 } sub baz { $_[1]+3 } }
- my $foo = bless({}, 'Foo');
- Test::More::ok($foo->${pipeline qw(foo bar baz)}(10) == -15);
+ sub clone {
+ my $self = shift;
+ bless {%$self, @_}, ref $self;
+ }
+
+ sub inc { $_[0]->{inc} ||= \@INC }
+ sub libs { $_[0]->{libs} ||= [ \'PERL5LIB' ] }
+ sub bins { $_[0]->{bins} ||= [ \'PATH' ] }
+ sub roots { $_[0]->{roots} ||= [ \'PERL_LOCAL_LIB_ROOT' ] }
+ sub extra { $_[0]->{extra} ||= {} }
+ sub no_create { $_[0]->{no_create} }
+
+ my $_archname = $Config{archname};
+ my $_version = $Config{version};
+ my @_inc_version_list = reverse split / /, $Config{inc_version_list};
+ my $_path_sep = $Config{path_sep};
+
+ sub _as_list {
+ my $list = shift;
+ grep length, map {
+ !(ref $_ && ref $_ eq 'SCALAR') ? $_ : (
+ defined $ENV{$$_} ? split(/\Q$_path_sep/, $ENV{$$_})
+ : ()
+ )
+ } ref $list ? @$list : $list;
+ }
+ sub _remove_from {
+ my ($list, @remove) = @_;
+ return @$list
+ if !@remove;
+ my %remove = map { $_ => 1 } @remove;
+ grep !$remove{$_}, _as_list($list);
+ }
+
+ my @_lib_subdirs = (
+ [$_version, $_archname],
+ [$_version],
+ [$_archname],
+ (@_inc_version_list ? \@_inc_version_list : ()),
+ [],
+ );
- =end testing
+ sub install_base_bin_path {
+ my ($class, $path) = @_;
+ return File::Spec->catdir($path, 'bin');
+ }
+ sub install_base_perl_path {
+ my ($class, $path) = @_;
+ return File::Spec->catdir($path, 'lib', 'perl5');
+ }
+ sub install_base_arch_path {
+ my ($class, $path) = @_;
+ File::Spec->catdir($class->install_base_perl_path($path), $_archname);
+ }
- =cut
+ sub lib_paths_for {
+ my ($class, $path) = @_;
+ my $base = $class->install_base_perl_path($path);
+ return map { File::Spec->catdir($base, @$_) } @_lib_subdirs;
+ }
- sub _uniq {
- my %seen;
- grep { ! $seen{$_}++ } @_;
+ sub _mm_escape_path {
+ my $path = shift;
+ $path =~ s/\\/\\\\\\\\/g;
+ if ($path =~ s/ /\\ /g) {
+ $path = qq{"\\"$path\\""};
+ }
+ return $path;
}
- sub resolve_path {
- my ($class, $path) = @_;
- $class->${pipeline qw(
- resolve_relative_path
- resolve_home_path
- resolve_empty_path
- )}($path);
+ sub _mb_escape_path {
+ my $path = shift;
+ $path =~ s/\\/\\\\/g;
+ return qq{"$path"};
}
- sub resolve_empty_path {
+ sub installer_options_for {
my ($class, $path) = @_;
- if (defined $path) {
- $path;
- } else {
- '~/perl5';
- }
+ return (
+ PERL_MM_OPT =>
+ defined $path ? "INSTALL_BASE="._mm_escape_path($path) : undef,
+ PERL_MB_OPT =>
+ defined $path ? "--install_base "._mb_escape_path($path) : undef,
+ );
}
- =begin testing
+ sub active_paths {
+ my ($self) = @_;
+ $self = ref $self ? $self : $self->new;
- #:: test classmethod setup
+ return grep {
+ # screen out entries that aren't actually reflected in @INC
+ my $active_ll = $self->install_base_perl_path($_);
+ grep { $_ eq $active_ll } @{$self->inc};
+ } _as_list($self->roots);
+ }
- my $c = 'local::lib';
- =end testing
+ sub deactivate {
+ my ($self, $path) = @_;
+ $self = $self->new unless ref $self;
+ $path = $self->resolve_path($path);
+ $path = $self->normalize_path($path);
- =begin testing
+ my @active_lls = $self->active_paths;
- #:: test classmethod
+ if (!grep { $_ eq $path } @active_lls) {
+ warn "Tried to deactivate inactive local::lib '$path'\n";
+ return $self;
+ }
- is($c->resolve_empty_path, '~/perl5');
- is($c->resolve_empty_path('foo'), 'foo');
+ my %args = (
+ bins => [ _remove_from($self->bins,
+ $self->install_base_bin_path($path)) ],
+ libs => [ _remove_from($self->libs,
+ $self->install_base_perl_path($path)) ],
+ inc => [ _remove_from($self->inc,
+ $self->lib_paths_for($path)) ],
+ roots => [ _remove_from($self->roots, $path) ],
+ );
- =end testing
+ $args{extra} = { $self->installer_options_for($args{roots}[0]) };
- =cut
+ $self->clone(%args);
+ }
- sub resolve_home_path {
- my ($class, $path) = @_;
- return $path unless ($path =~ /^~/);
- my ($user) = ($path =~ /^~([^\/]+)/); # can assume ^~ so undef for 'us'
- my $tried_file_homedir;
- my $homedir = do {
- if (eval { require File::HomeDir } && $File::HomeDir::VERSION >= 0.65) {
- $tried_file_homedir = 1;
- if (defined $user) {
- File::HomeDir->users_home($user);
- } else {
- File::HomeDir->my_home;
- }
- } else {
- if (defined $user) {
- (getpwnam $user)[7];
- } else {
- if (defined $ENV{HOME}) {
- $ENV{HOME};
- } else {
- (getpwuid $<)[7];
- }
- }
- }
- };
- unless (defined $homedir) {
- require Carp;
- Carp::croak(
- "Couldn't resolve homedir for "
- .(defined $user ? $user : 'current user')
- .($tried_file_homedir ? '' : ' - consider installing File::HomeDir')
+ sub deactivate_all {
+ my ($self) = @_;
+ $self = $self->new unless ref $self;
+
+ my @active_lls = $self->active_paths;
+
+ my %args;
+ if (@active_lls) {
+ %args = (
+ bins => [ _remove_from($self->bins,
+ map $self->install_base_bin_path($_), @active_lls) ],
+ libs => [ _remove_from($self->libs,
+ map $self->install_base_perl_path($_), @active_lls) ],
+ inc => [ _remove_from($self->inc,
+ map $self->lib_paths_for($_), @active_lls) ],
+ roots => [ _remove_from($self->roots, @active_lls) ],
);
}
- $path =~ s/^~[^\/]*/$homedir/;
- $path;
- }
-
- sub resolve_relative_path {
- my ($class, $path) = @_;
- $path = File::Spec->rel2abs($path);
- }
- =begin testing
+ $args{extra} = { $self->installer_options_for(undef) };
- #:: test classmethod
+ $self->clone(%args);
+ }
- local *File::Spec::rel2abs = sub { shift; 'FOO'.shift; };
- is($c->resolve_relative_path('bar'),'FOObar');
+ sub activate {
+ my ($self, $path) = @_;
+ $self = $self->new unless ref $self;
+ $path = $self->resolve_path($path);
+ $self->ensure_dir_structure_for($path)
+ unless $self->no_create;
- =end testing
+ $path = $self->normalize_path($path);
- =cut
+ my @active_lls = $self->active_paths;
- sub setup_local_lib_for {
- my ($class, $path, $deactivating) = @_;
-
- my $interpolate = LITERAL_ENV;
- my @active_lls = $class->active_paths;
-
- $class->ensure_dir_structure_for($path);
-
- # On Win32 directories often contain spaces. But some parts of the CPAN
- # toolchain don't like that. To avoid this, GetShortPathName() gives us
- # an alternate representation that has none.
- # This only works if the directory already exists.
- $path = Win32::GetShortPathName($path) if $^O eq 'MSWin32';
-
- if (! $deactivating) {
- if (@active_lls && $active_lls[-1] eq $path) {
- exit 0 if $0 eq '-';
- return; # Asked to add what's already at the top of the stack
- } elsif (grep { $_ eq $path} @active_lls) {
- # Asked to add a dir that's lower in the stack -- so we remove it from
- # where it is, and then add it back at the top.
- $class->setup_env_hash_for($path, DEACTIVATE_ONE);
- # Which means we can no longer output "PERL5LIB=...:$PERL5LIB" stuff
- # anymore because we're taking something *out*.
- $interpolate = INTERPOLATE_ENV;
- }
+ if (grep { $_ eq $path } @active_lls[1 .. $#active_lls]) {
+ $self = $self->deactivate($path);
}
- if ($0 eq '-') {
- $class->print_environment_vars_for($path, $deactivating, $interpolate);
- exit 0;
- } else {
- $class->setup_env_hash_for($path, $deactivating);
- my $arch_dir = $Config{archname};
- @INC = _uniq(
- (
- # Inject $path/$archname for each path in PERL5LIB
- map { ( File::Spec->catdir($_, $arch_dir), $_ ) }
- split($Config{path_sep}, $ENV{PERL5LIB})
- ),
- @INC
+ my %args;
+ if (!@active_lls || $active_lls[0] ne $path) {
+ %args = (
+ bins => [ $self->install_base_bin_path($path), @{$self->bins} ],
+ libs => [ $self->install_base_perl_path($path), @{$self->libs} ],
+ inc => [ $self->lib_paths_for($path), @{$self->inc} ],
+ roots => [ $path, @{$self->roots} ],
);
}
- }
- sub install_base_bin_path {
- my ($class, $path) = @_;
- File::Spec->catdir($path, 'bin');
+ $args{extra} = { $self->installer_options_for($path) };
+
+ $self->clone(%args);
}
- sub install_base_perl_path {
- my ($class, $path) = @_;
- File::Spec->catdir($path, 'lib', 'perl5');
+ sub normalize_path {
+ my ($self, $path) = @_;
+ $path = ( Win32::GetShortPathName($path) || $path )
+ if $^O eq 'MSWin32';
+ return $path;
}
- sub install_base_arch_path {
- my ($class, $path) = @_;
- File::Spec->catdir($class->install_base_perl_path($path), $Config{archname});
+ sub build_environment_vars_for {
+ my $self = $_[0]->new->activate($_[1]);
+ $self->build_environment_vars;
+ }
+ sub build_environment_vars {
+ my $self = shift;
+ (
+ PATH => join($_path_sep, _as_list($self->bins)),
+ PERL5LIB => join($_path_sep, _as_list($self->libs)),
+ PERL_LOCAL_LIB_ROOT => join($_path_sep, _as_list($self->roots)),
+ %{$self->extra},
+ );
}
- sub ensure_dir_structure_for {
- my ($class, $path) = @_;
- unless (-d $path) {
- warn "Attempting to create directory ${path}\n";
- }
- File::Path::mkpath($path);
- return
+ sub setup_local_lib_for {
+ my $self = $_[0]->new->activate($_[1]);
+ $self->setup_local_lib;
}
- sub guess_shelltype {
- my $shellbin = 'sh';
- if(defined $ENV{'SHELL'}) {
- my @shell_bin_path_parts = File::Spec->splitpath($ENV{'SHELL'});
- $shellbin = $shell_bin_path_parts[-1];
- }
- my $shelltype = do {
- local $_ = $shellbin;
- if(/csh/) {
- 'csh'
- } else {
- 'bourne'
- }
- };
+ sub setup_local_lib {
+ my $self = shift;
+ $self->setup_env_hash;
+ @INC = @{$self->inc};
+ }
- # Both Win32 and Cygwin have $ENV{COMSPEC} set.
- if (defined $ENV{'COMSPEC'} && $^O ne 'cygwin') {
- my @shell_bin_path_parts = File::Spec->splitpath($ENV{'COMSPEC'});
- $shellbin = $shell_bin_path_parts[-1];
- $shelltype = do {
- local $_ = $shellbin;
- if(/command\.com/) {
- 'win32'
- } elsif(/cmd\.exe/) {
- 'win32'
- } elsif(/4nt\.exe/) {
- 'win32'
- } else {
- $shelltype
- }
- };
+ sub setup_env_hash_for {
+ my $self = $_[0]->new->activate($_[1]);
+ $self->setup_env_hash;
+ }
+ sub setup_env_hash {
+ my $self = shift;
+ my %env = $self->build_environment_vars;
+ for my $key (keys %env) {
+ if (defined $env{$key}) {
+ $ENV{$key} = $env{$key};
+ }
+ else {
+ delete $ENV{$key};
+ }
}
- return $shelltype;
}
sub print_environment_vars_for {
- my ($class, $path, $deactivating, $interpolate) = @_;
- print $class->environment_vars_string_for($path, $deactivating, $interpolate);
+ print $_[0]->environment_vars_string_for(@_[1..$#_]);
}
sub environment_vars_string_for {
- my ($class, $path, $deactivating, $interpolate) = @_;
- my @envs = $class->build_environment_vars_for($path, $deactivating, $interpolate);
- my $out = '';
+ my $self = $_[0]->new->activate($_[1]);
+ $self->environment_vars_string;
+ }
+ sub environment_vars_string {
+ my ($self, $shelltype) = @_;
- # rather basic csh detection, goes on the assumption that something won't
- # call itself csh unless it really is. also, default to bourne in the
- # pathological situation where a user doesn't have $ENV{SHELL} defined.
- # note also that shells with funny names, like zoid, are assumed to be
- # bourne.
+ $shelltype ||= $self->guess_shelltype;
- my $shelltype = $class->guess_shelltype;
+ my $build_method = "build_${shelltype}_env_declaration";
+ my $extra = $self->extra;
+ my @envs = (
+ PATH => $self->bins,
+ PERL5LIB => $self->libs,
+ PERL_LOCAL_LIB_ROOT => $self->roots,
+ map { $_ => $extra->{$_} } sort keys %$extra,
+ );
+ my $out = '';
while (@envs) {
my ($name, $value) = (shift(@envs), shift(@envs));
- $value =~ s/(\\")/\\$1/g if defined $value;
- $out .= $class->${\"build_${shelltype}_env_declaration"}($name, $value);
+ if (
+ ref $value
+ && @$value == 1
+ && ref $value->[0]
+ && ref $value->[0] eq 'SCALAR'
+ && ${$value->[0]} eq $name) {
+ next;
+ }
+ if (
+ !ref $value
+ and defined $value
+ ? (defined $ENV{$name} && $value eq $ENV{$name})
+ : !defined $ENV{$name}
+ ) {
+ next;
+ }
+ $out .= $self->$build_method($name, $value);
+ }
+ my $wrap_method = "wrap_${shelltype}_output";
+ if ($self->can($wrap_method)) {
+ return $self->$wrap_method($out);
}
return $out;
}
- # simple routines that take two arguments: an %ENV key and a value. return
- # strings that are suitable for passing directly to the relevant shell to set
- # said key to said value.
sub build_bourne_env_declaration {
- my $class = shift;
- my($name, $value) = @_;
- return defined($value) ? qq{export ${name}="${value}";\n} : qq{unset ${name};\n};
- }
+ my ($class, $name, $args) = @_;
+ my $value = $class->_interpolate($args, '$%s', '"', '\\%s');
- sub build_csh_env_declaration {
- my $class = shift;
- my($name, $value) = @_;
- return defined($value) ? qq{setenv ${name} "${value}"\n} : qq{unsetenv ${name}\n};
- }
+ if (!defined $value) {
+ return qq{unset $name;\n};
+ }
- sub build_win32_env_declaration {
- my $class = shift;
- my($name, $value) = @_;
- return defined($value) ? qq{set ${name}=${value}\n} : qq{set ${name}=\n};
- }
+ $value =~ s/(^|\G|$_path_sep)\$$name$_path_sep/$1\$$name\${$name+$_path_sep}/g;
+ $value =~ s/$_path_sep\$$name$/\${$name+$_path_sep}\$$name/;
- sub setup_env_hash_for {
- my ($class, $path, $deactivating) = @_;
- my %envs = $class->build_environment_vars_for($path, $deactivating, INTERPOLATE_ENV);
- @ENV{keys %envs} = values %envs;
+ qq{${name}="$value"; export ${name};\n}
}
- sub build_environment_vars_for {
- my ($class, $path, $deactivating, $interpolate) = @_;
-
- if ($deactivating == DEACTIVATE_ONE) {
- return $class->build_deactivate_environment_vars_for($path, $interpolate);
- } elsif ($deactivating == DEACTIVATE_ALL) {
- return $class->build_deact_all_environment_vars_for($path, $interpolate);
- } else {
- return $class->build_activate_environment_vars_for($path, $interpolate);
+ sub build_csh_env_declaration {
+ my ($class, $name, $args) = @_;
+ my ($value, @vars) = $class->_interpolate($args, '$%s', '"', '"\\%s"');
+ if (!defined $value) {
+ return qq{unsetenv $name;\n};
}
- }
- # Build an environment value for a variable like PATH from a list of paths.
- # References to existing variables are given as references to the variable name.
- # Duplicates are removed.
- #
- # options:
- # - interpolate: INTERPOLATE_ENV/LITERAL_ENV
- # - exists: paths are included only if they exist (default: interpolate == INTERPOLATE_ENV)
- # - filter: function to apply to each path do decide if it must be included
- # - empty: the value to return in the case of empty value
- my %ENV_LIST_VALUE_DEFAULTS = (
- interpolate => INTERPOLATE_ENV,
- exists => undef,
- filter => sub { 1 },
- empty => undef,
- );
- sub _env_list_value {
- my $options = shift;
- die(sprintf "unknown option '$_' at %s line %u\n", (caller)[1..2])
- for grep { !exists $ENV_LIST_VALUE_DEFAULTS{$_} } keys %$options;
- my %options = (%ENV_LIST_VALUE_DEFAULTS, %{ $options });
- $options{exists} = $options{interpolate} == INTERPOLATE_ENV
- unless defined $options{exists};
-
- my %seen;
-
- my $value = join($Config{path_sep}, map {
- ref $_ ? ($^O eq 'MSWin32' ? "%${$_}%" : "\$${$_}") : $_
- } grep {
- ref $_ || (defined $_
- && length($_) > 0
- && !$seen{$_}++
- && $options{filter}->($_)
- && (!$options{exists} || -e $_))
- } map {
- if (ref $_ eq 'SCALAR' && $options{interpolate} == INTERPOLATE_ENV) {
- defined $ENV{${$_}} ? (split /\Q$Config{path_sep}/, $ENV{${$_}}) : ()
- } else {
- $_
- }
- } @_);
- return length($value) ? $value : $options{empty};
- }
+ my $out = '';
+ for my $var (@vars) {
+ $out .= qq{if ! \$?$name setenv $name '';\n};
+ }
- sub build_activate_environment_vars_for {
- my ($class, $path, $interpolate) = @_;
- return (
- PERL_LOCAL_LIB_ROOT =>
- _env_list_value(
- { interpolate => $interpolate, exists => 0, empty => '' },
- \'PERL_LOCAL_LIB_ROOT',
- $path,
- ),
- PERL_MB_OPT => "--install_base ${path}",
- PERL_MM_OPT => "INSTALL_BASE=${path}",
- PERL5LIB =>
- _env_list_value(
- { interpolate => $interpolate, exists => 0, empty => '' },
- $class->install_base_perl_path($path),
- \'PERL5LIB',
- ),
- PATH => _env_list_value(
- { interpolate => $interpolate, exists => 0, empty => '' },
- $class->install_base_bin_path($path),
- \'PATH',
- ),
- )
+ my $value_without = $value;
+ if ($value_without =~ s/(?:^|$_path_sep)\$$name(?:$_path_sep|$)//g) {
+ $out .= qq{if "\$$name" != '' setenv $name "$value";\n};
+ $out .= qq{if "\$$name" == '' };
+ }
+ $out .= qq{setenv $name "$value_without";\n};
+ return $out;
}
- sub active_paths {
- my ($class) = @_;
+ sub build_cmd_env_declaration {
+ my ($class, $name, $args) = @_;
+ my $value = $class->_interpolate($args, '%%%s%%', qr([()!^"<>&|]), '^%s');
+ if (!$value) {
+ return qq{\@set $name=\n};
+ }
- return () unless defined $ENV{PERL_LOCAL_LIB_ROOT};
- return grep { $_ ne '' } split /\Q$Config{path_sep}/, $ENV{PERL_LOCAL_LIB_ROOT};
+ my $out = '';
+ my $value_without = $value;
+ if ($value_without =~ s/(?:^|$_path_sep)%$name%(?:$_path_sep|$)//g) {
+ $out .= qq{\@if not "%$name%"=="" set $name=$value\n};
+ $out .= qq{\@if "%$name%"=="" };
+ }
+ $out .= qq{\@set $name=$value_without\n};
+ return $out;
}
- sub build_deactivate_environment_vars_for {
- my ($class, $path, $interpolate) = @_;
+ sub build_powershell_env_declaration {
+ my ($class, $name, $args) = @_;
+ my $value = $class->_interpolate($args, '$env:%s', '"', '`%s');
- my @active_lls = $class->active_paths;
-
- if (!grep { $_ eq $path } @active_lls) {
- warn "Tried to deactivate inactive local::lib '$path'\n";
- return ();
+ if (!$value) {
+ return qq{Remove-Item -ErrorAction 0 Env:\\$name;\n};
}
- my $perl_path = $class->install_base_perl_path($path);
- my $arch_path = $class->install_base_arch_path($path);
- my $bin_path = $class->install_base_bin_path($path);
+ my $maybe_path_sep = qq{\$(if("\$env:$name"-eq""){""}else{"$_path_sep"})};
+ $value =~ s/(^|\G|$_path_sep)\$env:$name$_path_sep/$1\$env:$name"+$maybe_path_sep+"/g;
+ $value =~ s/$_path_sep\$env:$name$/"+$maybe_path_sep+\$env:$name+"/;
+ qq{\$env:$name = \$("$value");\n};
+ }
+ sub wrap_powershell_output {
+ my ($class, $out) = @_;
+ return $out || " \n";
+ }
- my %env = (
- PERL_LOCAL_LIB_ROOT => _env_list_value(
- {
- exists => 0,
- },
- grep { $_ ne $path } @active_lls
- ),
- PERL5LIB => _env_list_value(
- {
- exists => 0,
- filter => sub {
- $_ ne $perl_path && $_ ne $arch_path
- },
- },
- \'PERL5LIB',
- ),
- PATH => _env_list_value(
- {
- exists => 0,
- filter => sub { $_ ne $bin_path },
- },
- \'PATH',
- ),
- );
-
- # If removing ourselves from the "top of the stack", set install paths to
- # correspond with the new top of stack.
- if ($active_lls[-1] eq $path) {
- my $new_top = $active_lls[-2];
- $env{PERL_MB_OPT} = defined($new_top) ? "--install_base ${new_top}" : undef;
- $env{PERL_MM_OPT} = defined($new_top) ? "INSTALL_BASE=${new_top}" : undef;
+ sub build_fish_env_declaration {
+ my ($class, $name, $args) = @_;
+ my $value = $class->_interpolate($args, '$%s', '"', '\\%s');
+ if (!defined $value) {
+ return qq{set -e $name;\n};
}
+ $value =~ s/$_path_sep/ /g;
+ qq{set -x $name $value;\n};
+ }
- return %env;
+ sub _interpolate {
+ my ($class, $args, $var_pat, $escape, $escape_pat) = @_;
+ return
+ unless defined $args;
+ my @args = ref $args ? @$args : $args;
+ return
+ unless @args;
+ my @vars = map { $$_ } grep { ref $_ eq 'SCALAR' } @args;
+ my $string = join $_path_sep, map {
+ ref $_ eq 'SCALAR' ? sprintf($var_pat, $$_) : do {
+ s/($escape)/sprintf($escape_pat, $1)/ge; $_;
+ };
+ } @args;
+ return wantarray ? ($string, \@vars) : $string;
}
- sub build_deact_all_environment_vars_for {
- my ($class, $path, $interpolate) = @_;
+ sub pipeline;
- my @active_lls = $class->active_paths;
+ sub pipeline {
+ my @methods = @_;
+ my $last = pop(@methods);
+ if (@methods) {
+ \sub {
+ my ($obj, @args) = @_;
+ $obj->${pipeline @methods}(
+ $obj->$last(@args)
+ );
+ };
+ } else {
+ \sub {
+ shift->$last(@_);
+ };
+ }
+ }
- my %perl_paths = map { (
- $class->install_base_perl_path($_) => 1,
- $class->install_base_arch_path($_) => 1
- ) } @active_lls;
- my %bin_paths = map { (
- $class->install_base_bin_path($_) => 1,
- ) } @active_lls;
+ sub resolve_path {
+ my ($class, $path) = @_;
- my %env = (
- PERL_LOCAL_LIB_ROOT => undef,
- PERL_MM_OPT => undef,
- PERL_MB_OPT => undef,
- PERL5LIB => _env_list_value(
- {
- exists => 0,
- filter => sub {
- ! scalar grep { exists $perl_paths{$_} } $_[0]
- },
- },
- \'PERL5LIB'
- ),
- PATH => _env_list_value(
- {
- exists => 0,
- filter => sub {
- ! scalar grep { exists $bin_paths{$_} } $_[0]
- },
- },
- \'PATH'
- ),
- );
+ $path = $class->${pipeline qw(
+ resolve_relative_path
+ resolve_home_path
+ resolve_empty_path
+ )}($path);
- return %env;
+ $path;
}
- =begin testing
+ sub resolve_empty_path {
+ my ($class, $path) = @_;
+ if (defined $path) {
+ $path;
+ } else {
+ '~/perl5';
+ }
+ }
- #:: test classmethod
+ sub resolve_home_path {
+ my ($class, $path) = @_;
+ $path =~ /^~([^\/]*)/ or return $path;
+ my $user = $1;
+ my $homedir = do {
+ if (! length($user) && defined $ENV{HOME}) {
+ $ENV{HOME};
+ }
+ else {
+ require File::Glob;
+ File::Glob::bsd_glob("~$user", File::Glob::GLOB_TILDE());
+ }
+ };
+ unless (defined $homedir) {
+ require Carp;
+ Carp::croak(
+ "Couldn't resolve homedir for "
+ .(defined $user ? $user : 'current user')
+ );
+ }
+ $path =~ s/^~[^\/]*/$homedir/;
+ $path;
+ }
- File::Path::rmtree('t/var/splat');
+ sub resolve_relative_path {
+ my ($class, $path) = @_;
+ $path = File::Spec->rel2abs($path);
+ }
- $c->ensure_dir_structure_for('t/var/splat');
+ sub ensure_dir_structure_for {
+ my ($class, $path) = @_;
+ unless (-d $path) {
+ warn "Attempting to create directory ${path}\n";
+ }
+ require File::Basename;
+ my @dirs;
+ while(!-d $path) {
+ push @dirs, $path;
+ $path = File::Basename::dirname($path);
+ }
+ mkdir $_ for reverse @dirs;
+ return;
+ }
- ok(-d 't/var/splat');
+ sub guess_shelltype {
+ my $shellbin
+ = defined $ENV{SHELL}
+ ? ($ENV{SHELL} =~ /([\w.]+)$/)[-1]
+ : ( $^O eq 'MSWin32' && exists $ENV{'!EXITCODE'} )
+ ? 'bash'
+ : ( $^O eq 'MSWin32' && $ENV{PROMPT} && $ENV{COMSPEC} )
+ ? ($ENV{COMSPEC} =~ /([\w.]+)$/)[-1]
+ : ( $^O eq 'MSWin32' && !$ENV{PROMPT} )
+ ? 'powershell.exe'
+ : 'sh';
+
+ for ($shellbin) {
+ return
+ /csh$/ ? 'csh'
+ : /fish/ ? 'fish'
+ : /command(?:\.com)?$/i ? 'cmd'
+ : /cmd(?:\.exe)?$/i ? 'cmd'
+ : /4nt(?:\.exe)?$/i ? 'cmd'
+ : /powershell(?:\.exe)?$/i ? 'powershell'
+ : 'bourne';
+ }
+ }
- =end testing
+ 1;
+ __END__
=encoding utf8
@@ -19620,19 +20151,24 @@ $fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
# Just print out useful shell commands
$ perl -Mlocal::lib
- export PERL_MB_OPT='--install_base /home/username/perl5'
- export PERL_MM_OPT='INSTALL_BASE=/home/username/perl5'
- export PERL5LIB='/home/username/perl5/lib/perl5/i386-linux:/home/username/perl5/lib/perl5'
- export PATH="/home/username/perl5/bin:$PATH"
+ PERL_MB_OPT='--install_base /home/username/perl5'; export PERL_MB_OPT;
+ PERL_MM_OPT='INSTALL_BASE=/home/username/perl5'; export PERL_MM_OPT;
+ PERL5LIB="/home/username/perl5/lib/perl5"; export PERL5LIB;
+ PATH="/home/username/perl5/bin:$PATH"; export PATH;
+ PERL_LOCAL_LIB_ROOT="/home/usename/perl5:$PERL_LOCAL_LIB_ROOT"; export PERL_LOCAL_LIB_ROOT;
+
+ From a .bashrc file -
+
+ [ $SHLVL -eq 1 ] && eval "$(perl -I$HOME/perl5/lib/perl5 -Mlocal::lib)"
=head2 The bootstrapping technique
A typical way to install local::lib is using what is known as the
"bootstrapping" technique. You would do this if your system administrator
hasn't already installed local::lib. In this case, you'll need to install
- local::lib in your home directory.
+ local::lib in your home directory.
- If you do have administrative privileges, you will still want to set up your
+ Even if you do have administrative privileges, you will still want to set up your
environment variables, as discussed in step 4. Without this, you would still
install the modules into the system CPAN installation and also your Perl scripts
will not use the lib/ path you bootstrapped with local::lib.
@@ -19641,12 +20177,18 @@ $fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
Windows users must also see L</Differences when using this module under Win32>.
- 1. Download and unpack the local::lib tarball from CPAN (search for "Download"
+ =over 4
+
+ =item 1.
+
+ Download and unpack the local::lib tarball from CPAN (search for "Download"
on the CPAN page about local::lib). Do this as an ordinary user, not as root
or administrator. Unpack the file in your home directory or in any other
convenient location.
- 2. Run this:
+ =item 2.
+
+ Run this:
perl Makefile.PL --bootstrap
@@ -19658,42 +20200,49 @@ $fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
perl Makefile.PL --bootstrap=~/foo
- 3. Run this: (local::lib assumes you have make installed on your system)
+ =item 3.
+
+ Run this: (local::lib assumes you have make installed on your system)
make test && make install
- 4. Now we need to setup the appropriate environment variables, so that Perl
+ =item 4.
+
+ Now we need to setup the appropriate environment variables, so that Perl
starts using our newly generated lib/ directory. If you are using bash or
any other Bourne shells, you can add this to your shell startup script this
way:
- echo 'eval $(perl -I$HOME/perl5/lib/perl5 -Mlocal::lib)' >>~/.bashrc
+ echo '[ $SHLVL -eq 1 ] && eval "$(perl -I$HOME/perl5/lib/perl5 -Mlocal::lib)"' >>~/.bashrc
If you are using C shell, you can do this as follows:
/bin/csh
echo $SHELL
/bin/csh
- perl -I$HOME/perl5/lib/perl5 -Mlocal::lib >> ~/.cshrc
+ echo 'eval `perl -I$HOME/perl5/lib/perl5 -Mlocal::lib`' >> ~/.cshrc
- If you passed to bootstrap a directory other than default, you also need to give that as
- import parameter to the call of the local::lib module like this way:
+ If you passed to bootstrap a directory other than default, you also need to
+ give that as import parameter to the call of the local::lib module like this
+ way:
- echo 'eval $(perl -I$HOME/foo/lib/perl5 -Mlocal::lib=$HOME/foo)' >>~/.bashrc
+ echo '[ $SHLVL -eq 1 ] && eval "$(perl -I$HOME/foo/lib/perl5 -Mlocal::lib=$HOME/foo)"' >>~/.bashrc
After writing your shell configuration file, be sure to re-read it to get the
- changed settings into your current shell's environment. Bourne shells use
+ changed settings into your current shell's environment. Bourne shells use
C<. ~/.bashrc> for this, whereas C shells use C<source ~/.cshrc>.
+ =back
+
If you're on a slower machine, or are operating under draconian disk space
limitations, you can disable the automatic generation of manpages from POD when
installing modules by using the C<--no-manpages> argument when bootstrapping:
perl Makefile.PL --bootstrap --no-manpages
- To avoid doing several bootstrap for several Perl module environments on the
- same account, for example if you use it for several different deployed
- applications independently, you can use one bootstrapped local::lib
+ To avoid doing several bootstrap for several Perl module environments on the
+ same account, for example if you use it for several different deployed
+ applications independently, you can use one bootstrapped local::lib
installation to install modules in different directories directly this way:
cd ~/mydir1
@@ -19704,6 +20253,12 @@ $fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
cd ../mydir2
... REPEAT ...
+ When used in a C<.bashrc> file, it is recommended that you protect against
+ re-activating a directory in a sub-shell. This can be done by checking the
+ C<$SHLVL> variable as shown in synopsis. Without this, sub-shells created by
+ the user or other programs will override changes made to the parent shell's
+ environment.
+
If you are working with several C<local::lib> environments, you may want to
remove some of them from the current environment without disturbing the others.
You can deactivate one environment like this (using bourne sh):
@@ -19744,14 +20299,14 @@ $fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
C:\>perl -Mlocal::lib
set PERL_MB_OPT=--install_base C:\DOCUME~1\ADMINI~1\perl5
set PERL_MM_OPT=INSTALL_BASE=C:\DOCUME~1\ADMINI~1\perl5
- set PERL5LIB=C:\DOCUME~1\ADMINI~1\perl5\lib\perl5;C:\DOCUME~1\ADMINI~1\perl5\lib\perl5\MSWin32-x86-multi-thread
+ set PERL5LIB=C:\DOCUME~1\ADMINI~1\perl5\lib\perl5
set PATH=C:\DOCUME~1\ADMINI~1\perl5\bin;%PATH%
-
+
### To set the environment for this shell alone
C:\>perl -Mlocal::lib > %TEMP%\tmp.bat && %TEMP%\tmp.bat && del %TEMP%\tmp.bat
### instead of $(perl -Mlocal::lib=./)
- If you want the environment entries to persist, you'll need to add then to the
+ If you want the environment entries to persist, you'll need to add them to the
Control Panel's System applet yourself or use L<App::local::lib::Win32Helper>.
The "~" is translated to the user's profile directory (the directory named for
@@ -19760,6 +20315,13 @@ $fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
directory is translated to a short name (which means the directory must exist)
and the subdirectories are created.
+ =head3 PowerShell
+
+ local::lib also supports PowerShell, and can be used with the
+ C<Invoke-Expression> cmdlet.
+
+ Invoke-Expression "$(perl -Mlocal::lib)"
+
=head1 RATIONALE
The version of a Perl package on your machine is not always the version you
@@ -19780,7 +20342,7 @@ $fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
If you are using a package management system (such as Debian), you don't need to
worry about Debian and CPAN stepping on each other's toes. Your local version
of the packages will be written to an entirely separate directory from those
- installed by Debian.
+ installed by Debian.
=head1 DESCRIPTION
@@ -19810,10 +20372,12 @@ $fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
=item PATH
- PATH is appended to, rather than clobbered.
+ =item PERL_LOCAL_LIB_ROOT
=back
+ When possible, these will be appended to instead of overwritten entirely.
+
These values are then available for reference by any code after import.
=head1 CREATING A SELF-CONTAINED SET OF MODULES
@@ -19822,7 +20386,7 @@ $fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
there are a number of caveats, and the best approach is always to perform a
build against a clean perl (i.e. site and vendor as close to empty as possible).
- =head1 OPTIONS
+ =head1 IMPORT OPTIONS
Options are values that can be passed to the C<local::lib> import besides the
directory to use. They are specified as C<use local::lib '--option'[, path];>
@@ -19838,7 +20402,18 @@ $fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
Remove all directories that were added to search paths by C<local::lib> from the
search paths.
- =head1 METHODS
+ =head2 --shelltype
+
+ Specify the shell type to use for output. By default, the shell will be
+ detected based on the environment. Should be one of: C<bourne>, C<csh>,
+ C<cmd>, or C<powershell>.
+
+ =head2 --no-create
+
+ Prevents C<local::lib> from creating directories when activating dirs. This is
+ likely to cause issues on Win32 systems.
+
+ =head1 CLASS METHODS
=head2 ensure_dir_structure_for
@@ -19870,9 +20445,9 @@ $fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
=over 4
- =item Arguments: $path, $interpolate
+ =item Arguments: $path
- =item Return value: \%environment_vars
+ =item Return value: %environment_vars
=back
@@ -19903,7 +20478,8 @@ $fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
=back
Returns a list of active C<local::lib> paths, according to the
- C<PERL_LOCAL_LIB_ROOT> environment variable.
+ C<PERL_LOCAL_LIB_ROOT> environment variable and verified against
+ what is really in C<@INC>.
=head2 install_base_perl_path
@@ -19919,20 +20495,19 @@ $fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
library installation. Appends the directories C<lib> and C<perl5> to the given
path.
- =head2 install_base_arch_path
+ =head2 lib_paths_for
=over 4
=item Arguments: $path
- =item Return value: $install_base_arch_path
+ =item Return value: @lib_paths
=back
- Returns a path describing where to install the architecture-specific Perl
- modules for this local library installation. Based on the
- L</install_base_perl_path> method's return value, and appends the value of
- C<$Config{archname}>.
+ Returns the list of paths perl will search for libraries, given a base path.
+ This includes the base path itself, the architecture specific subdirectory, and
+ perl version specific subdirectories. These paths may not all exist.
=head2 install_base_bin_path
@@ -19945,8 +20520,20 @@ $fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
=back
Returns a path describing where to install the executable programs for this
- local library installation. Based on the L</install_base_perl_path> method's
- return value, and appends the directory C<bin>.
+ local library installation. Appends the directory C<bin> to the given path.
+
+ =head2 installer_options_for
+
+ =over 4
+
+ =item Arguments: $path
+
+ =item Return value: %installer_env_vars
+
+ =back
+
+ Returns a hash of environment variables that should be set to cause
+ installation into the given path.
=head2 resolve_empty_path
@@ -20005,6 +20592,141 @@ $fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
L</resolve_relative_path>. The result of this final call is returned from
L</resolve_path>.
+ =head1 OBJECT INTERFACE
+
+ =head2 new
+
+ =over 4
+
+ =item Arguments: %attributes
+
+ =item Return value: $local_lib
+
+ =back
+
+ Constructs a new C<local::lib> object, representing the current state of
+ C<@INC> and the relevant environment variables.
+
+ =head1 ATTRIBUTES
+
+ =head2 roots
+
+ An arrayref representing active C<local::lib> directories.
+
+ =head2 inc
+
+ An arrayref representing C<@INC>.
+
+ =head2 libs
+
+ An arrayref representing the PERL5LIB environment variable.
+
+ =head2 bins
+
+ An arrayref representing the PATH environment variable.
+
+ =head2 extra
+
+ A hashref of extra environment variables (e.g. C<PERL_MM_OPT> and
+ C<PERL_MB_OPT>)
+
+ =head2 no_create
+
+ If set, C<local::lib> will not try to create directories when activating them.
+
+ =head1 OBJECT METHODS
+
+ =head2 clone
+
+ =over 4
+
+ =item Arguments: %attributes
+
+ =item Return value: $local_lib
+
+ =back
+
+ Constructs a new C<local::lib> object based on the existing one, overriding the
+ specified attributes.
+
+ =head2 activate
+
+ =over 4
+
+ =item Arguments: $path
+
+ =item Return value: $new_local_lib
+
+ =back
+
+ Constructs a new instance with the specified path active.
+
+ =head2 deactivate
+
+ =over 4
+
+ =item Arguments: $path
+
+ =item Return value: $new_local_lib
+
+ =back
+
+ Constructs a new instance with the specified path deactivated.
+
+ =head2 deactivate_all
+
+ =over 4
+
+ =item Arguments: None
+
+ =item Return value: $new_local_lib
+
+ =back
+
+ Constructs a new instance with all C<local::lib> directories deactivated.
+
+ =head2 environment_vars_string
+
+ =over 4
+
+ =item Arguments: [ $shelltype ]
+
+ =item Return value: $shell_env_string
+
+ =back
+
+ Returns a string to set up the C<local::lib>, meant to be run by a shell.
+
+ =head2 build_environment_vars
+
+ =over 4
+
+ =item Arguments: None
+
+ =item Return value: %environment_vars
+
+ =back
+
+ Returns a hash with the variables listed above, properly set to use the
+ given path as the base directory.
+
+ =head2 setup_env_hash
+
+ =over 4
+
+ =item Arguments: None
+
+ =item Return value: None
+
+ =back
+
+ Constructs the C<%ENV> keys for the given path, by calling
+ L</build_environment_vars>.
+
+ =head2 setup_local_lib
+
+ Constructs the C<%ENV> hash using L</setup_env_hash>, and set up C<@INC>.
+
=head1 A WARNING ABOUT UNINST=1
Be careful about using local::lib in combination with "make install UNINST=1".
@@ -20017,28 +20739,52 @@ $fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
=head1 LIMITATIONS
- The perl toolchain is unable to handle directory names with spaces in it,
- so you cant put your local::lib bootstrap into a directory with spaces. What
- you can do is moving your local::lib to a directory with spaces B<after> you
- installed all modules inside your local::lib bootstrap. But be aware that you
- cant update or install CPAN modules after the move.
+ =over 4
+
+ =item * Directory names with spaces in them are not well supported by the perl
+ toolchain and the programs it uses. Pure-perl distributions should support
+ spaces, but problems are more likely with dists that require compilation. A
+ workaround you can do is moving your local::lib to a directory with spaces
+ B<after> you installed all modules inside your local::lib bootstrap. But be
+ aware that you can't update or install CPAN modules after the move.
- Rather basic shell detection. Right now anything with csh in its name is
+ =item * Rather basic shell detection. Right now anything with csh in its name is
assumed to be a C shell or something compatible, and everything else is assumed
to be Bourne, except on Win32 systems. If the C<SHELL> environment variable is
not set, a Bourne-compatible shell is assumed.
- Bootstrap is a hack and will use CPAN.pm for ExtUtils::MakeMaker even if you
- have CPANPLUS installed.
+ =item * Kills any existing PERL_MM_OPT or PERL_MB_OPT.
- Kills any existing PERL5LIB, PERL_MM_OPT or PERL_MB_OPT.
+ =item * Should probably auto-fixup CPAN config if not already done.
- Should probably auto-fixup CPAN config if not already done.
+ =item * local::lib loads L<File::Spec>. When used to set shell variables,
+ this isn't a problem. When used inside a perl script, any L<File::Spec>
+ version inside the local::lib will be ignored. A workaround for this is using
+ C<use lib "$ENV{HOME}/perl5/lib/perl5";> inside the script instead of using
+ C<local::lib> directly.
+
+ =item * Conflicts with L<ExtUtils::MakeMaker>'s C<PREFIX> option.
+ C<local::lib> uses the C<INSTALL_BASE> option, as it has more predictable and
+ sane behavior. If something attempts to use the C<PREFIX> option when running
+ a F<Makefile.PL>, L<ExtUtils::MakeMaker> will refuse to run, as the two
+ options conflict. This can be worked around by temporarily unsetting the
+ C<PERL_MM_OPT> environment variable.
+
+ =item * Conflicts with L<Module::Build>'s C<--prefix> option. Similar to the
+ previous limitation, but any C<--prefix> option specified will be ignored.
+ This can be worked around by temporarily unsetting the C<PERL_MB_OPT>
+ environment variable.
+
+ =back
Patches very much welcome for any of the above.
- On Win32 systems, does not have a way to write the created environment variables
- to the registry, so that they can persist through a reboot.
+ =over 4
+
+ =item * On Win32 systems, does not have a way to write the created environment
+ variables to the registry, so that they can persist through a reboot.
+
+ =back
=head1 TROUBLESHOOTING
@@ -20097,8 +20843,8 @@ $fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
documentation additions, contributed by Christopher Nehren <apeiron at cpan.org>.
Doc patches for a custom local::lib directory, more cleanups in the english
- documentation and a L<german documentation|POD2::DE::local::lib> contributed by Torsten Raudssus
- <torsten at raudssus.de>.
+ documentation and a L<german documentation|POD2::DE::local::lib> contributed by
+ Torsten Raudssus <torsten at raudssus.de>.
Hans Dieter Pearcey <hdp at cpan.org> sent in some additional tests for ensuring
things will install properly, submitted a fix for the bug causing problems with
@@ -20109,52 +20855,310 @@ $fatpacked{"local/lib.pm"} = <<'LOCAL_LIB';
pattern of Freenode IRC contributed the beginnings of the Troubleshooting
section. Many thanks!
- Patch to add Win32 support contributed by Curtis Jewell <csjewell at cpan.org>.
+ Patch to add Win32 support contributed by Curtis Jewell <csjewell at cpan.org>.
+
+ Warnings for missing PATH/PERL5LIB (as when not running interactively) silenced
+ by a patch from Marco Emilio Poleggi.
+
+ Mark Stosberg <mark at summersault.com> provided the code for the now deleted
+ '--self-contained' option.
+
+ Documentation patches to make win32 usage clearer by
+ David Mertens <dcmertens.perl at gmail.com> (run4flat).
+
+ Brazilian L<portuguese translation|POD2::PT_BR::local::lib> and minor doc
+ patches contributed by Breno G. de Oliveira <garu at cpan.org>.
+
+ Improvements to stacking multiple local::lib dirs and removing them from the
+ environment later on contributed by Andrew Rodland <arodland at cpan.org>.
+
+ Patch for Carp version mismatch contributed by Hakim Cassimally
+ <osfameron at cpan.org>.
+
+ Rewrite of internals and numerous bug fixes and added features contributed by
+ Graham Knop <haarg at haarg.org>.
+
+ =head1 COPYRIGHT
+
+ Copyright (c) 2007 - 2013 the local::lib L</AUTHOR> and L</CONTRIBUTORS> as
+ listed above.
+
+ =head1 LICENSE
+
+ 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
+LOCAL_LIB
+
+$fatpacked{"parent.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PARENT';
+ package parent;
+ use strict;
+ use vars qw($VERSION);
+ $VERSION = '0.225';
+
+ sub import {
+ my $class = shift;
+
+ my $inheritor = caller(0);
+
+ if ( @_ and $_[0] eq '-norequire' ) {
+ shift @_;
+ } else {
+ for ( my @filename = @_ ) {
+ if ( $_ eq $inheritor ) {
+ warn "Class '$inheritor' tried to inherit from itself\n";
+ };
+
+ s{::|'}{/}g;
+ require "$_.pm"; # dies if the file is not found
+ }
+ }
+
+ {
+ no strict 'refs';
+ push @{"$inheritor\::ISA"}, @_;
+ };
+ };
+
+ "All your base are belong to us"
+
+ __END__
+
+ =encoding utf8
+
+ =head1 NAME
+
+ parent - Establish an ISA relationship with base classes at compile time
+
+ =head1 SYNOPSIS
+
+ package Baz;
+ use parent qw(Foo Bar);
+
+ =head1 DESCRIPTION
+
+ Allows you to both load one or more modules, while setting up inheritance from
+ those modules at the same time. Mostly similar in effect to
+
+ package Baz;
+ BEGIN {
+ require Foo;
+ require Bar;
+ push @ISA, qw(Foo Bar);
+ }
+
+ By default, every base class needs to live in a file of its own.
+ If you want to have a subclass and its parent class in the same file, you
+ can tell C<parent> not to load any modules by using the C<-norequire> switch:
+
+ package Foo;
+ sub exclaim { "I CAN HAS PERL" }
+
+ package DoesNotLoadFooBar;
+ use parent -norequire, 'Foo', 'Bar';
+ # will not go looking for Foo.pm or Bar.pm
+
+ This is equivalent to the following code:
+
+ package Foo;
+ sub exclaim { "I CAN HAS PERL" }
+
+ package DoesNotLoadFooBar;
+ push @DoesNotLoadFooBar::ISA, 'Foo', 'Bar';
+
+ This is also helpful for the case where a package lives within
+ a differently named file:
+
+ package MyHash;
+ use Tie::Hash;
+ use parent -norequire, 'Tie::StdHash';
+
+ This is equivalent to the following code:
+
+ package MyHash;
+ require Tie::Hash;
+ push @ISA, 'Tie::StdHash';
+
+ If you want to load a subclass from a file that C<require> would
+ not consider an eligible filename (that is, it does not end in
+ either C<.pm> or C<.pmc>), use the following code:
+
+ package MySecondPlugin;
+ require './plugins/custom.plugin'; # contains Plugin::Custom
+ use parent -norequire, 'Plugin::Custom';
+
+ =head1 DIAGNOSTICS
+
+ =over 4
+
+ =item Class 'Foo' tried to inherit from itself
+
+ Attempting to inherit from yourself generates a warning.
+
+ package Foo;
+ use parent 'Foo';
+
+ =back
+
+ =head1 HISTORY
+
+ This module was forked from L<base> to remove the cruft
+ that had accumulated in it.
+
+ =head1 CAVEATS
+
+ =head1 SEE ALSO
+
+ L<base>
+
+ =head1 AUTHORS AND CONTRIBUTORS
+
+ Rafaël Garcia-Suarez, Bart Lateur, Max Maischein, Anno Siegel, Michael Schwern
+
+ =head1 MAINTAINER
+
+ Max Maischein C< corion at cpan.org >
+
+ Copyright (c) 2007-10 Max Maischein C<< <corion at cpan.org> >>
+ Based on the idea of C<base.pm>, which was introduced with Perl 5.004_04.
+
+ =head1 LICENSE
+
+ This module is released under the same terms as Perl itself.
+
+ =cut
+PARENT
+
+$fatpacked{"version.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'VERSION';
+ #!perl -w
+ package version;
+
+ use 5.006002;
+ use strict;
+
+ use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
+
+ $VERSION = 0.9908;
+ $CLASS = 'version';
+
+ # !!!!Delete this next block completely when adding to Perl core!!!!
+ {
+ local $SIG{'__DIE__'};
+ eval "use version::vxs $VERSION";
+ if ( $@ ) { # don't have the XS version installed
+ eval "use version::vpp $VERSION"; # don't tempt fate
+ die "$@" if ( $@ );
+ push @ISA, "version::vpp";
+ local $^W;
+ *version::qv = \&version::vpp::qv;
+ *version::declare = \&version::vpp::declare;
+ *version::_VERSION = \&version::vpp::_VERSION;
+ *version::vcmp = \&version::vpp::vcmp;
+ *version::new = \&version::vpp::new;
+ if ($] >= 5.009000) {
+ no strict 'refs';
+ *version::stringify = \&version::vpp::stringify;
+ *{'version::(""'} = \&version::vpp::stringify;
+ *{'version::(<=>'} = \&version::vpp::vcmp;
+ *version::parse = \&version::vpp::parse;
+ }
+ }
+ else { # use XS module
+ push @ISA, "version::vxs";
+ local $^W;
+ *version::declare = \&version::vxs::declare;
+ *version::qv = \&version::vxs::qv;
+ *version::_VERSION = \&version::vxs::_VERSION;
+ *version::vcmp = \&version::vxs::VCMP;
+ *version::new = \&version::vxs::new;
+ if ($] >= 5.009000) {
+ no strict 'refs';
+ *version::stringify = \&version::vxs::stringify;
+ *{'version::(""'} = \&version::vxs::stringify;
+ *{'version::(<=>'} = \&version::vxs::VCMP;
+ *version::parse = \&version::vxs::parse;
+ }
+ }
+ }
+
+ # avoid using Exporter
+ require version::regex;
+ *version::is_lax = \&version::regex::is_lax;
+ *version::is_strict = \&version::regex::is_strict;
+ *LAX = \$version::regex::LAX;
+ *STRICT = \$version::regex::STRICT;
- Warnings for missing PATH/PERL5LIB (as when not running interactively) silenced
- by a patch from Marco Emilio Poleggi.
+ sub import {
+ no strict 'refs';
+ my ($class) = shift;
- Mark Stosberg <mark at summersault.com> provided the code for the now deleted
- '--self-contained' option.
+ # Set up any derived class
+ unless ($class eq $CLASS) {
+ local $^W;
+ *{$class.'::declare'} = \&{$CLASS.'::declare'};
+ *{$class.'::qv'} = \&{$CLASS.'::qv'};
+ }
- Documentation patches to make win32 usage clearer by
- David Mertens <dcmertens.perl at gmail.com> (run4flat).
+ my %args;
+ if (@_) { # any remaining terms are arguments
+ map { $args{$_} = 1 } @_
+ }
+ else { # no parameters at all on use line
+ %args =
+ (
+ qv => 1,
+ 'UNIVERSAL::VERSION' => 1,
+ );
+ }
- Brazilian L<portuguese translation|POD2::PT_BR::local::lib> and minor doc patches contributed by Breno
- G. de Oliveira <garu at cpan.org>.
+ my $callpkg = caller();
- Improvements to stacking multiple local::lib dirs and removing them from the
- environment later on contributed by Andrew Rodland <arodland at cpan.org>.
+ if (exists($args{declare})) {
+ *{$callpkg.'::declare'} =
+ sub {return $class->declare(shift) }
+ unless defined(&{$callpkg.'::declare'});
+ }
- Patch for Carp version mismatch contributed by Hakim Cassimally <osfameron at cpan.org>.
+ if (exists($args{qv})) {
+ *{$callpkg.'::qv'} =
+ sub {return $class->qv(shift) }
+ unless defined(&{$callpkg.'::qv'});
+ }
- =head1 COPYRIGHT
+ if (exists($args{'UNIVERSAL::VERSION'})) {
+ local $^W;
+ *UNIVERSAL::VERSION
+ = \&{$CLASS.'::_VERSION'};
+ }
- Copyright (c) 2007 - 2010 the local::lib L</AUTHOR> and L</CONTRIBUTORS> as
- listed above.
+ if (exists($args{'VERSION'})) {
+ *{$callpkg.'::VERSION'} = \&{$CLASS.'::_VERSION'};
+ }
- =head1 LICENSE
+ if (exists($args{'is_strict'})) {
+ *{$callpkg.'::is_strict'} = \&{$CLASS.'::is_strict'}
+ unless defined(&{$callpkg.'::is_strict'});
+ }
- This library is free software and may be distributed under the same terms
- as perl itself.
+ if (exists($args{'is_lax'})) {
+ *{$callpkg.'::is_lax'} = \&{$CLASS.'::is_lax'}
+ unless defined(&{$callpkg.'::is_lax'});
+ }
+ }
- =cut
1;
-LOCAL_LIB
+VERSION
-$fatpacked{"version.pm"} = <<'VERSION';
- #!perl -w
- package version;
+$fatpacked{"version/regex.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'VERSION_REGEX';
+ package version::regex;
- use 5.005_04;
use strict;
- use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
-
- $VERSION = 0.9902;
+ use vars qw($VERSION $CLASS $STRICT $LAX);
- $CLASS = 'version';
+ $VERSION = 0.9908;
#--------------------------------------------------------------------------#
# Version regexp components
@@ -20260,112 +21264,14 @@ $fatpacked{"version.pm"} = <<'VERSION';
#--------------------------------------------------------------------------#
- {
- local $SIG{'__DIE__'};
- eval "use version::vxs $VERSION";
- if ( $@ ) { # don't have the XS version installed
- eval "use version::vpp $VERSION"; # don't tempt fate
- die "$@" if ( $@ );
- push @ISA, "version::vpp";
- local $^W;
- *version::qv = \&version::vpp::qv;
- *version::declare = \&version::vpp::declare;
- *version::_VERSION = \&version::vpp::_VERSION;
- *version::vcmp = \&version::vpp::vcmp;
- *version::new = \&version::vpp::new;
- if ($] >= 5.009000) {
- no strict 'refs';
- *version::stringify = \&version::vpp::stringify;
- *{'version::(""'} = \&version::vpp::stringify;
- *{'version::(<=>'} = \&version::vpp::vcmp;
- *version::parse = \&version::vpp::parse;
- }
- }
- else { # use XS module
- push @ISA, "version::vxs";
- local $^W;
- *version::declare = \&version::vxs::declare;
- *version::qv = \&version::vxs::qv;
- *version::_VERSION = \&version::vxs::_VERSION;
- *version::vcmp = \&version::vxs::VCMP;
- *version::new = \&version::vxs::new;
- if ($] >= 5.009000) {
- no strict 'refs';
- *version::stringify = \&version::vxs::stringify;
- *{'version::(""'} = \&version::vxs::stringify;
- *{'version::(<=>'} = \&version::vxs::VCMP;
- *version::parse = \&version::vxs::parse;
- }
-
- }
- }
-
# Preloaded methods go here.
- sub import {
- no strict 'refs';
- my ($class) = shift;
-
- # Set up any derived class
- unless ($class eq 'version') {
- local $^W;
- *{$class.'::declare'} = \&version::declare;
- *{$class.'::qv'} = \&version::qv;
- }
-
- my %args;
- if (@_) { # any remaining terms are arguments
- map { $args{$_} = 1 } @_
- }
- else { # no parameters at all on use line
- %args =
- (
- qv => 1,
- 'UNIVERSAL::VERSION' => 1,
- );
- }
-
- my $callpkg = caller();
-
- if (exists($args{declare})) {
- *{$callpkg.'::declare'} =
- sub {return $class->declare(shift) }
- unless defined(&{$callpkg.'::declare'});
- }
-
- if (exists($args{qv})) {
- *{$callpkg.'::qv'} =
- sub {return $class->qv(shift) }
- unless defined(&{$callpkg.'::qv'});
- }
-
- if (exists($args{'UNIVERSAL::VERSION'})) {
- local $^W;
- *UNIVERSAL::VERSION
- = \&version::_VERSION;
- }
-
- if (exists($args{'VERSION'})) {
- *{$callpkg.'::VERSION'} = \&version::_VERSION;
- }
-
- if (exists($args{'is_strict'})) {
- *{$callpkg.'::is_strict'} = \&version::is_strict
- unless defined(&{$callpkg.'::is_strict'});
- }
-
- if (exists($args{'is_lax'})) {
- *{$callpkg.'::is_lax'} = \&version::is_lax
- unless defined(&{$callpkg.'::is_lax'});
- }
- }
-
sub is_strict { defined $_[0] && $_[0] =~ qr/ \A $STRICT \z /x }
sub is_lax { defined $_[0] && $_[0] =~ qr/ \A $LAX \z /x }
1;
-VERSION
+VERSION_REGEX
-$fatpacked{"version/vpp.pm"} = <<'VERSION_VPP';
+$fatpacked{"version/vpp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'VERSION_VPP';
package charstar;
# a little helper class to emulate C char* semantics in Perl
# so that prescan_version can use the same code as in C
@@ -20484,12 +21390,20 @@ $fatpacked{"version/vpp.pm"} = <<'VERSION_VPP';
}
package version::vpp;
+
+ use 5.006002;
use strict;
- use POSIX qw/locale_h/;
- use locale;
- use vars qw ($VERSION @ISA @REGEXS);
- $VERSION = 0.9902;
+ use Config;
+ use vars qw($VERSION $CLASS @ISA $LAX $STRICT);
+ $VERSION = 0.9908;
+ $CLASS = 'version::vpp';
+
+ require version::regex;
+ *version::vpp::is_strict = \&version::regex::is_strict;
+ *version::vpp::is_lax = \&version::regex::is_lax;
+ *LAX = \$version::regex::LAX;
+ *STRICT = \$version::regex::STRICT;
use overload (
'""' => \&stringify,
@@ -20518,6 +21432,64 @@ $fatpacked{"version/vpp.pm"} = <<'VERSION_VPP';
';
}
+ sub import {
+ no strict 'refs';
+ my ($class) = shift;
+
+ # Set up any derived class
+ unless ($class eq $CLASS) {
+ local $^W;
+ *{$class.'::declare'} = \&{$CLASS.'::declare'};
+ *{$class.'::qv'} = \&{$CLASS.'::qv'};
+ }
+
+ my %args;
+ if (@_) { # any remaining terms are arguments
+ map { $args{$_} = 1 } @_
+ }
+ else { # no parameters at all on use line
+ %args =
+ (
+ qv => 1,
+ 'UNIVERSAL::VERSION' => 1,
+ );
+ }
+
+ my $callpkg = caller();
+
+ if (exists($args{declare})) {
+ *{$callpkg.'::declare'} =
+ sub {return $class->declare(shift) }
+ unless defined(&{$callpkg.'::declare'});
+ }
+
+ if (exists($args{qv})) {
+ *{$callpkg.'::qv'} =
+ sub {return $class->qv(shift) }
+ unless defined(&{$callpkg.'::qv'});
+ }
+
+ if (exists($args{'UNIVERSAL::VERSION'})) {
+ local $^W;
+ *UNIVERSAL::VERSION
+ = \&{$CLASS.'::_VERSION'};
+ }
+
+ if (exists($args{'VERSION'})) {
+ *{$callpkg.'::VERSION'} = \&{$CLASS.'::_VERSION'};
+ }
+
+ if (exists($args{'is_strict'})) {
+ *{$callpkg.'::is_strict'} = \&{$CLASS.'::is_strict'}
+ unless defined(&{$callpkg.'::is_strict'});
+ }
+
+ if (exists($args{'is_lax'})) {
+ *{$callpkg.'::is_lax'} = \&{$CLASS.'::is_lax'}
+ unless defined(&{$callpkg.'::is_lax'});
+ }
+ }
+
my $VERSION_MAX = 0x7FFFFFFF;
# implement prescan_version as closely to the C version as possible
@@ -20780,7 +21752,7 @@ $fatpacked{"version/vpp.pm"} = <<'VERSION_VPP';
if ($errstr) {
# 'undef' is a special case and not an error
if ( $s ne 'undef') {
- use Carp;
+ require Carp;
Carp::croak($errstr);
}
}
@@ -20936,25 +21908,49 @@ $fatpacked{"version/vpp.pm"} = <<'VERSION_VPP';
return $s;
}
- sub new
- {
- my ($class, $value) = @_;
- unless (defined $class) {
- require Carp;
- Carp::croak('Usage: version::new(class, version)');
- }
- my $self = bless ({}, ref ($class) || $class);
- my $qv = FALSE;
-
- if ( ref($value) && eval('$value->isa("version")') ) {
- # Can copy the elements directly
- $self->{version} = [ @{$value->{version} } ];
- $self->{qv} = 1 if $value->{qv};
- $self->{alpha} = 1 if $value->{alpha};
- $self->{original} = ''.$value->{original};
- return $self;
- }
+ sub new {
+ my $class = shift;
+ unless (defined $class or $#_ > 1) {
+ require Carp;
+ Carp::croak('Usage: version::new(class, version)');
+ }
+
+ my $self = bless ({}, ref ($class) || $class);
+ my $qv = FALSE;
+
+ if ( $#_ == 1 ) { # must be CVS-style
+ $qv = TRUE;
+ }
+ my $value = pop; # always going to be the last element
+
+ if ( ref($value) && eval('$value->isa("version")') ) {
+ # Can copy the elements directly
+ $self->{version} = [ @{$value->{version} } ];
+ $self->{qv} = 1 if $value->{qv};
+ $self->{alpha} = 1 if $value->{alpha};
+ $self->{original} = ''.$value->{original};
+ return $self;
+ }
+
+ if ( not defined $value or $value =~ /^undef$/ ) {
+ # RT #19517 - special case for undef comparison
+ # or someone forgot to pass a value
+ push @{$self->{version}}, 0;
+ $self->{original} = "0";
+ return ($self);
+ }
+
+
+ if (ref($value) =~ m/ARRAY|HASH/) {
+ require Carp;
+ Carp::croak("Invalid version format (non-numeric data)");
+ }
+
+ $value = _un_vstring($value);
+ if ($Config{d_setlocale}) {
+ use POSIX qw/locale_h/;
+ use if $Config{d_setlocale}, 'locale';
my $currlocale = setlocale(LC_ALL);
# if the current locale uses commas for decimal points, we
@@ -20963,42 +21959,27 @@ $fatpacked{"version/vpp.pm"} = <<'VERSION_VPP';
if ( localeconv()->{decimal_point} eq ',' ) {
$value =~ tr/,/./;
}
+ }
- if ( not defined $value or $value =~ /^undef$/ ) {
- # RT #19517 - special case for undef comparison
- # or someone forgot to pass a value
- push @{$self->{version}}, 0;
- $self->{original} = "0";
- return ($self);
- }
-
- if ( $#_ == 2 ) { # must be CVS-style
- $value = $_[2];
- $qv = TRUE;
- }
-
- $value = _un_vstring($value);
-
- # exponential notation
- if ( $value =~ /\d+.?\d*e[-+]?\d+/ ) {
- $value = sprintf("%.9f",$value);
- $value =~ s/(0+)$//; # trim trailing zeros
- }
+ # exponential notation
+ if ( $value =~ /\d+.?\d*e[-+]?\d+/ ) {
+ $value = sprintf("%.9f",$value);
+ $value =~ s/(0+)$//; # trim trailing zeros
+ }
- my $s = scan_version($value, \$self, $qv);
+ my $s = scan_version($value, \$self, $qv);
- if ($s) { # must be something left over
- warn("Version string '%s' contains invalid data; "
- ."ignoring: '%s'", $value, $s);
- }
+ if ($s) { # must be something left over
+ warn("Version string '%s' contains invalid data; "
+ ."ignoring: '%s'", $value, $s);
+ }
- return ($self);
+ return ($self);
}
*parse = \&new;
- sub numify
- {
+ sub numify {
my ($self) = @_;
unless (_verify($self)) {
require Carp;
@@ -21038,8 +22019,7 @@ $fatpacked{"version/vpp.pm"} = <<'VERSION_VPP';
return $string;
}
- sub normal
- {
+ sub normal {
my ($self) = @_;
unless (_verify($self)) {
require Carp;
@@ -21074,8 +22054,7 @@ $fatpacked{"version/vpp.pm"} = <<'VERSION_VPP';
return $string;
}
- sub stringify
- {
+ sub stringify {
my ($self) = @_;
unless (_verify($self)) {
require Carp;
@@ -21088,8 +22067,7 @@ $fatpacked{"version/vpp.pm"} = <<'VERSION_VPP';
: $self->numify;
}
- sub vcmp
- {
+ sub vcmp {
require UNIVERSAL;
my ($left,$right,$swap) = @_;
my $class = ref($left);
@@ -21174,7 +22152,7 @@ $fatpacked{"version/vpp.pm"} = <<'VERSION_VPP';
sub qv {
my $value = shift;
- my $class = 'version';
+ my $class = $CLASS;
if (@_) {
$class = ref($value) || $value;
$value = shift;
@@ -21182,7 +22160,7 @@ $fatpacked{"version/vpp.pm"} = <<'VERSION_VPP';
$value = _un_vstring($value);
$value = 'v'.$value unless $value =~ /(^v|\d+\.\d+\.\d)/;
- my $obj = version->new($value);
+ my $obj = $CLASS->new($value);
return bless $obj, $class;
}
@@ -21321,24 +22299,37 @@ VERSION_VPP
s/^ //mg for values %fatpacked;
-unshift @INC, sub {
- if (my $fat = $fatpacked{$_[1]}) {
- if ($] < 5.008) {
- return sub {
- return 0 unless length $fat;
- $fat =~ s/^([^\n]*\n?)//;
- $_ = $1;
- return 1;
- };
+my $class = 'FatPacked::'.(0+\%fatpacked);
+no strict 'refs';
+*{"${class}::files"} = sub { keys %{$_[0]} };
+
+if ($] < 5.008) {
+ *{"${class}::INC"} = sub {
+ if (my $fat = $_[0]{$_[1]}) {
+ return sub {
+ return 0 unless length $fat;
+ $fat =~ s/^([^\n]*\n?)//;
+ $_ = $1;
+ return 1;
+ };
+ }
+ return;
+ };
+}
+
+else {
+ *{"${class}::INC"} = sub {
+ if (my $fat = $_[0]{$_[1]}) {
+ open my $fh, '<', \$fat
+ or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
+ return $fh;
}
- open my $fh, '<', \$fat
- or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
- return $fh;
- }
- return
-};
+ return;
+ };
+}
-} # END OF FATPACK CODE
+unshift @INC, bless \%fatpacked, $class;
+ } # END OF FATPACK CODE
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/cpanminus.git
More information about the Pkg-perl-cvs-commits
mailing list