From: Alexander Hartmaier Date: Thu, 10 Jun 2010 12:57:07 +0000 (+0200) Subject: Factor out the oracle shortener code, and apply it to both X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=63ca94e17632a42875a93d2c7333f9cdc2a7dfd7;p=dbsrgits%2FDBIx-Class-Historic.git 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 --- 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 --- 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 { $_ =~ / (?{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 --- 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 --- 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 --- 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;