[Bast-commits] r8204 - in DBIx-Class/0.08/branches/oracle_shorten_aliases: lib/DBIx/Class lib/DBIx/Class/Storage lib/DBIx/Class/Storage/DBI/Oracle t

caelum at dev.catalyst.perl.org caelum at dev.catalyst.perl.org
Thu Dec 31 20:02:52 GMT 2009


Author: caelum
Date: 2009-12-31 20:02:50 +0000 (Thu, 31 Dec 2009)
New Revision: 8204

Modified:
   DBIx-Class/0.08/branches/oracle_shorten_aliases/lib/DBIx/Class/ResultSet.pm
   DBIx-Class/0.08/branches/oracle_shorten_aliases/lib/DBIx/Class/ResultSource.pm
   DBIx-Class/0.08/branches/oracle_shorten_aliases/lib/DBIx/Class/Storage/DBI.pm
   DBIx-Class/0.08/branches/oracle_shorten_aliases/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
   DBIx-Class/0.08/branches/oracle_shorten_aliases/t/73oracle.t
Log:
got something working

Modified: DBIx-Class/0.08/branches/oracle_shorten_aliases/lib/DBIx/Class/ResultSet.pm
===================================================================
--- DBIx-Class/0.08/branches/oracle_shorten_aliases/lib/DBIx/Class/ResultSet.pm	2009-12-31 18:00:35 UTC (rev 8203)
+++ DBIx-Class/0.08/branches/oracle_shorten_aliases/lib/DBIx/Class/ResultSet.pm	2009-12-31 20:02:50 UTC (rev 8204)
@@ -2522,8 +2522,9 @@
     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->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)};
 

Modified: DBIx-Class/0.08/branches/oracle_shorten_aliases/lib/DBIx/Class/ResultSource.pm
===================================================================
--- DBIx-Class/0.08/branches/oracle_shorten_aliases/lib/DBIx/Class/ResultSource.pm	2009-12-31 18:00:35 UTC (rev 8203)
+++ DBIx-Class/0.08/branches/oracle_shorten_aliases/lib/DBIx/Class/ResultSource.pm	2009-12-31 20:02:50 UTC (rev 8204)
@@ -1228,7 +1228,9 @@
       $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 @@
   }
   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}");

Modified: DBIx-Class/0.08/branches/oracle_shorten_aliases/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
===================================================================
--- DBIx-Class/0.08/branches/oracle_shorten_aliases/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm	2009-12-31 18:00:35 UTC (rev 8203)
+++ DBIx-Class/0.08/branches/oracle_shorten_aliases/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm	2009-12-31 20:02:50 UTC (rev 8204)
@@ -17,7 +17,9 @@
 
 =head1 DESCRIPTION
 
-This class implements autoincrements for Oracle.
+This class implements base Oracle support. The subclass
+L<DBIx::Class::Storage::DBI::Oracle::WhereJoins> is for C<(+)> joins in Oracle
+versions before 9.
 
 =head1 METHODS
 
@@ -274,6 +276,37 @@
     $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name")
 }
 
+=head2 relname_to_table_alias
+
+L<DBIx::Class> uses L<DBIx::Class::Relationship> names as table aliases in
+queries.
+
+Unfortunately, Oracle doesn't support identifiers over 30 chars in length, so
+if the L<DBIx::Class::Relationship> name is shortened here if necessary.
+
+See L<DBIx::Class::Storage/"relname_to_table_alias">.
+
+=cut
+
+sub relname_to_table_alias {
+  my $self = shift;
+  my ($relname, $join_count) = @_;
+
+  my $alias = $self->next::method(@_);
+
+  return $alias if length($alias) <= 30;
+
+  $alias =~ s/[aeiou]//ig;
+
+  return $alias if length($alias) <= 30;
+
+  ($alias = $relname) =~ s/[aeiou]//ig;
+  substr($alias, 0, 30 - length($join_count) - 1) = '';
+  $alias .= "_$join_count";
+
+  return $alias;
+}
+
 =head1 AUTHOR
 
 See L<DBIx::Class/CONTRIBUTORS>.

Modified: DBIx-Class/0.08/branches/oracle_shorten_aliases/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/oracle_shorten_aliases/lib/DBIx/Class/Storage/DBI.pm	2009-12-31 18:00:35 UTC (rev 8203)
+++ DBIx-Class/0.08/branches/oracle_shorten_aliases/lib/DBIx/Class/Storage/DBI.pm	2009-12-31 20:02:50 UTC (rev 8204)
@@ -2510,6 +2510,30 @@
   sub _sqlt_minimum_version { $minimum_sqlt_version };
 }
 
+=head2 relname_to_table_alias
+
+=over 4
+
+=item Arguments: $relname, $join_count
+
+=back
+
+L<DBIx::Class> uses L<DBIx::Class::Relationship> names as table aliases in
+queries.
+
+This hook is to allow specific C<Storage> drivers to change the way these
+aliases are named.
+
+=cut
+
+sub relname_to_table_alias {
+  my ($self, $relname, $join_count) = @_;
+
+  my $alias = ($join_count > 1 ? join('_', $relname, $join_count) : $relname);
+
+  return $alias;
+}
+
 sub DESTROY {
   my $self = shift;
 

Modified: DBIx-Class/0.08/branches/oracle_shorten_aliases/t/73oracle.t
===================================================================
--- DBIx-Class/0.08/branches/oracle_shorten_aliases/t/73oracle.t	2009-12-31 18:00:35 UTC (rev 8203)
+++ DBIx-Class/0.08/branches/oracle_shorten_aliases/t/73oracle.t	2009-12-31 20:02:50 UTC (rev 8204)
@@ -63,7 +63,7 @@
 $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))");
@@ -130,15 +130,31 @@
 
 # test rel names over the 30 char limit
 my $query = $schema->resultset('Artist')->search({
-  'cds_very_very_very_long_relationship_name.title' => 'EP C'
+  artistid => 1 
 }, {
   prefetch => 'cds_very_very_very_long_relationship_name'
 });
 
 lives_and {
-  is $query->first->cds_very_very_very_long_relationship_name->cdid, 1
+  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,




More information about the Bast-commits mailing list