Revision history for DBIx::Class
* Fixes
+ - Make sure Oracle identifier shortener applies to auto-generated
+ column names, so we stay within the 30-char limit
- Fix a Storage/$dbh leak introduced by th migration to
Try::Tiny (this is *not* a Try::Tiny bug)
- Test suite default on-disk database now checks for Win32
fail-conditions even when running on other OSes
-
0.08122 2010-05-03 17:41 (UTC)
* New Features
- Add DBIx::Class::FilterColumn for non-ref filtering
'Context::Preserve' => '0.01',
'Try::Tiny' => '0.04',
'namespace::clean' => '0.14',
+ 'Math::Base36' => '0.07',
};
# this is so we can order requires alphabetically
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;
);
}
+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 ) = @_;
} elsif (ref $cond eq 'ARRAY') {
return join(' OR ', map { $self->_join_condition($_) } @$cond);
} else {
- die "Can't handle this yet!";
+ croak "Can't handle this yet!";
}
}
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__
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
is( scalar @results, 1, "Group by with limit OK" );
}
+# test identifiers over the 30 char limit
+{
+ lives_ok {
+ my @results = $schema->resultset('CD')->search(undef, {
+ prefetch => 'very_long_artist_relationship',
+ rows => 3,
+ offset => 0,
+ })->all;
+ ok( scalar @results > 0, 'limit with long identifiers returned something');
+ } 'limit with long identifiers executed successfully';
+}
+
# test with_deferred_fk_checks
lives_ok {
$schema->storage->with_deferred_fk_checks(sub {
__PACKAGE__->belongs_to( artist => 'DBICTest::Schema::Artist', undef, {
is_deferrable => 1,
});
+__PACKAGE__->belongs_to( very_long_artist_relationship => 'DBICTest::Schema::Artist', 'artist', {
+ is_deferrable => 1,
+});
# in case this is a single-cd it promotes a track from another cd
__PACKAGE__->belongs_to( single_track => 'DBICTest::Schema::Track', 'single_track',
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",
,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;
use Test::More;
use lib qw(t/lib);
use Scalar::Util; # load before we break require()
+use Carp (); # Carp is not used in the test, but we want to have it loaded for proper %INC comparison
+
+# a dummy test which lazy-loads more modules (so we can compare INC below)
+ok (1);
+
+# record contents of %INC - makes sure there are no extra deps slipping into
+# Opt::Dep.
+my $inc_before = [ keys %INC ];
+ok ( (! grep { $_ =~ m|DBIx/Class| } @$inc_before ), 'Nothing DBIC related is yet loaded');
use_ok 'DBIx::Class::Optional::Dependencies';
+my $inc_after = [ keys %INC ];
+
+is_deeply (
+ [ sort @$inc_after],
+ [ sort (@$inc_before, 'DBIx/Class/Optional/Dependencies.pm') ],
+ 'Nothing loaded other than DBIx::Class::OptDeps',
+);
+
my $sqlt_dep = DBIx::Class::Optional::Dependencies->req_list_for ('deploy');
is_deeply (
[ keys %$sqlt_dep ],
projects / dbsrgits/DBIx-Class.git / commitdiff