From: Peter Rabbitson Date: Fri, 18 Jul 2014 16:11:15 +0000 (+0200) Subject: Add internal assertion guard for some indirect calls (for now only create/new) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=77c3a5dca478801246ff728f80a0c5013e57f4a2;hp=209a20649200c6885697ced98d8499022c2e9eeb;p=dbsrgits%2FDBIx-Class-Historic.git Add internal assertion guard for some indirect calls (for now only create/new) Modeled on the idea of a9da9b6a, this one blows up when a public proxy is called insted of the equivalent public chan of methods This particular set of changes to create() and new() is solely an optimisation (unlike a subsequent commit to ::ResultSourceProxy) --- diff --git a/lib/DBIx/Class/Admin.pm b/lib/DBIx/Class/Admin.pm index 4c7c6bb..003f4ae 100644 --- a/lib/DBIx/Class/Admin.pm +++ b/lib/DBIx/Class/Admin.pm @@ -451,7 +451,7 @@ sub insert { $rs ||= $self->resultset(); $set ||= $self->set(); my $resultset = $self->schema->resultset($rs); - my $obj = $resultset->create( $set ); + my $obj = $resultset->new_result($set)->insert; print ''.ref($resultset).' ID: '.join(',',$obj->id())."\n" if (!$self->quiet); } diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index e81fc82..0262537 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -7,7 +7,7 @@ use DBIx::Class::Carp; use DBIx::Class::ResultSetColumn; use Scalar::Util qw/blessed weaken reftype/; use DBIx::Class::_Util qw( - fail_on_internal_wantarray UNRESOLVABLE_CONDITION + fail_on_internal_wantarray fail_on_internal_call UNRESOLVABLE_CONDITION ); use Try::Tiny; use Data::Compare (); # no imports!!! guard against insane architecture @@ -301,7 +301,11 @@ creation B. See also warning pertaining to L. sub new { my $class = shift; - return $class->new_result(@_) if ref $class; + + if (ref $class) { + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; + return $class->new_result(@_); + } my ($source, $attrs) = @_; $source = $source->resolve @@ -2236,7 +2240,7 @@ sub populate { return unless @$data; if(defined wantarray) { - my @created = map { $self->create($_) } @$data; + my @created = map { $self->new_result($_)->insert } @$data; return wantarray ? @created : \@created; } else { @@ -2272,7 +2276,7 @@ sub populate { foreach my $rel (@rels) { next unless ref $data->[$index]->{$rel} eq "HASH"; - my $result = $self->related_resultset($rel)->create($data->[$index]->{$rel}); + my $result = $self->related_resultset($rel)->new_result($data->[$index]->{$rel})->insert; my (undef, $reverse_relinfo) = %{$rsrc->reverse_relationship_info($rel)}; my $related = $result->result_source->_resolve_condition( $reverse_relinfo->{cond}, @@ -2748,6 +2752,7 @@ L. sub create { #my ($self, $col_data) = @_; + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; return shift->new_result(shift)->insert; } @@ -2830,7 +2835,7 @@ sub find_or_create { if (keys %$hash and my $row = $self->find($hash, $attrs) ) { return $row; } - return $self->create($hash); + return $self->new_result($hash)->insert; } =head2 update_or_create @@ -2900,7 +2905,7 @@ sub update_or_create { return $row; } - return $self->create($cond); + return $self->new_result($cond)->insert; } =head2 update_or_new diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm index 114064a..95adc66 100644 --- a/lib/DBIx/Class/Schema/Versioned.pm +++ b/lib/DBIx/Class/Schema/Versioned.pm @@ -603,7 +603,7 @@ sub _on_connect my $vtable_compat = DBIx::Class::VersionCompat->connect(@$conn_info)->resultset('TableCompat'); if ($self->_source_exists($vtable_compat)) { $self->{vschema}->deploy; - map { $vtable->create({ installed => $_->Installed, version => $_->Version }) } $vtable_compat->all; + map { $vtable->new_result({ installed => $_->Installed, version => $_->Version })->insert } $vtable_compat->all; $self->storage->_get_dbh->do("DROP TABLE " . $vtable_compat->result_source->from); } } @@ -710,7 +710,7 @@ sub _set_db_version { # formatted by this new function will sort _after_ any existing 200... strings. my @tm = gettimeofday(); my @dt = gmtime ($tm[0]); - my $o = $vtable->create({ + my $o = $vtable->new_result({ version => $version, installed => sprintf("v%04d%02d%02d_%02d%02d%02d.%03.0f", $dt[5] + 1900, @@ -721,7 +721,7 @@ sub _set_db_version { $dt[0], int($tm[1] / 1000), # convert to millisecs ), - }); + })->insert; } sub _read_sql_file { diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm index d43d836..5a35ab3 100644 --- a/lib/DBIx/Class/_Util.pm +++ b/lib/DBIx/Class/_Util.pm @@ -30,6 +30,8 @@ BEGIN { ASSERT_NO_INTERNAL_WANTARRAY => $ENV{DBIC_ASSERT_NO_INTERNAL_WANTARRAY} ? 1 : 0, + ASSERT_NO_INTERNAL_INDIRECT_CALLS => $ENV{DBIC_ASSERT_NO_INTERNAL_INDIRECT_CALLS} ? 1 : 0, + IV_SIZE => $Config{ivsize}, OS_NAME => $^O, @@ -55,7 +57,8 @@ use List::Util qw(first); use base 'Exporter'; our @EXPORT_OK = qw( - sigwarn_silencer modver_gt_or_eq fail_on_internal_wantarray + sigwarn_silencer modver_gt_or_eq + fail_on_internal_wantarray fail_on_internal_call refdesc refcount hrefaddr is_exception UNRESOLVABLE_CONDITION ); @@ -218,4 +221,33 @@ sub modver_gt_or_eq ($$) { } } +sub fail_on_internal_call { + my ($fr, $argdesc); + { + package DB; + $fr = [ caller(1) ]; + $argdesc = ref $DB::args[0] + ? DBIx::Class::_Util::refdesc($DB::args[0]) + : undef + ; + }; + + if ( + $argdesc + and + $fr->[0] =~ /^(?:DBIx::Class|DBICx::)/ + and + $fr->[1] !~ /\b(?:CDBICompat|ResultSetProxy)\b/ # no point touching there + ) { + DBIx::Class::Exception->throw( sprintf ( + "Illegal internal call of indirect proxy-method %s() with argument %s: examine the last lines of the proxy method deparse below to determine what to call directly instead at %s on line %d\n\n%s\n\n Stacktrace starts", + $fr->[3], $argdesc, @{$fr}[1,2], ( $fr->[6] || do { + require B::Deparse; + no strict 'refs'; + B::Deparse->new->coderef2text(\&{$fr->[3]}) + }), + ), 'with_stacktrace'); + } +} + 1;