From: Peter Rabbitson Date: Wed, 25 May 2016 12:19:13 +0000 (+0200) Subject: Move even more utils into DBIC::_Util (see next commit) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=10be570e51ef741ead5f0e8d5ceca78499a8965c;p=dbsrgits%2FDBIx-Class-Historic.git Move even more utils into DBIC::_Util (see next commit) Zero functional changes --- diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm index da0d49b..a713ee7 100644 --- a/lib/DBIx/Class/_Util.pm +++ b/lib/DBIx/Class/_Util.pm @@ -94,8 +94,8 @@ our @EXPORT_OK = qw( fail_on_internal_wantarray fail_on_internal_call refdesc refcount hrefaddr set_subname scope_guard detected_reinvoked_destructor - is_exception dbic_internal_try - quote_sub qsub perlstring serialize deep_clone dump_value + is_exception dbic_internal_try visit_namespaces + quote_sub qsub perlstring serialize deep_clone dump_value uniq parent_dir mkdir_p UNRESOLVABLE_CONDITION ); @@ -200,6 +200,36 @@ sub refcount ($) { B::svref_2object($_[0])->REFCNT; } +sub visit_namespaces { + my $args = { (ref $_[0]) ? %{$_[0]} : @_ }; + + my $visited_count = 1; + + # A package and a namespace are subtly different things + $args->{package} ||= 'main'; + $args->{package} = 'main' if $args->{package} =~ /^ :: (?: main )? $/x; + $args->{package} =~ s/^:://; + + if ( $args->{action}->($args->{package}) ) { + my $ns = + ( ($args->{package} eq 'main') ? '' : $args->{package} ) + . + '::' + ; + + $visited_count += visit_namespaces( %$args, package => $_ ) for + grep + # this happens sometimes on %:: traversal + { $_ ne '::main' } + map + { $_ =~ /^(.+?)::$/ ? "$ns$1" : () } + do { no strict 'refs'; keys %$ns } + ; + } + + $visited_count; +} + # FIXME In another life switch this to a polyfill like the one in namespace::clean sub set_subname ($$) { @@ -215,6 +245,15 @@ sub serialize ($) { nfreeze($_[0]); } +sub uniq { + my( %seen, $seen_undef, $numeric_preserving_copy ); + grep { not ( + defined $_ + ? $seen{ $numeric_preserving_copy = $_ }++ + : $seen_undef++ + ) } @_; +} + my $dd_obj; sub dump_value ($) { local $Data::Dumper::Indent = 1 diff --git a/t/00describe_environment.t b/t/00describe_environment.t index e24249f..21cf5d6 100644 --- a/t/00describe_environment.t +++ b/t/00describe_environment.t @@ -57,7 +57,7 @@ use List::Util 'max'; use ExtUtils::MakeMaker; use DBICTest::RunMode; -use DBICTest::Util 'visit_namespaces'; +use DBIx::Class::_Util 'visit_namespaces'; use DBIx::Class::Optional::Dependencies; my $known_paths = { diff --git a/t/lib/DBICTest/Util.pm b/t/lib/DBICTest/Util.pm index 990050c..46b8c2f 100644 --- a/t/lib/DBICTest/Util.pm +++ b/t/lib/DBICTest/Util.pm @@ -37,7 +37,7 @@ use base 'Exporter'; our @EXPORT_OK = qw( dbg stacktrace class_seems_loaded local_umask slurp_bytes tmpdir find_co_root rm_rf - visit_namespaces PEEPEENESS + PEEPEENESS check_customcond_args await_flock DEBUG_TEST_CONCURRENCY_LOCKS ); @@ -409,36 +409,6 @@ sub check_customcond_args ($) { $args; } -sub visit_namespaces { - my $args = { (ref $_[0]) ? %{$_[0]} : @_ }; - - my $visited_count = 1; - - # A package and a namespace are subtly different things - $args->{package} ||= 'main'; - $args->{package} = 'main' if $args->{package} =~ /^ :: (?: main )? $/x; - $args->{package} =~ s/^:://; - - if ( $args->{action}->($args->{package}) ) { - my $ns = - ( ($args->{package} eq 'main') ? '' : $args->{package} ) - . - '::' - ; - - $visited_count += visit_namespaces( %$args, package => $_ ) for - grep - # this happens sometimes on %:: traversal - { $_ ne '::main' } - map - { $_ =~ /^(.+?)::$/ ? "$ns$1" : () } - do { no strict 'refs'; keys %$ns } - ; - } - - return $visited_count; -} - # # Replicate the *heuristic* (important!!!) implementation found in various # forms within Class::Load / Module::Inspector / Class::C3::Componentised diff --git a/t/lib/DBICTest/Util/LeakTracer.pm b/t/lib/DBICTest/Util/LeakTracer.pm index 4873d77..6f1bcb6 100644 --- a/t/lib/DBICTest/Util/LeakTracer.pm +++ b/t/lib/DBICTest/Util/LeakTracer.pm @@ -6,9 +6,9 @@ use strict; use ANFANG; use Carp; use Scalar::Util qw(isweak weaken blessed reftype); -use DBIx::Class::_Util qw(refcount hrefaddr refdesc dump_value); +use DBIx::Class::_Util qw(refcount hrefaddr refdesc dump_value visit_namespaces); use DBICTest::RunMode; -use DBICTest::Util qw( stacktrace visit_namespaces ); +use DBICTest::Util 'stacktrace'; use constant { CV_TRACING => !!( !DBICTest::RunMode->is_plain