# 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';
my $attrs = $self->_chain_relationship($rel);
my $join_count = $attrs->{seen_join}{$rel};
- my $alias = ($join_count > 1 ? join('_', $rel, $join_count) : $rel);
+
+ my $alias = $self->result_source->storage
+ ->relname_to_table_alias($rel, $join_count);
#XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi
delete @{$attrs}{qw(result_class alias)};
$force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
# the actual seen value will be incremented by the recursion
- my $as = ($seen->{$rel} ? join ('_', $rel, $seen->{$rel} + 1) : $rel);
+ my $as = $self->storage->relname_to_table_alias(
+ $rel, ($seen->{$rel} && $seen->{$rel} + 1)
+ );
push @ret, (
$self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
}
else {
my $count = ++$seen->{$join};
- my $as = ($count > 1 ? "${join}_${count}" : $join);
+ my $as = $self->storage->relname_to_table_alias(
+ $join, ($count > 1 && $count)
+ );
my $rel_info = $self->relationship_info($join)
or $self->throw_exception("No such relationship ${join}");
sub _sqlt_minimum_version { $minimum_sqlt_version };
}
+=head2 relname_to_table_alias
+
+=over 4
+
+=item Arguments: $relname, $join_count
+
+=back
+
+L<DBIx::Class> uses L<DBIx::Class::Relationship> names as table aliases in
+queries.
+
+This hook is to allow specific L<DBIx::Class::Storage> drivers to change the
+way these aliases are named.
+
+The default behavior is C<"$relname_$join_count" if $join_count > 1>, otherwise
+C<"$relname">.
+
+=cut
+
+sub relname_to_table_alias {
+ my ($self, $relname, $join_count) = @_;
+
+ my $alias = ($join_count && $join_count > 1 ?
+ join('_', $relname, $join_count) : $relname);
+
+ return $alias;
+}
+
sub DESTROY {
my $self = shift;
=head1 DESCRIPTION
-This class implements autoincrements for Oracle.
+This class implements base Oracle support. The subclass
+L<DBIx::Class::Storage::DBI::Oracle::WhereJoins> is for C<(+)> joins in Oracle
+versions before 9.
=head1 METHODS
$self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name")
}
+=head2 relname_to_table_alias
+
+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 and appended with half of an
+MD5 hash.
+
+See L<DBIx::Class::Storage/"relname_to_table_alias">.
+
+=cut
+
+sub relname_to_table_alias {
+ my $self = shift;
+ my ($relname, $join_count) = @_;
+
+ 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;
+
+ # 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 $res;
+}
+
=head1 AUTHOR
See L<DBIx::Class/CONTRIBUTORS>.
' as well as following sequences: \'pkid1_seq\', \'pkid2_seq\' and \'nonpkid_seq\''
unless ($dsn && $user && $pass);
-plan tests => 36;
-
DBICTest::Schema->load_classes('ArtistFQN');
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
$dbh->do("CREATE SEQUENCE nonpkid_seq START WITH 20 MAXVALUE 999999 MINVALUE 0");
$dbh->do("CREATE TABLE artist (artistid NUMBER(12), name VARCHAR(255), rank NUMBER(38), charfield VARCHAR2(10))");
$dbh->do("CREATE TABLE sequence_test (pkid1 NUMBER(12), pkid2 NUMBER(12), nonpkid NUMBER(12), name VARCHAR(255))");
-$dbh->do("CREATE TABLE cd (cdid NUMBER(12), artist NUMBER(12), title VARCHAR(255), year VARCHAR(4))");
+$dbh->do("CREATE TABLE cd (cdid NUMBER(12), artist NUMBER(12), title VARCHAR(255), year VARCHAR(4), genreid NUMBER(12), single_track NUMBER(12))");
$dbh->do("CREATE TABLE track (trackid NUMBER(12), cd NUMBER(12), position NUMBER(12), title VARCHAR(255), last_updated_on DATE, last_updated_at DATE, small_dt DATE)");
$dbh->do("ALTER TABLE artist ADD (CONSTRAINT artist_pk PRIMARY KEY (artistid))");
is($new->artistid, 1, "Oracle Auto-PK worked");
my $cd = $schema->resultset('CD')->create({ artist => 1, title => 'EP C', year => '2003' });
-is($new->artistid, 1, "Oracle Auto-PK worked - using scalar ref as table name");
+is($cd->cdid, 1, "Oracle Auto-PK worked - using scalar ref as table name");
# test again with fully-qualified table name
$new = $schema->resultset('ArtistFQN')->create( { name => 'bar' } );
is( $new->artistid, 2, "Oracle Auto-PK worked with fully-qualified tablename" );
+# test rel names over the 30 char limit
+my $query = $schema->resultset('Artist')->search({
+ artistid => 1
+}, {
+ prefetch => 'cds_very_very_very_long_relationship_name'
+});
+
+lives_and {
+ is $query->first->cds_very_very_very_long_relationship_name->first->cdid, 1
+} 'query with rel name over 30 chars survived and worked';
+
+# rel name over 30 char limit with user condition
+# This requires walking the SQLA data structure.
+{
+ local $TODO = 'user condition on rel longer than 30 chars';
+
+ $query = $schema->resultset('Artist')->search({
+ 'cds_very_very_very_long_relationship_name.title' => 'EP C'
+ }, {
+ prefetch => 'cds_very_very_very_long_relationship_name'
+ });
+
+ lives_and {
+ is $query->first->cds_very_very_very_long_relationship_name->first->cdid, 1
+ } 'query with rel name over 30 chars and user condition survived and worked';
+}
+
# test join with row count ambiguity
my $track = $schema->resultset('Track')->create({ trackid => 1, cd => 1,
}
}
+done_testing;
+
# clean up our mess
END {
if($schema && ($dbh = $schema->storage->dbh)) {
__PACKAGE__->has_many(
cds_unordered => 'DBICTest::Schema::CD'
);
+__PACKAGE__->has_many(
+ cds_very_very_very_long_relationship_name => 'DBICTest::Schema::CD'
+);
__PACKAGE__->has_many( twokeys => 'DBICTest::Schema::TwoKeys' );
__PACKAGE__->has_many( onekeys => 'DBICTest::Schema::OneKey' );
projects / dbsrgits/DBIx-Class.git / commitdiff