From: Rafael Kitover Date: Tue, 5 Jan 2010 12:54:56 +0000 (+0000) Subject: Merge 'oracle_shorten_aliases' into 'trunk' X-Git-Tag: v0.08116~75 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=commitdiff_plain;h=02d9b41a4842cf599a547299986b46ad83adfc1d;hp=918ab8aed49581928f45573c1e14e1264031b1f2 Merge 'oracle_shorten_aliases' into 'trunk' r22328@hlagh (orig r8201): caelum | 2009-12-31 12:29:51 -0500 new branch to fix table aliases in queries over the 30char limit r22329@hlagh (orig r8202): caelum | 2009-12-31 12:55:50 -0500 failing test r22330@hlagh (orig r8203): caelum | 2009-12-31 13:00:35 -0500 switch oracle tests to done_testing() r22331@hlagh (orig r8204): caelum | 2009-12-31 15:02:50 -0500 got something working r22332@hlagh (orig r8205): caelum | 2009-12-31 15:08:30 -0500 POD touchups r22343@hlagh (orig r8216): caelum | 2010-01-01 07:42:03 -0500 fix uninitialized warning and a bug in ResultSet r22419@hlagh (orig r8234): caelum | 2010-01-05 07:53:18 -0500 append half of a base64 MD5 to shortened table aliases for Oracle --- diff --git a/Makefile.PL b/Makefile.PL index c607b11..813b808 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -29,6 +29,9 @@ requires 'Storable' => '0'; # Perl 5.8.0 doesn't have utf8::is_utf8() requires 'Encode' => '0' if ($] <= 5.008000); +# Pre 5.8 does not have Digest::MD5 +requires 'Digest::MD5' => '0' if ($] < 5.007003); + # Dependencies (keep in alphabetical order) requires 'Carp::Clan' => '6.0'; requires 'Class::Accessor::Grouped' => '0.09002'; diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 6af5f63..d3d71d1 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -2522,7 +2522,9 @@ sub related_resultset { my $attrs = $self->_chain_relationship($rel); my $join_count = $attrs->{seen_join}{$rel}; - my $alias = ($join_count > 1 ? join('_', $rel, $join_count) : $rel); + + my $alias = $self->result_source->storage + ->relname_to_table_alias($rel, $join_count); #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi delete @{$attrs}{qw(result_class alias)}; diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index aaa31a3..541aa12 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -1228,7 +1228,9 @@ sub _resolve_join { $force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left'; # the actual seen value will be incremented by the recursion - my $as = ($seen->{$rel} ? join ('_', $rel, $seen->{$rel} + 1) : $rel); + my $as = $self->storage->relname_to_table_alias( + $rel, ($seen->{$rel} && $seen->{$rel} + 1) + ); push @ret, ( $self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left), @@ -1245,7 +1247,9 @@ sub _resolve_join { } else { my $count = ++$seen->{$join}; - my $as = ($count > 1 ? "${join}_${count}" : $join); + my $as = $self->storage->relname_to_table_alias( + $join, ($count > 1 && $count) + ); my $rel_info = $self->relationship_info($join) or $self->throw_exception("No such relationship ${join}"); diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 405041c..2939f4a 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -2510,6 +2510,34 @@ sub lag_behind_master { sub _sqlt_minimum_version { $minimum_sqlt_version }; } +=head2 relname_to_table_alias + +=over 4 + +=item Arguments: $relname, $join_count + +=back + +L uses L names as table aliases in +queries. + +This hook is to allow specific L drivers to change the +way these aliases are named. + +The default behavior is C<"$relname_$join_count" if $join_count > 1>, otherwise +C<"$relname">. + +=cut + +sub relname_to_table_alias { + my ($self, $relname, $join_count) = @_; + + my $alias = ($join_count && $join_count > 1 ? + join('_', $relname, $join_count) : $relname); + + return $alias; +} + sub DESTROY { my $self = shift; diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm index 2b62826..5ed31a0 100644 --- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm @@ -17,7 +17,9 @@ DBIx::Class::Storage::DBI::Oracle::Generic - Oracle Support for DBIx::Class =head1 DESCRIPTION -This class implements autoincrements for Oracle. +This class implements base Oracle support. The subclass +L is for C<(+)> joins in Oracle +versions before 9. =head1 METHODS @@ -274,6 +276,40 @@ sub _svp_rollback { $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name") } +=head2 relname_to_table_alias + +L uses L names as table aliases in +queries. + +Unfortunately, Oracle doesn't support identifiers over 30 chars in length, so +the L name is shortened and appended with half of an +MD5 hash. + +See L. + +=cut + +sub relname_to_table_alias { + my $self = shift; + my ($relname, $join_count) = @_; + + my $alias = $self->next::method(@_); + + return $alias if length($alias) <= 30; + + # get a base64 md5 of the alias with join_count + require Digest::MD5; + my $ctx = Digest::MD5->new; + $ctx->add($alias); + my $md5 = $ctx->b64digest; + + # truncate and prepend to truncated relname without vowels + (my $devoweled = $relname) =~ s/[aeiou]//g; + my $res = substr($devoweled, 0, 18) . '_' . substr($md5, 0, 11); + + return $res; +} + =head1 AUTHOR See L. diff --git a/t/73oracle.t b/t/73oracle.t index bb5a86e..04f1641 100644 --- a/t/73oracle.t +++ b/t/73oracle.t @@ -40,8 +40,6 @@ plan skip_all => 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test. ' as well as following sequences: \'pkid1_seq\', \'pkid2_seq\' and \'nonpkid_seq\'' unless ($dsn && $user && $pass); -plan tests => 36; - DBICTest::Schema->load_classes('ArtistFQN'); my $schema = DBICTest::Schema->connect($dsn, $user, $pass); @@ -65,7 +63,7 @@ $dbh->do("CREATE SEQUENCE pkid2_seq START WITH 10 MAXVALUE 999999 MINVALUE 0"); $dbh->do("CREATE SEQUENCE nonpkid_seq START WITH 20 MAXVALUE 999999 MINVALUE 0"); $dbh->do("CREATE TABLE artist (artistid NUMBER(12), name VARCHAR(255), rank NUMBER(38), charfield VARCHAR2(10))"); $dbh->do("CREATE TABLE sequence_test (pkid1 NUMBER(12), pkid2 NUMBER(12), nonpkid NUMBER(12), name VARCHAR(255))"); -$dbh->do("CREATE TABLE cd (cdid NUMBER(12), artist NUMBER(12), title VARCHAR(255), year VARCHAR(4))"); +$dbh->do("CREATE TABLE cd (cdid NUMBER(12), artist NUMBER(12), title VARCHAR(255), year VARCHAR(4), genreid NUMBER(12), single_track NUMBER(12))"); $dbh->do("CREATE TABLE track (trackid NUMBER(12), cd NUMBER(12), position NUMBER(12), title VARCHAR(255), last_updated_on DATE, last_updated_at DATE, small_dt DATE)"); $dbh->do("ALTER TABLE artist ADD (CONSTRAINT artist_pk PRIMARY KEY (artistid))"); @@ -124,12 +122,39 @@ my $new = $schema->resultset('Artist')->create({ name => 'foo' }); is($new->artistid, 1, "Oracle Auto-PK worked"); my $cd = $schema->resultset('CD')->create({ artist => 1, title => 'EP C', year => '2003' }); -is($new->artistid, 1, "Oracle Auto-PK worked - using scalar ref as table name"); +is($cd->cdid, 1, "Oracle Auto-PK worked - using scalar ref as table name"); # test again with fully-qualified table name $new = $schema->resultset('ArtistFQN')->create( { name => 'bar' } ); is( $new->artistid, 2, "Oracle Auto-PK worked with fully-qualified tablename" ); +# test rel names over the 30 char limit +my $query = $schema->resultset('Artist')->search({ + artistid => 1 +}, { + prefetch => 'cds_very_very_very_long_relationship_name' +}); + +lives_and { + is $query->first->cds_very_very_very_long_relationship_name->first->cdid, 1 +} 'query with rel name over 30 chars survived and worked'; + +# rel name over 30 char limit with user condition +# This requires walking the SQLA data structure. +{ + local $TODO = 'user condition on rel longer than 30 chars'; + + $query = $schema->resultset('Artist')->search({ + 'cds_very_very_very_long_relationship_name.title' => 'EP C' + }, { + prefetch => 'cds_very_very_very_long_relationship_name' + }); + + lives_and { + is $query->first->cds_very_very_very_long_relationship_name->first->cdid, 1 + } 'query with rel name over 30 chars and user condition survived and worked'; +} + # test join with row count ambiguity my $track = $schema->resultset('Track')->create({ trackid => 1, cd => 1, @@ -228,6 +253,8 @@ SKIP: { } } +done_testing; + # clean up our mess END { if($schema && ($dbh = $schema->storage->dbh)) { diff --git a/t/lib/DBICTest/Schema/Artist.pm b/t/lib/DBICTest/Schema/Artist.pm index 4bc0b5c..dd5028e 100644 --- a/t/lib/DBICTest/Schema/Artist.pm +++ b/t/lib/DBICTest/Schema/Artist.pm @@ -44,6 +44,9 @@ __PACKAGE__->has_many( __PACKAGE__->has_many( cds_unordered => 'DBICTest::Schema::CD' ); +__PACKAGE__->has_many( + cds_very_very_very_long_relationship_name => 'DBICTest::Schema::CD' +); __PACKAGE__->has_many( twokeys => 'DBICTest::Schema::TwoKeys' ); __PACKAGE__->has_many( onekeys => 'DBICTest::Schema::OneKey' );