(internal) Introduce an extra utility function, essentially a ( >= , < ) test

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / _Util.pm

diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm
index 83bca47..be34bc6 100644 (file)
--- a/lib/DBIx/Class/_Util.pm
+++ b/lib/DBIx/Class/_Util.pm
@@ -34,6 +34,8 @@ BEGIN {
 
     ASSERT_NO_INTERNAL_INDIRECT_CALLS => $ENV{DBIC_ASSERT_NO_INTERNAL_INDIRECT_CALLS} ? 1 : 0,
 
+    STRESSTEST_UTF8_UPGRADE_GENERATED_COLLAPSER_SOURCE => $ENV{DBIC_STRESSTEST_UTF8_UPGRADE_GENERATED_COLLAPSER_SOURCE} ? 1 : 0,
+
     IV_SIZE => $Config{ivsize},
 
     OS_NAME => $^O,
@@ -61,8 +63,14 @@ use List::Util qw(first);
 # BEGIN pre-Moo2 import block
 BEGIN {
   my $initial_fatal_bits = (${^WARNING_BITS}||'') & $warnings::DeadBits{all};
+
   local $ENV{PERL_STRICTURES_EXTRA} = 0;
-  require Sub::Quote; Sub::Quote->import('quote_sub');
+  # load all of these now, so that lazy-loading does not escape
+  # the current PERL_STRICTURES_EXTRA setting
+  require Sub::Quote;
+  require Sub::Defer;
+
+  Sub::Quote->import('quote_sub');
   ${^WARNING_BITS} &= ( $initial_fatal_bits | ~ $warnings::DeadBits{all} );
 }
 sub qsub ($) { goto &quote_sub }  # no point depping on new Moo just for this
@@ -70,10 +78,10 @@ sub qsub ($) { goto &quote_sub }  # no point depping on new Moo just for this
 
 use base 'Exporter';
 our @EXPORT_OK = qw(
-  sigwarn_silencer modver_gt_or_eq
+  sigwarn_silencer modver_gt_or_eq modver_gt_or_eq_and_lt
   fail_on_internal_wantarray fail_on_internal_call
   refdesc refcount hrefaddr is_exception
-  quote_sub qsub perlstring
+  quote_sub qsub perlstring serialize
   UNRESOLVABLE_CONDITION
 );
 
@@ -114,6 +122,12 @@ sub refcount ($) {
   B::svref_2object($_[0])->REFCNT;
 }
 
+sub serialize ($) {
+  require Storable;
+  local $Storable::canonical = 1;
+  Storable::nfreeze($_[0]);
+}
+
 sub is_exception ($) {
   my $e = $_[0];
 
@@ -185,6 +199,19 @@ sub modver_gt_or_eq ($$) {
   eval { $mod->VERSION($ver) } ? 1 : 0;
 }
 
+sub modver_gt_or_eq_and_lt ($$$) {
+  my ($mod, $v_ge, $v_lt) = @_;
+
+  croak "Nonsensical maximum version supplied"
+    if ! defined $v_lt or $v_lt =~ /[^0-9\.\_]/;
+
+  return (
+    modver_gt_or_eq($mod, $v_ge)
+      and
+    ! modver_gt_or_eq($mod, $v_lt)
+  ) ? 1 : 0;
+}
+
 {
   my $list_ctx_ok_stack_marker;