From: Rafael Kitover <rkitover@cpan.org>
Date: Tue, 5 Jan 2010 12:53:18 +0000 (+0000)
Subject: append half of a base64 MD5 to shortened table aliases for Oracle
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=af0edca1cb4cc086f70fb81e9c1955230346691a;p=dbsrgits%2FDBIx-Class-Historic.git

append half of a base64 MD5 to shortened table aliases for Oracle
---

diff --git a/Makefile.PL b/Makefile.PL
index dd41d6f..c7764c3 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/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
index 3379ffc..5ed31a0 100644
--- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
+++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
@@ -282,7 +282,8 @@ 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
-the L<DBIx::Class::Relationship> name is shortened here if necessary.
+the L<DBIx::Class::Relationship> name is shortened and appended with half of an
+MD5 hash.
 
 See L<DBIx::Class::Storage/"relname_to_table_alias">.
 
@@ -296,15 +297,17 @@ sub relname_to_table_alias {
 
   return $alias if length($alias) <= 30;
 
-  $alias =~ s/[aeiou]//ig;
+  # 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;
 
-  return $alias if length($alias) <= 30;
-
-  ($alias = $relname) =~ s/[aeiou]//ig;
-  substr($alias, 0, 30 - length($join_count) - 1) = '';
-  $alias .= "_$join_count";
+  # 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 $alias;
+  return $res;
 }
 
 =head1 AUTHOR