From: Peter Rabbitson Date: Mon, 28 Mar 2016 20:50:55 +0000 (+0200) Subject: Lose yet another dep (Data::Dumper::Concise) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8fc4291ef4f19b6f4c4f25cd695cb613da613fe1;p=dbsrgits%2FDBIx-Class-Historic.git Lose yet another dep (Data::Dumper::Concise) --- diff --git a/Makefile.PL b/Makefile.PL index 0bf82f3..a44941b 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -57,7 +57,6 @@ my $runtime_requires = { 'Class::C3::Componentised' => '1.0009', 'Class::Inspector' => '1.24', 'Context::Preserve' => '0.01', - 'Data::Dumper::Concise' => '2.020', 'Data::Page' => '2.00', 'Devel::GlobalDestruction' => '0.09', 'Hash::Merge' => '0.12', diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 0a6c002..e604832 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -8,7 +8,7 @@ use DBIx::Class::ResultSetColumn; use DBIx::Class::ResultClass::HashRefInflator; use Scalar::Util qw/blessed weaken reftype/; use DBIx::Class::_Util qw( - dbic_internal_try + dbic_internal_try dump_value fail_on_internal_wantarray fail_on_internal_call UNRESOLVABLE_CONDITION ); use Try::Tiny; @@ -554,7 +554,6 @@ sub search_rs { return $rs; } -my $dark_sel_dumper; sub _normalize_selection { my ($self, $attrs) = @_; @@ -619,11 +618,10 @@ sub _normalize_selection { else { $attrs->{_dark_selector} = { plus_stage => $pref, - string => ($dark_sel_dumper ||= do { - require Data::Dumper::Concise; - Data::Dumper::Concise::DumperObject()->Indent(0); - })->Values([$_])->Dump - , + string => do { + local $Data::Dumper::Indent = 0; + dump_value $_; + }, }; last SELECTOR; } diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 1f66d71..01c8dcc 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -14,7 +14,7 @@ use Context::Preserve 'preserve_context'; use Try::Tiny; use SQL::Abstract qw(is_plain_value is_literal_value); use DBIx::Class::_Util qw( - quote_sub perlstring serialize + quote_sub perlstring serialize dump_value dbic_internal_try detected_reinvoked_destructor scope_guard mkdir_p @@ -1419,12 +1419,10 @@ sub _get_rdbms_name { shift->_dbh_get_info('SQL_DBMS_NAME') } sub _warn_undetermined_driver { my ($self, $msg) = @_; - require Data::Dumper::Concise; - carp_once ($msg . ' While we will attempt to continue anyway, the results ' . 'are likely to be underwhelming. Please upgrade DBIC, and if this message ' . "does not go away, file a bugreport including the following info:\n" - . Data::Dumper::Concise::Dumper($self->_describe_connection) + . dump_value $self->_describe_connection ); } @@ -2200,13 +2198,12 @@ sub _insert_bulk { $msg, $cols->[$c_idx], do { - require Data::Dumper::Concise; local $Data::Dumper::Maxdepth = 5; - Data::Dumper::Concise::Dumper ({ + dump_value { map { $cols->[$_] => $data->[$r_idx][$_] } 0..$#$cols - }), + }; } ); }; @@ -2403,10 +2400,9 @@ sub _dbh_execute_for_fetch { $self->throw_exception("Unexpected populate error: $err") if ($i > $#$tuple_status); - require Data::Dumper::Concise; $self->throw_exception(sprintf "execute_for_fetch() aborted with '%s' at populate slice:\n%s", ($tuple_status->[$i][1] || $err), - Data::Dumper::Concise::Dumper( { map { $cols->[$_] => $data->[$i][$_] } (0 .. $#$cols) } ), + dump_value { map { $cols->[$_] => $data->[$i][$_] } (0 .. $#$cols) }, ); } diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm index 3479ff3..3d66fa1 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm @@ -13,10 +13,9 @@ use DBIx::Class::Carp; use Scalar::Util qw/blessed weaken/; use List::Util 'first'; use Sub::Name(); -use Data::Dumper::Concise 'Dumper'; use Try::Tiny; use Context::Preserve 'preserve_context'; -use DBIx::Class::_Util qw( sigwarn_silencer dbic_internal_try ); +use DBIx::Class::_Util qw( sigwarn_silencer dbic_internal_try dump_value ); use namespace::clean; __PACKAGE__->sql_limit_dialect ('GenericSubQ'); @@ -781,7 +780,7 @@ sub _insert_blobs { if (not $sth) { $self->throw_exception( "Could not find row in table '$table' for blob update:\n" - . (Dumper \%where) + . dump_value \%where ); } diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm index 14410b7..e98bc49 100644 --- a/lib/DBIx/Class/Storage/DBIHacks.pm +++ b/lib/DBIx/Class/Storage/DBIHacks.pm @@ -30,7 +30,7 @@ use mro 'c3'; use List::Util 'first'; use Scalar::Util 'blessed'; -use DBIx::Class::_Util qw(UNRESOLVABLE_CONDITION serialize); +use DBIx::Class::_Util qw(UNRESOLVABLE_CONDITION serialize dump_value); use SQL::Abstract qw(is_plain_value is_literal_value); use DBIx::Class::Carp; use namespace::clean; @@ -513,9 +513,9 @@ sub _resolve_aliastypes_from_select_args { ( $_ = join ' ', map { ( ! defined $_ ) ? () - : ( length ref $_ ) ? (require Data::Dumper::Concise && $self->throw_exception( - "Unexpected ref in scan-plan: " . Data::Dumper::Concise::Dumper($_) - )) + : ( length ref $_ ) ? $self->throw_exception( + "Unexpected ref in scan-plan: " . dump_value $_ + ) : ( $_ =~ /^\s*$/ ) ? () : $_ @@ -1346,11 +1346,10 @@ sub _collapse_cond_unroll_pairs { # extra sanity check if (keys %$p > 1) { - require Data::Dumper::Concise; local $Data::Dumper::Deepcopy = 1; $self->throw_exception( "Internal error: unexpected collapse unroll:" - . Data::Dumper::Concise::Dumper { in => { $lhs => $rhs }, out => $p } + . dump_value { in => { $lhs => $rhs }, out => $p } ); } diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm index 8c62054..60a4815 100644 --- a/lib/DBIx/Class/_Util.pm +++ b/lib/DBIx/Class/_Util.pm @@ -75,7 +75,7 @@ our @EXPORT_OK = qw( refdesc refcount hrefaddr scope_guard detected_reinvoked_destructor is_exception dbic_internal_try - quote_sub qsub perlstring serialize deep_clone + quote_sub qsub perlstring serialize deep_clone dump_value parent_dir mkdir_p UNRESOLVABLE_CONDITION ); @@ -121,6 +121,42 @@ sub serialize ($) { nfreeze($_[0]); } +my ($dd_obj, $dump_str); +sub dump_value ($) { + local $Data::Dumper::Indent = 1 + unless defined $Data::Dumper::Indent; + + $dump_str = ( + $dd_obj + ||= + do { + require Data::Dumper; + my $d = Data::Dumper->new([]) + ->Purity(0) + ->Pad('') + ->Useqq(1) + ->Terse(1) + ->Freezer('') + ->Quotekeys(0) + ->Bless('bless') + ->Pair(' => ') + ->Sortkeys(1) + ->Deparse(1) + ; + + $d->Sparseseen(1) if modver_gt_or_eq ( + 'Data::Dumper', '2.136' + ); + + $d; + } + )->Values([$_[0]])->Dump; + + $dd_obj->Reset->Values([]); + + $dump_str; +} + sub scope_guard (&) { croak 'Calling scope_guard() in void context makes no sense' if ! defined wantarray; diff --git a/lib/SQL/Translator/Producer/DBIx/Class/File.pm b/lib/SQL/Translator/Producer/DBIx/Class/File.pm index 90c61fd..db02f7c 100644 --- a/lib/SQL/Translator/Producer/DBIx/Class/File.pm +++ b/lib/SQL/Translator/Producer/DBIx/Class/File.pm @@ -36,7 +36,7 @@ $DEBUG = 0 unless defined $DEBUG; use SQL::Translator::Schema::Constants; use SQL::Translator::Utils qw(header_comment); -use Data::Dumper (); +use DBIx::Class::_Util 'dump_value'; ## Skip all column type translation, as we want to use whatever the parser got. @@ -108,13 +108,9 @@ __PACKAGE__->table('${tname}'); $output .= "\n__PACKAGE__->add_columns("; foreach my $f (@fields) { - local $Data::Dumper::Terse = 1; $output .= "\n '" . (keys %$f)[0] . "' => " ; - my $colinfo = - Data::Dumper->Dump([values %$f], - [''] # keys %$f] - ); - chomp($colinfo); + ( my $colinfo = dump_value( (values %$f)[0] ) ) =~ s/^/ /mg; + $colinfo =~ s/^\s*|\s*$//g; $output .= $colinfo . ","; } $output .= "\n);\n"; @@ -129,7 +125,6 @@ __PACKAGE__->table('${tname}'); foreach my $cont ($table->get_constraints) { -# print Data::Dumper::Dumper($cont->type); if($cont->type =~ /foreign key/i) { # $output .= "\n__PACKAGE__->belongs_to('" . diff --git a/t/00describe_environment.t b/t/00describe_environment.t index a88c187..37e3da9 100644 --- a/t/00describe_environment.t +++ b/t/00describe_environment.t @@ -192,6 +192,7 @@ my $load_weights = { my @known_modules = sort { ($load_weights->{$b}||0) <=> ($load_weights->{$a}||0) } + qw( Data::Dumper ), keys %{ DBIx::Class::Optional::Dependencies->req_list_for([ grep diff --git a/t/cdbi/23-cascade.t b/t/cdbi/23-cascade.t index c66cffb..cedf91a 100644 --- a/t/cdbi/23-cascade.t +++ b/t/cdbi/23-cascade.t @@ -5,7 +5,7 @@ use strict; use warnings; use Test::More; -use Data::Dumper; +use DBIx::Class::_Util 'dump_value'; use lib 't/cdbi/testlib'; use Film; @@ -42,8 +42,7 @@ for my $args ({ no_cascade_delete => 1 }, { cascade => "None" }) { is $dir->nasties, 1, "We have one nasty"; ok $dir->delete; - local $Data::Dumper::Terse = 1; - ok +Film->retrieve("Alligator"), 'has_many with ' . Dumper ($args);; + ok +Film->retrieve("Alligator"), 'has_many with ' . dump_value $args; $kk->delete; } diff --git a/t/lib/DBICTest/Util/LeakTracer.pm b/t/lib/DBICTest/Util/LeakTracer.pm index 03a8a13..8e2e6e8 100644 --- a/t/lib/DBICTest/Util/LeakTracer.pm +++ b/t/lib/DBICTest/Util/LeakTracer.pm @@ -6,9 +6,8 @@ use strict; use ANFANG; use Carp; use Scalar::Util qw(isweak weaken blessed reftype); -use DBIx::Class::_Util qw(refcount hrefaddr refdesc); +use DBIx::Class::_Util qw(refcount hrefaddr refdesc dump_value); use DBICTest::RunMode; -use Data::Dumper::Concise; use DBICTest::Util qw( stacktrace visit_namespaces ); use constant { CV_TRACING => !!( @@ -280,7 +279,7 @@ sub assert_empty_weakregistry { ref($weak_registry->{$addr}{weakref}) eq 'CODE' and B::svref_2object($weak_registry->{$addr}{weakref})->XSUB - ) ? '__XSUB__' : Dumper( $weak_registry->{$addr}{weakref} ) + ) ? '__XSUB__' : dump_value $weak_registry->{$addr}{weakref} ; }; diff --git a/t/prefetch/attrs_untouched.t b/t/prefetch/attrs_untouched.t index ce99b42..7b50344 100644 --- a/t/prefetch/attrs_untouched.t +++ b/t/prefetch/attrs_untouched.t @@ -6,9 +6,7 @@ use strict; use Test::More; use DBICTest; - -use Data::Dumper; -$Data::Dumper::Sortkeys = 1; +use DBIx::Class::_Util 'dump_value'; my $schema = DBICTest->init_schema(); @@ -19,11 +17,11 @@ plan tests => 3; my $search = { 'artist.name' => 'Caterwauler McCrae' }; my $attr = { prefetch => [ qw/artist liner_notes/ ], order_by => 'me.cdid' }; -my $search_str = Dumper($search); -my $attr_str = Dumper($attr); +my $search_str = dump_value $search; +my $attr_str = dump_value $attr; my $rs = $schema->resultset("CD")->search($search, $attr); -is(Dumper($search), $search_str, 'Search hash untouched after search()'); -is(Dumper($attr), $attr_str, 'Attribute hash untouched after search()'); +is( dump_value $search, $search_str, 'Search hash untouched after search()'); +is( dump_value $attr, $attr_str, 'Attribute hash untouched after search()'); cmp_ok($rs + 0, '==', 3, 'Correct number of records returned'); diff --git a/t/search/stack_cond.t b/t/search/stack_cond.t index 4c06a5d..497b698 100644 --- a/t/search/stack_cond.t +++ b/t/search/stack_cond.t @@ -5,12 +5,10 @@ use warnings; use Test::More; +use DBIx::Class::_Util 'dump_value'; use DBICTest ':DiffSQL'; use SQL::Abstract qw(is_plain_value is_literal_value); use List::Util 'shuffle'; -use Data::Dumper; -$Data::Dumper::Terse = 1; -$Data::Dumper::Useqq = 1; $Data::Dumper::Indent = 0; my $schema = DBICTest->init_schema(); @@ -87,7 +85,7 @@ for my $c ( year $c->{sql} )", \@bind, - 'Double condition correctly collapsed for steps' . Dumper \@query_steps, + 'Double condition correctly collapsed for steps' . dump_value \@query_steps, ); } diff --git a/t/sqlmaker/dbihacks_internals.t b/t/sqlmaker/dbihacks_internals.t index cf75a26..4e34f13 100644 --- a/t/sqlmaker/dbihacks_internals.t +++ b/t/sqlmaker/dbihacks_internals.t @@ -8,9 +8,8 @@ use Test::Exception; use DBICTest ':DiffSQL'; -use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION'; +use DBIx::Class::_Util qw( UNRESOLVABLE_CONDITION dump_value ); -use Data::Dumper; BEGIN { if ( eval { require Test::Differences } ) { no warnings 'redefine'; @@ -626,7 +625,7 @@ for my $t (@tests) { ) { die unless Test::Builder->new->is_passing; - my $name = do { local ($Data::Dumper::Indent, $Data::Dumper::Terse, $Data::Dumper::Sortkeys) = (0, 1, 1); Dumper $w }; + my $name = do { local $Data::Dumper::Indent = 0; dump_value $w }; my ($collapsed_cond, $collapsed_cond_as_sql); diff --git a/t/sqlmaker/oracle.t b/t/sqlmaker/oracle.t index 31fc496..0fef7fb 100644 --- a/t/sqlmaker/oracle.t +++ b/t/sqlmaker/oracle.t @@ -6,8 +6,8 @@ use warnings; use Test::More; use Test::Exception; -use Data::Dumper::Concise; +use DBIx::Class::_Util 'dump_value'; use DBICTest ':DiffSQL'; use DBIx::Class::SQLMaker::Oracle; @@ -68,7 +68,7 @@ for my $case (@handle_tests) { sub { ( $stmt, @bind ) = $sqla_oracle->_recurse_where( $case->{connect_by} ); is_same_sql_bind( $stmt, \@bind, $case->{stmt}, $case->{bind},$msg ) - || diag "Search term:\n" . Dumper $case->{connect_by}; + || diag "Search term:\n" . dump_value $case->{connect_by}; } ,sprintf("lives is ok from '%s'",$msg)); } diff --git a/t/sqlmaker/order_by_bindtransport.t b/t/sqlmaker/order_by_bindtransport.t index f99a191..08afe42 100644 --- a/t/sqlmaker/order_by_bindtransport.t +++ b/t/sqlmaker/order_by_bindtransport.t @@ -5,8 +5,8 @@ use warnings; use Test::More; use Test::Exception; -use Data::Dumper::Concise; +use DBIx::Class::_Util 'dump_value'; use DBICTest ':DiffSQL'; sub test_order { @@ -43,7 +43,7 @@ sub test_order { ? map { [ { dbic_colname => $_->[0] } => $_->[1] ] } @{ $args->{bind} } : () ], - ) || diag Dumper $args->{order_by}; + ) || diag dump_value $args->{order_by}; }; } diff --git a/t/storage/base.t b/t/storage/base.t index b4fd789..90cd8f7 100644 --- a/t/storage/base.t +++ b/t/storage/base.t @@ -8,7 +8,7 @@ use Test::Warn; use Test::Exception; use DBICTest; -use Data::Dumper; +use DBIx::Class::_Util 'dump_value'; my $schema = DBICTest->init_schema( sqlite_use_file => 1 ); @@ -157,8 +157,7 @@ for my $type (keys %$invocations) { # we can not use a cloner portably because of the coderef # so compare dumps instead - local $Data::Dumper::Sortkeys = 1; - my $arg_dump = Dumper ($invocations->{$type}{args}); + my $arg_dump = dump_value $invocations->{$type}{args}; warnings_exist ( sub { $storage->connect_info ($invocations->{$type}{args}) }, @@ -166,7 +165,11 @@ for my $type (keys %$invocations) { 'Warned about ignored attributes', ); - is ($arg_dump, Dumper ($invocations->{$type}{args}), "$type didn't modify passed arguments"); + is ( + $arg_dump, + dump_value $invocations->{$type}{args}, + "$type didn't modify passed arguments", + ); is_deeply ($storage->_dbi_connect_info, $invocations->{$type}{dbi_connect_info}, "$type produced correct _dbi_connect_info"); ok ( (not $storage->auto_savepoint and not $storage->unsafe), "$type correctly ignored extra hashref"); diff --git a/t/storage/deprecated_exception_source_bind_attrs.t b/t/storage/deprecated_exception_source_bind_attrs.t index 3a6c2dd..cba18bc 100644 --- a/t/storage/deprecated_exception_source_bind_attrs.t +++ b/t/storage/deprecated_exception_source_bind_attrs.t @@ -13,8 +13,6 @@ use DBICTest; package DBICTest::Legacy::Storage; use base 'DBIx::Class::Storage::DBI::SQLite'; - use Data::Dumper::Concise; - sub source_bind_attributes { return {} } } diff --git a/t/storage/quote_names.t b/t/storage/quote_names.t index ff82d9f..591606c 100644 --- a/t/storage/quote_names.t +++ b/t/storage/quote_names.t @@ -3,10 +3,11 @@ BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) } use strict; use warnings; use Test::More; -use Data::Dumper::Concise; use Try::Tiny; use DBICTest; +use DBIx::Class::_Util 'dump_value'; +$Data::Dumper::Indent = 0; my %expected = ( 'DBIx::Class::Storage::DBI' => @@ -62,7 +63,7 @@ for my $class (keys %expected) { SKIP: { my ($quote_char, $name_sep) = @$mapping{qw/quote_char name_sep/}; my $instance = $class->new; - my $quote_char_text = dumper($quote_char); + my $quote_char_text = dump_value $quote_char; if (exists $mapping->{quote_char}) { is_deeply $instance->sql_quote_char, $quote_char, @@ -122,7 +123,7 @@ for my $db (sort { my ($exp_quote_char, $exp_name_sep) = @{$expected{$dbs{$db}}}{qw/quote_char name_sep/}; - my ($quote_char_text, $name_sep_text) = map { dumper($_) } + my ($quote_char_text, $name_sep_text) = map { dump_value $_ } ($exp_quote_char, $exp_name_sep); is_deeply $sql_maker->quote_char, @@ -148,13 +149,3 @@ for my $db (sort { } done_testing; - -sub dumper { - my $val = shift; - - my $dd = DumperObject; - $dd->Indent(0); - return $dd->Values([ $val ])->Dump; -} - -1;