From 9a2e284f1ec75a3406d9730e8b5852dcde8320ca Mon Sep 17 00:00:00 2001 From: Ed J Date: Thu, 5 Oct 2017 19:23:20 +0100 Subject: [PATCH 1/4] "require" specified to return true on success --- Makefile.PL | 6 +++--- lib/JSON/MaybeXS.pm | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/Makefile.PL b/Makefile.PL index 04b7ebc..4b38de2 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -69,16 +69,16 @@ if (! parse_args()->{PUREPERL_ONLY}) { # we require Cpanel::JSON::XS, except if JSON::XS is already installed. # (we also always recommend Cpanel::JSON::XS, just to make sure.) $MM_ARGS{PREREQ_PM}{'Cpanel::JSON::XS'} = '2.3310' - if eval { require Cpanel::JSON::XS; 1 } + if eval { require Cpanel::JSON::XS } or ( - not eval { require JSON::XS; 1; } + not eval { require JSON::XS } and can_compile_loadable_object(quiet => 1) ); # JSON::XS 3 changed its boolean handling - update it # if JSON::XS is installed and < 3.0 $MM_ARGS{PREREQ_PM}{'JSON::XS'} = '3.00' - if eval { require JSON::XS; 1 } + if eval { require JSON::XS } and not eval { JSON::XS->VERSION('3.0'); 1 }; } diff --git a/lib/JSON/MaybeXS.pm b/lib/JSON/MaybeXS.pm index 64d13f2..5020053 100644 --- a/lib/JSON/MaybeXS.pm +++ b/lib/JSON/MaybeXS.pm @@ -13,13 +13,13 @@ sub _choose_json_module { my @err; - return 'Cpanel::JSON::XS' if eval { require Cpanel::JSON::XS; 1; }; + return 'Cpanel::JSON::XS' if eval { require Cpanel::JSON::XS }; push @err, "Error loading Cpanel::JSON::XS: $@"; - return 'JSON::XS' if eval { require JSON::XS; 1; }; + return 'JSON::XS' if eval { require JSON::XS }; push @err, "Error loading JSON::XS: $@"; - return 'JSON::PP' if eval { require JSON::PP; 1 }; + return 'JSON::PP' if eval { require JSON::PP }; push @err, "Error loading JSON::PP: $@"; die join( "\n", "Couldn't load a JSON module:", @err ); From fd375fd9f6d2422da75b774dbb87776137e3b89e Mon Sep 17 00:00:00 2001 From: Ed J Date: Thu, 5 Oct 2017 19:55:37 +0100 Subject: [PATCH 2/4] refactor t/none.t --- t/none.t | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/t/none.t b/t/none.t index 12d26fd..6aabedb 100644 --- a/t/none.t +++ b/t/none.t @@ -1,18 +1,24 @@ use strict; use warnings; +my @BACKENDS; +BEGIN { + @BACKENDS = ('Cpanel/JSON/XS.pm', 'JSON/XS.pm', 'JSON/PP.pm'); +} + # hide Cpanel::JSON::XS, JSON::XS, JSON::PP use lib map { my $m = $_; sub { return unless $_[1] eq $m; die "Can't locate $m in \@INC (hidden).\n" }; -} qw{Cpanel/JSON/XS.pm JSON/XS.pm JSON/PP.pm}; +} @BACKENDS; use Test::More 0.88; ok(!eval { require JSON::MaybeXS; 1 }, 'Class failed to load'); +my $re_string = join '.*', map quotemeta("Can't locate $_"), @BACKENDS; like( - $@, qr{Can't locate Cpanel/JSON/XS\.pm.*Can't locate JSON/XS\.pm.*Can't locate JSON/PP\.pm}s, + $@, qr{$re_string}s, 'All errors reported' ); From 28c7f7410e1c204f14132e2a4a7d42c5aaf80ac9 Mon Sep 17 00:00:00 2001 From: Ed J Date: Thu, 5 Oct 2017 19:41:31 +0100 Subject: [PATCH 3/4] no use JSON::XS without $ENV{PERL_JSON_XS_USE} --- lib/JSON/MaybeXS.pm | 21 ++++++++++++++------- t/none.t | 6 +++++- t/preload_xs.t | 1 + t/xs.t | 2 +- 4 files changed, 21 insertions(+), 9 deletions(-) diff --git a/lib/JSON/MaybeXS.pm b/lib/JSON/MaybeXS.pm index 5020053..72d88bd 100644 --- a/lib/JSON/MaybeXS.pm +++ b/lib/JSON/MaybeXS.pm @@ -9,15 +9,15 @@ $VERSION = eval $VERSION; sub _choose_json_module { return 'Cpanel::JSON::XS' if $INC{'Cpanel/JSON/XS.pm'}; - return 'JSON::XS' if $INC{'JSON/XS.pm'}; + return 'JSON::XS' if $INC{'JSON/XS.pm'} and $ENV{PERL_JSON_XS_USE}; my @err; return 'Cpanel::JSON::XS' if eval { require Cpanel::JSON::XS }; push @err, "Error loading Cpanel::JSON::XS: $@"; - return 'JSON::XS' if eval { require JSON::XS }; - push @err, "Error loading JSON::XS: $@"; + return 'JSON::XS' if $ENV{PERL_JSON_XS_USE} and eval { require JSON::XS }; + push @err, "Error loading JSON::XS: $@" if $ENV{PERL_JSON_XS_USE}; return 'JSON::PP' if eval { require JSON::PP }; push @err, "Error loading JSON::PP: $@"; @@ -101,7 +101,7 @@ sub to_json ($@) { =head1 NAME -JSON::MaybeXS - Use L with a fallback to L and L +JSON::MaybeXS - Use L with a fallback to maybe L, and L =head1 SYNOPSIS @@ -118,9 +118,11 @@ JSON::MaybeXS - Use L with a fallback to L and L or -L is already loaded, in which case it uses that module. Otherwise -it tries to load L, then L, then L -in order, and either uses the first module it finds or throws an error. +L is already loaded (but see L), +in which case it uses that module. Otherwise it tries to load +L, then L (see L), +then L in order, and either uses the first module it finds or +throws an error. It then exports the C and C functions from the loaded module, along with a C constant that returns the class name @@ -202,6 +204,11 @@ Since this is a bare sub in the various backend classes, it cannot be called as a class method like the other interfaces; it must be called as a function, with no invocant. It supports the representation used in all JSON backends. +=head1 NOTE ON JSON::XS + +As of version 1.003010, JSON::MaybeXS will not use L unless +the environment variable C is set to a true value. + =head1 CONSTRUCTOR =head2 new diff --git a/t/none.t b/t/none.t index 6aabedb..6ca3bd0 100644 --- a/t/none.t +++ b/t/none.t @@ -3,7 +3,11 @@ use warnings; my @BACKENDS; BEGIN { - @BACKENDS = ('Cpanel/JSON/XS.pm', 'JSON/XS.pm', 'JSON/PP.pm'); + @BACKENDS = ( + 'Cpanel/JSON/XS.pm', + ($ENV{PERL_JSON_XS_USE} ? 'JSON/XS.pm' : ()), + 'JSON/PP.pm', + ); } # hide Cpanel::JSON::XS, JSON::XS, JSON::PP diff --git a/t/preload_xs.t b/t/preload_xs.t index 7270312..760b260 100644 --- a/t/preload_xs.t +++ b/t/preload_xs.t @@ -1,6 +1,7 @@ use strict; use warnings; +use if !$ENV{PERL_JSON_XS_USE}, 'Test::More', skip_all => 'No JSON::XS override'; use if !eval { require JSON::XS; 1; }, 'Test::More', skip_all => 'No JSON::XS'; use Test::More 0.88; use JSON::MaybeXS; diff --git a/t/xs.t b/t/xs.t index 405e7f1..44b9010 100644 --- a/t/xs.t +++ b/t/xs.t @@ -10,7 +10,7 @@ use lib map { use Test::More 0.88; use JSON::MaybeXS; -unless ( eval { require JSON::XS; 1 } ) { +unless ( $ENV{PERL_JSON_XS_USE} and eval { require JSON::XS; 1 } ) { plan skip_all => 'No JSON::XS'; } From 11995090490c65fb8ee0a96a3ee68a10b0f7706a Mon Sep 17 00:00:00 2001 From: Ed J Date: Thu, 5 Oct 2017 19:31:07 +0100 Subject: [PATCH 4/4] no look at JSON::XS on install if !$ENV{PERL_JSON_XS_USE} --- Makefile.PL | 10 ++++++---- lib/JSON/MaybeXS.pm | 10 +++++++--- 2 files changed, 13 insertions(+), 7 deletions(-) diff --git a/Makefile.PL b/Makefile.PL index 4b38de2..57947f3 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -66,19 +66,21 @@ my %META = ( my %MM_ARGS = (); if (! parse_args()->{PUREPERL_ONLY}) { - # we require Cpanel::JSON::XS, except if JSON::XS is already installed. + # we require Cpanel::JSON::XS, except if + # (JSON::XS is already installed and its use dictated by env var). # (we also always recommend Cpanel::JSON::XS, just to make sure.) $MM_ARGS{PREREQ_PM}{'Cpanel::JSON::XS'} = '2.3310' if eval { require Cpanel::JSON::XS } or ( - not eval { require JSON::XS } + $ENV{PERL_JSON_XS_USE} + and not eval { require JSON::XS } and can_compile_loadable_object(quiet => 1) ); # JSON::XS 3 changed its boolean handling - update it - # if JSON::XS is installed and < 3.0 + # if JSON::XS is installed and < 3.0 and JSON::XS use dictated by env var $MM_ARGS{PREREQ_PM}{'JSON::XS'} = '3.00' - if eval { require JSON::XS } + if $ENV{PERL_JSON_XS_USE} and eval { require JSON::XS } and not eval { JSON::XS->VERSION('3.0'); 1 }; } diff --git a/lib/JSON/MaybeXS.pm b/lib/JSON/MaybeXS.pm index 72d88bd..70eb549 100644 --- a/lib/JSON/MaybeXS.pm +++ b/lib/JSON/MaybeXS.pm @@ -288,9 +288,13 @@ Alternatively, you can use duck typing: At installation time, F will attempt to determine if you have a working compiler available, and therefore whether you are able to run XS code. -If so, L will be added to the prerequisite list, unless -L is already installed at a high enough version. L may -also be upgraded to fix any incompatibility issues. +If so, L will be added to the prerequisite list. + +If and only if the environment variable C is set +to a true variable, then unless L is already installed at +a high enough version. L may also be upgraded to fix any +incompatibility issues. If that environment variable is not set to a +true value, L will be ignored. Because running XS code is not mandatory and L (which is in perl core) is used as a fallback backend, this module is safe to be used in a suite