From: Peter Rabbitson Date: Sat, 24 Jan 2015 15:16:14 +0000 (+0100) Subject: Remove last remaining accesses to ->VERSION in lib X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7302b3e0fadad3321a1e0ad681949b06c9c8601f;p=dbsrgits%2FDBIx-Class-Historic.git Remove last remaining accesses to ->VERSION in lib Beef up and streamline (with caching) the ::_Util mod version checks Read under -w --- diff --git a/lib/DBIx/Class/Storage/DBI/ADO.pm b/lib/DBIx/Class/Storage/DBI/ADO.pm index 4244aa7..cfabc73 100644 --- a/lib/DBIx/Class/Storage/DBI/ADO.pm +++ b/lib/DBIx/Class/Storage/DBI/ADO.pm @@ -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}; diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm index 1780d51..2bea8b9 100644 --- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm @@ -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) diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm index 32fdf0c..bfb6a2a 100644 --- a/lib/DBIx/Class/_Util.pm +++ b/lib/DBIx/Class/_Util.pm @@ -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)