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

caelum at dev.catalyst.perl.org caelum at dev.catalyst.perl.org
Tue Jan 5 12:53:18 GMT 2010


Author: caelum
Date: 2010-01-05 12:53:18 +0000 (Tue, 05 Jan 2010)
New Revision: 8234

Modified:
   DBIx-Class/0.08/branches/oracle_shorten_aliases/Makefile.PL
   DBIx-Class/0.08/branches/oracle_shorten_aliases/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
Log:
append half of a base64 MD5 to shortened table aliases for Oracle

Modified: DBIx-Class/0.08/branches/oracle_shorten_aliases/Makefile.PL
===================================================================
--- DBIx-Class/0.08/branches/oracle_shorten_aliases/Makefile.PL	2010-01-04 11:14:20 UTC (rev 8233)
+++ DBIx-Class/0.08/branches/oracle_shorten_aliases/Makefile.PL	2010-01-05 12:53:18 UTC (rev 8234)
@@ -29,6 +29,9 @@
 # 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';

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	2010-01-04 11:14:20 UTC (rev 8233)
+++ DBIx-Class/0.08/branches/oracle_shorten_aliases/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm	2010-01-05 12:53:18 UTC (rev 8234)
@@ -282,7 +282,8 @@
 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 @@
 
   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;
+  # truncate and prepend to truncated relname without vowels
+  (my $devoweled = $relname) =~ s/[aeiou]//g;
+  my $res = substr($devoweled, 0, 18) . '_' . substr($md5, 0, 11);
 
-  ($alias = $relname) =~ s/[aeiou]//ig;
-  substr($alias, 0, 30 - length($join_count) - 1) = '';
-  $alias .= "_$join_count";
-
-  return $alias;
+  return $res;
 }
 
 =head1 AUTHOR




More information about the Bast-commits mailing list