Make it possible to force Specio to use only pure Perl dependencies

We do this by switching between Clone and Clone::PP. This is useful for cases like fatpacking a
program, where XS just doesn't work.

Author: autarch

Changes

@@ -1,5 +1,10 @@
 {{$NEXT}}
 
+- Made it possible to force Specio to only use pure Perl dependencies by setting the
+  SPECIO_IMPLEMENTATION environment variable to "PP". Requested by @arodland (Andrew Rodland). GH
+  #23.
+
+
 0.50     2025-02-18
 
 - Fixed a bug in the Int type that caused it to accept numbers like 124512.000000000123, which when

Makefile.PL

@@ -23,12 +23,15 @@ my %WriteMakefileArgs = (
     "B" => 0,
     "Carp" => 0,
     "Clone" => 0,
+    "Clone::Choose" => 0,
+    "Clone::PP" => 0,
     "Devel::StackTrace" => 0,
     "Eval::Closure" => 0,
     "Exporter" => 0,
     "IO::File" => 0,
     "List::Util" => "1.33",
     "MRO::Compat" => 0,
+    "Module::Implementation" => 0,
     "Module::Runtime" => 0,
     "Role::Tiny" => "1.003003",
     "Role::Tiny::With" => 0,
@@ -64,6 +67,8 @@ my %FallbackPrereqs = (
   "B" => 0,
   "Carp" => 0,
   "Clone" => 0,
+  "Clone::Choose" => 0,
+  "Clone::PP" => 0,
   "Devel::StackTrace" => 0,
   "Eval::Closure" => 0,
   "Exporter" => 0,
@@ -73,6 +78,7 @@ my %FallbackPrereqs = (
   "IO::File" => 0,
   "List::Util" => "1.33",
   "MRO::Compat" => 0,
+  "Module::Implementation" => 0,
   "Module::Runtime" => 0,
   "Role::Tiny" => "1.003003",
   "Role::Tiny::With" => 0,

README.md

@@ -4,7 +4,7 @@ Specio - Type constraints and coercions for Perl
 
 # VERSION
 
-version 0.50
+version 0.51
 
 # SYNOPSIS
 
@@ -390,6 +390,12 @@ distribution better in some way.
     If one of these is installed then stack traces that end up in Specio code will
     have much better subroutine names for any frames.
 
+# FORCING PURE PERL MODE
+
+For some use cases (notably fat-packing a program), you may want to force
+Specio to use pure Perl code instead of XS code. This can be done by setting
+the environment variable `SPECIO_IMPLEMENTATION` to `PP`.
+
 # WHY THE NAME?
 
 This distro was originally called "Type", but that's an awfully generic top

cpanfile

@@ -4,12 +4,15 @@
 requires "B" => "0";
 requires "Carp" => "0";
 requires "Clone" => "0";
+requires "Clone::Choose" => "0";
+requires "Clone::PP" => "0";
 requires "Devel::StackTrace" => "0";
 requires "Eval::Closure" => "0";
 requires "Exporter" => "0";
 requires "IO::File" => "0";
 requires "List::Util" => "1.33";
 requires "MRO::Compat" => "0";
+requires "Module::Implementation" => "0";
 requires "Module::Runtime" => "0";
 requires "Role::Tiny" => "1.003003";
 requires "Role::Tiny::With" => "0";
@@ -71,12 +74,16 @@ on 'develop' => sub {
   requires "Test::EOL" => "0";
   requires "Test::Mojibake" => "0";
   requires "Test::More" => "0.88";
+  requires "Test::Needs" => "0";
   requires "Test::NoTabs" => "0";
   requires "Test::Pod" => "1.41";
   requires "Test::Pod::Coverage" => "1.08";
   requires "Test::Portability::Files" => "0";
   requires "Test::Spelling" => "0.17";
   requires "Test::Version" => "2.05";
   requires "Test::Without::Module" => "0";
+  requires "lib" => "0";
   requires "namespace::autoclean" => "0";
+  requires "open" => "0";
+  requires "utf8" => "0";
 };

dist.ini

@@ -13,6 +13,8 @@ prereqs_skip = Mouse
 prereqs_skip = namespace::autoclean
 prereqs_skip = Sub::Name
 prereqs_skip = XString
+pod_coverage_skip = Specio::PP
+pod_coverage_skip = Specio::XS
 stopwords_file = .stopwords
 use_github_issues = 1
 Test::TidyAll.minimum_perl = 5.010000
@@ -38,3 +40,7 @@ Sub::Quote = 0
 
 [MetaNoIndex]
 directory = t/lib
+
+[PurePerlTests]
+:version = 0.06
+env_var = SPECIO_TEST_PP

lib/Specio.pm

@@ -7,6 +7,33 @@ use 5.008;
 
 our $VERSION = '0.51';
 
+use Module::Implementation;
+
+use Exporter qw( import );
+
+BEGIN {
+    # This env var exists for the benefit of the PurePerlTests dzil plugin, which only knows how to
+    # set an env var to a true value.
+    if ( $ENV{SPECIO_TEST_PP} ) {
+        ## no critic (Variables::RequireLocalizedPunctuationVars)
+        $ENV{SPECIO_IMPLEMENTATION} = 'PP';
+    }
+
+    my $loader = Module::Implementation::build_loader_sub(
+        implementations => [ 'XS', 'PP' ],
+        symbols         => ['_clone'],
+    );
+    $loader->();
+}
+
+# It's a bit weird to put this in the root module, but this way the env var that
+# Module::Implementation::build_loader_sub uses will be named "SPECIO_IMPLEMENTATION". That way, if
+# in the future there are other optional XS components besides the Clone implementation, we don't
+# end up with a bunch of different env vars.
+#
+## no critic (Modules::ProhibitAutomaticExportation)
+our @EXPORT = qw( _clone );
+
 1;
 
 # ABSTRACT: Type constraints and coercions for Perl
@@ -406,6 +433,12 @@ have much better subroutine names for any frames.
 
 =back
 
+=head1 FORCING PURE PERL MODE
+
+For some use cases (notably fatpacking a program), you may want to force Specio
+to use pure Perl code instead of XS code. This can be done by setting the
+environment variable C<SPECIO_IMPLEMENTATION> to C<PP>.
+
 =head1 WHY THE NAME?
 
 This distro was originally called "Type", but that's an awfully generic top
@@ -414,4 +447,3 @@ the word "species". It's short, relatively easy to type, and not used by any
 other distro.
 
 =cut
-

lib/Specio/OO.pm

@@ -4,11 +4,12 @@ use strict;
 use warnings;
 
 use Carp            qw( confess );
-use Clone           ();
+use Clone::Choose   ();
 use List::Util 1.33 qw( all );
 use MRO::Compat;
 use Role::Tiny;
 use Scalar::Util        qw( weaken );
+use Specio              qw( _clone );
 use Specio::Helpers     qw( perlstring );
 use Specio::PartialDump qw( partial_dump );
 use Specio::TypeChecks;
@@ -335,7 +336,7 @@ sub clone {
         $new->{$key}
             = !$ref               ? $value
             : $ref eq 'CODE'      ? $value
-            : $BuiltinTypes{$ref} ? Clone::clone($value)
+            : $BuiltinTypes{$ref} ? _clone($value)
             :                       $value->clone;
     }
 

lib/Specio/PP.pm

@@ -0,0 +1,20 @@
+package Specio::PP;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.51';
+
+use Clone::PP qw( clone );
+
+use Exporter qw( import );
+
+## no critic (Modules::ProhibitAutomaticExportation)
+our @EXPORT = qw(  _clone );
+
+## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
+sub _clone {
+    return clone(shift);
+}
+
+1;

lib/Specio/XS.pm

@@ -0,0 +1,20 @@
+package Specio::XS;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.51';
+
+use Clone qw( clone );
+
+use Exporter qw( import );
+
+## no critic (Modules::ProhibitAutomaticExportation)
+our @EXPORT = qw(  _clone );
+
+## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
+sub _clone {
+    return clone(shift);
+}
+
+1;

t/combines.t

@@ -2,7 +2,19 @@ use strict;
 use warnings;
 
 use FindBin qw( $Bin );
-use lib "$Bin/lib";
+
+my $lib_path;
+
+BEGIN {
+    if ( $Bin =~ /xt/ ) {
+        $lib_path = "$Bin/../../t";
+    }
+    else {
+        $lib_path = "$Bin";
+    }
+}
+
+use lib "$lib_path/lib";
 
 use Test::Fatal;
 use Test::More 0.96;