X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2F_Util.pm;h=33b296c0977d20129d0227edf45d856e32ddad71;hb=0020e364ef2847a723dd8bc538ee1ce632fd734c;hp=5a35ab3f128c809f8b561b1db403f898d2566545;hpb=77c3a5dca478801246ff728f80a0c5013e57f4a2;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm
index 5a35ab3..33b296c 100644
--- a/lib/DBIx/Class/_Util.pm
+++ b/lib/DBIx/Class/_Util.pm
@@ -17,6 +17,8 @@ BEGIN {
     # but of course
     BROKEN_FORK => ($^O eq 'MSWin32') ? 1 : 0,
 
+    BROKEN_GOTO => ($] < '5.008003') ? 1 : 0,
+
     HAS_ITHREADS => $Config{useithreads} ? 1 : 0,
 
     # ::Runmode would only be loaded by DBICTest, which in turn implies t/
@@ -32,6 +34,10 @@ 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,
+
+    STRESSTEST_COLUMN_INFO_UNAWARE_STORAGE => $ENV{DBIC_STRESSTEST_COLUMN_INFO_UNAWARE_STORAGE} ? 1 : 0,
+
     IV_SIZE => $Config{ivsize},
 
     OS_NAME => $^O,
@@ -51,15 +57,22 @@ BEGIN {
 # Carp::Skip to the rescue soon
 use DBIx::Class::Carp '^DBIx::Class|^DBICTest';
 
+use B ();
 use Carp 'croak';
+use Storable 'nfreeze';
 use Scalar::Util qw(weaken blessed reftype);
 use List::Util qw(first);
+use Sub::Quote qw(qsub quote_sub);
+
+# Already correctly prototyped: perlbrew exec perl -MStorable -e 'warn prototype \&Storable::dclone'
+BEGIN { *deep_clone = \&Storable::dclone }
 
 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 serialize deep_clone
   UNRESOLVABLE_CONDITION
 );
 
@@ -75,6 +88,8 @@ sub sigwarn_silencer ($) {
   return sub { &$orig_sig_warn unless $_[0] =~ $pattern };
 }
 
+sub perlstring ($) { q{"}. quotemeta( shift ). q{"} };
+
 sub hrefaddr ($) { sprintf '0x%x', &Scalar::Util::refaddr||0 }
 
 sub refdesc ($) {
@@ -92,12 +107,16 @@ sub refdesc ($) {
 sub refcount ($) {
   croak "Expecting a reference" if ! length ref $_[0];
 
-  require B;
   # No tempvars - must operate on $_[0], otherwise the pad
   # will count as an extra ref
   B::svref_2object($_[0])->REFCNT;
 }
 
+sub serialize ($) {
+  local $Storable::canonical = 1;
+  nfreeze($_[0]);
+}
+
 sub is_exception ($) {
   my $e = $_[0];
 
@@ -169,6 +188,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;