Remove last remaining accesses to ->VERSION in lib
Peter Rabbitson [Sat, 24 Jan 2015 15:16:14 +0000 (16:16 +0100)]
Beef up and streamline (with caching) the ::_Util mod version checks

Read under -w

lib/DBIx/Class/Storage/DBI/ADO.pm
lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
lib/DBIx/Class/_Util.pm

index 4244aa7..cfabc73 100644 (file)
@@ -7,8 +7,7 @@ use base 'DBIx::Class::Storage::DBI';
 use mro 'c3';
 
 use Sub::Name;
-use Try::Tiny;
-use DBIx::Class::_Util 'sigwarn_silencer';
+use DBIx::Class::_Util qw( sigwarn_silencer modver_gt_or_eq );
 use namespace::clean;
 
 =head1 NAME
@@ -45,7 +44,7 @@ sub _init {
   unless ($DBD::ADO::__DBIC_MONKEYPATCH_CHECKED__) {
     require DBD::ADO;
 
-    unless (try { DBD::ADO->VERSION('2.99'); 1 }) {
+    unless ( modver_gt_or_eq( 'DBD::ADO', '2.99' ) ) {
       no warnings 'redefine';
       my $disconnect = *DBD::ADO::db::disconnect{CODE};
 
index 1780d51..2bea8b9 100644 (file)
@@ -9,6 +9,7 @@ use Scope::Guard ();
 use Context::Preserve 'preserve_context';
 use Try::Tiny;
 use List::Util 'first';
+use DBIx::Class::_Util 'modver_gt_or_eq_and_lt';
 use namespace::clean;
 
 __PACKAGE__->sql_limit_dialect ('RowNum');
@@ -440,20 +441,11 @@ sub bind_attribute_by_data_type {
 
   if ($self->_is_lob_type($dt)) {
 
-    # this is a hot-ish codepath, store an escape-flag in the DBD namespace, so that
-    # things like Class::Unload work (unlikely but possible)
-    unless ($DBD::Oracle::__DBIC_DBD_VERSION_CHECK_OK__) {
-
-      # no earlier - no later
-      if ($DBD::Oracle::VERSION eq '1.23') {
-        $self->throw_exception(
-          "BLOB/CLOB support in DBD::Oracle == 1.23 is broken, use an earlier or later ".
-          "version (https://rt.cpan.org/Public/Bug/Display.html?id=46016)"
-        );
-      }
-
-      $DBD::Oracle::__DBIC_DBD_VERSION_CHECK_OK__ = 1;
-    }
+    # no earlier - no later
+    $self->throw_exception(
+      "BLOB/CLOB support in DBD::Oracle == 1.23 is broken, use an earlier or later "
+    . "version (https://rt.cpan.org/Public/Bug/Display.html?id=46016)"
+    ) if modver_gt_or_eq_and_lt( 'DBD::Oracle', '1.23', '1.24' );
 
     return {
       ora_type => $self->_is_text_lob_type($dt)
index 32fdf0c..bfb6a2a 100644 (file)
@@ -270,30 +270,44 @@ sub is_exception ($) {
   }
 }
 
+my $module_name_rx = qr/ \A [A-Z_a-z] [0-9A-Z_a-z]* (?: :: [0-9A-Z_a-z]+ )* \z /x;
+my $ver_rx =         qr/ \A [0-9]+ (?: \. [0-9]+ )* (?: \_ [0-9]+ )*        \z /x;
+
 sub modver_gt_or_eq ($$) {
   my ($mod, $ver) = @_;
 
   croak "Nonsensical module name supplied"
-    if ! defined $mod or ! length $mod;
+    if ! defined $mod or $mod !~ $module_name_rx;
 
   croak "Nonsensical minimum version supplied"
-    if ! defined $ver or $ver =~ /[^0-9\.\_]/;
+    if ! defined $ver or $ver !~ $ver_rx;
+
+  no strict 'refs';
+  my $ver_cache = ${"${mod}::__DBIC_MODULE_VERSION_CHECKS__"} ||= ( $mod->VERSION
+    ? {}
+    : croak "$mod does not seem to provide a version (perhaps it never loaded)"
+  );
+
+  ! defined $ver_cache->{$ver}
+    and
+  $ver_cache->{$ver} = do {
 
-  local $SIG{__WARN__} = sigwarn_silencer( qr/\Qisn't numeric in subroutine entry/ )
-    if SPURIOUS_VERSION_CHECK_WARNINGS;
+    local $SIG{__WARN__} = sigwarn_silencer( qr/\Qisn't numeric in subroutine entry/ )
+      if SPURIOUS_VERSION_CHECK_WARNINGS;
 
-  croak "$mod does not seem to provide a version (perhaps it never loaded)"
-    unless $mod->VERSION;
+    local $@;
+    local $SIG{__DIE__};
+    eval { $mod->VERSION($ver) } ? 1 : 0;
+  };
 
-  local $@;
-  eval { $mod->VERSION($ver) } ? 1 : 0;
+  $ver_cache->{$ver};
 }
 
 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\.\_]/;
+    if ! defined $v_lt or $v_lt !~ $ver_rx;
 
   return (
     modver_gt_or_eq($mod, $v_ge)