Factor out the oracle shortener code, and apply it to both

the storage and the sqlahacks

diff --git a/Makefile.PL b/Makefile.PL
index 7546d87..5b493d2 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -61,6 +61,7 @@ my $runtime_requires = {
   'Context::Preserve'        => '0.01',
   'Try::Tiny'                => '0.04',
   'namespace::clean'         => '0.14',
+  'Math::Base36'             => '0.07',
 };
 
 # this is so we can order requires alphabetically

diff --git a/lib/DBIx/Class/SQLAHacks.pm b/lib/DBIx/Class/SQLAHacks.pm
index c3a3f0d..68566f3 100644 (file)
--- a/lib/DBIx/Class/SQLAHacks.pm
+++ b/lib/DBIx/Class/SQLAHacks.pm
@@ -123,7 +123,7 @@ sub _subqueried_limit_attrs {
   my (@in_sel, @out_sel, %renamed);
   for my $node (@sel) {
     if (first { $_ =~ / (?<! $re_alias ) $re_sep /x } ($node->{as}, $node->{unquoted_sql}) )  {
-      $node->{as} =~ s/ $re_sep /__/xg;
+      $node->{as} = $self->_unqualify_colname($node->{as});
       my $quoted_as = $self->_quote($node->{as});
       push @in_sel, sprintf '%s AS %s', $node->{sql}, $quoted_as;
       push @out_sel, $quoted_as;
@@ -159,6 +159,13 @@ sub _subqueried_limit_attrs {
   );
 }
 
+sub _unqualify_colname {
+  my ($self, $fqcn) = @_;
+  my $re_sep = quotemeta($self->name_sep || '.');
+  $fqcn =~ s/ $re_sep /__/xg;
+  return $fqcn;
+}
+
 # ANSI standard Limit/Offset implementation. DB2 and MSSQL >= 2005 use this
 sub _RowNumberOver {
   my ($self, $sql, $rs_attrs, $rows, $offset ) = @_;

diff --git a/lib/DBIx/Class/SQLAHacks/Oracle.pm b/lib/DBIx/Class/SQLAHacks/Oracle.pm
index 4274939..3e55622 100644 (file)
--- a/lib/DBIx/Class/SQLAHacks/Oracle.pm
+++ b/lib/DBIx/Class/SQLAHacks/Oracle.pm
@@ -102,6 +102,87 @@ sub _where_field_PRIOR {
   return ($sql, @bind);
 }
 
+# this takes an identifier and shortens it if necessary
+# optionally keywords can be passed as an arrayref to generate useful
+# identifiers
+sub _shorten_identifier {
+  my ($self, $to_shorten, $keywords) = @_;
+
+  # 30 characters is the identifier limit for Oracle
+  my $max_len = 30;
+  # we want at least 10 characters of the base36 md5
+  my $min_entropy = 10;
+
+  my $max_trunc = $max_len - $min_entropy - 1;
+
+  return $to_shorten
+    if length($to_shorten) <= $max_len;
+
+  croak 'keywords needs to be an arrayref'
+    if defined $keywords && ref $keywords ne 'ARRAY';
+
+  # if no keywords are passed use the identifier as one
+  my @keywords = @{$keywords || []};
+  @keywords = $to_shorten unless @keywords;
+
+  # get a base36 md5 of the identifier
+  require Digest::MD5;
+  require Math::BigInt;
+  require Math::Base36;
+  my $b36sum = Math::Base36::encode_base36(
+    Math::BigInt->from_hex (
+      '0x' . Digest::MD5::md5_hex ($to_shorten)
+    )
+  );
+
+  # switch from perl to java
+  # get run-length
+  my ($concat_len, @lengths);
+  for (@keywords) {
+    $_ = ucfirst (lc ($_));
+    $_ =~ s/\_+(\w)/uc ($1)/eg;
+
+    push @lengths, length ($_);
+    $concat_len += $lengths[-1];
+  }
+
+  # if we are still too long - try to disemvowel non-capitals (not keyword starts)
+  if ($concat_len > $max_trunc) {
+    $concat_len = 0;
+    @lengths = ();
+
+    for (@keywords) {
+      $_ =~ s/[aeiou]//g;
+
+      push @lengths, length ($_);
+      $concat_len += $lengths[-1];
+    }
+  }
+
+  # still too long - just start cuting proportionally
+  if ($concat_len > $max_trunc) {
+    my $trim_ratio = $max_trunc / $concat_len;
+
+    for my $i (0 .. $#keywords) {
+      $keywords[$i] = substr ($keywords[$i], 0, int ($trim_ratio * $lengths[$i] ) );
+    }
+  }
+
+  my $fin = join ('', @keywords);
+  my $fin_len = length $fin;
+
+  return sprintf ('%s_%s',
+    $fin,
+    substr ($b36sum, 0, $max_len - $fin_len - 1),
+  );
+}
+
+sub _unqualify_colname {
+  my ($self, $fqcn) = @_;
+
+  return $self->_shorten_identifier($self->next::method($fqcn));
+}
+
 1;
 
 __END__

diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
index 1c3157c..ab2678e 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
+++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
@@ -366,25 +366,7 @@ sub relname_to_table_alias {
 
   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;
-
-  # remove alignment mark just in case
-  $md5 =~ s/=*\z//;
-
-  # truncate and prepend to truncated relname without vowels
-  (my $devoweled = $relname) =~ s/[aeiou]//g;
-  my $shortened = substr($devoweled, 0, 18);
-
-  my $new_alias =
-    $shortened . '_' . substr($md5, 0, 30 - length($shortened) - 1);
-
-  return $new_alias;
+  return $self->sql_maker->_shorten_identifier($alias, [$relname]);
 }
 
 =head2 with_deferred_fk_checks

diff --git a/t/sqlahacks/oracle.t b/t/sqlahacks/oracle.t
index fdcfaca..67a908e 100644 (file)
--- a/t/sqlahacks/oracle.t
+++ b/t/sqlahacks/oracle.t
@@ -56,8 +56,6 @@ my $sqla_oracle = DBIx::Class::SQLAHacks::Oracle->new( quote_char => '"', name_s
 isa_ok($sqla_oracle, 'DBIx::Class::SQLAHacks::Oracle');
 
 
-my $test_count = ( @handle_tests * 2 ) + 1;
-
 for my $case (@handle_tests) {
     my ( $stmt, @bind );
     my $msg = sprintf("Offline: %s",
@@ -72,9 +70,39 @@ for my $case (@handle_tests) {
     ,sprintf("lives is ok from '%s'",$msg));
 }
 
-# 
-#   Online Tests?
-# 
-$test_count += 0;
+is (
+  $sqla_oracle->_shorten_identifier('short_id'),
+  'short_id',
+  '_shorten_identifier for short id without keywords ok'
+);
+
+is (
+  $sqla_oracle->_shorten_identifier('short_id', [qw/ foo /]),
+  'short_id',
+  '_shorten_identifier for short id with one keyword ok'
+);
+
+is (
+  $sqla_oracle->_shorten_identifier('short_id', [qw/ foo bar baz /]),
+  'short_id',
+  '_shorten_identifier for short id with keywords ok'
+);
+
+is (
+  $sqla_oracle->_shorten_identifier('very_long_identifier_which_exceeds_the_30char_limit'),
+  'VryLngIdntfrWhchExc_72M8CIDTM7',
+  '_shorten_identifier without keywords ok',
+);
+
+is (
+  $sqla_oracle->_shorten_identifier('very_long_identifier_which_exceeds_the_30char_limit',[qw/ foo /]),
+  'Foo_72M8CIDTM7KBAUPXG48B22P4E',
+  '_shorten_identifier with one keyword ok',
+);
+is (
+  $sqla_oracle->_shorten_identifier('very_long_identifier_which_exceeds_the_30char_limit',[qw/ foo bar baz /]),
+  'FooBarBaz_72M8CIDTM7KBAUPXG48B',
+  '_shorten_identifier with keywords ok',
+);
 
-done_testing( $test_count );
+done_testing;