coderef, allowing better intergration with Catalyst
- Fixed a complex prefetch + regular join regression introduced
in 0.08108
+ - Fixed insert_bulk rebless handling
- SQLT related fixes:
- sqlt_type is now called on the correct storage object
- hooks can now see the correct producer_type
'Hash::Merge', => '0.11',
);
-my $sqlt_recommends = '0.09004';
+# when changing also adjust $DBIx::Class::minimum_sqlt_version
+my $sqlt_recommends = '0.11002';
recommends 'SQL::Translator' => $sqlt_recommends;
$VERSION = eval $VERSION; # numify for warning-free dev releases
+# what version of sqlt do we require if deploy() without a ddl_dir is invoked
+# when changing also adjust $sqlt_recommends in Makefile.PL
+my $minimum_sqlt_version = '0.11002';
+
sub MODIFY_CODE_ATTRIBUTES {
my ($class,$code,@attrs) = @_;
$class->mk_classdata('__attr_cache' => {})
return $@ ? $cache : { %$cache, %$rest };
}
+# SQLT version handling
+{
+ my $_sqlt_version_ok; # private
+ my $_sqlt_version_error; # private
+
+ sub _sqlt_version_ok {
+ if (!defined $_sqlt_version_ok) {
+ eval "use SQL::Translator $minimum_sqlt_version";
+ if ($@) {
+ $_sqlt_version_ok = 0;
+ $_sqlt_version_error = $@;
+ }
+ else {
+ $_sqlt_version_ok = 1;
+ }
+ }
+ return $_sqlt_version_ok;
+ }
+
+ sub _sqlt_version_error {
+ shift->_sqlt_version_ok unless defined $_sqlt_version_ok;
+ return $_sqlt_version_error;
+ }
+
+ sub _sqlt_minimum_version { $minimum_sqlt_version };
+}
+
+
1;
=head1 NAME
L<DBIx::Class::Manual::DocMap> lists each task you might want help on, and
the modules where you will find documentation.
+=head1 COPYRIGHT
+
+Copyright (c) 2005 - 2009 the DBIx::Class L</AUTHOR> and L</CONTRIBUTORS>
+as listed below.
+
=head1 AUTHOR
mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
=head1 LICENSE
-You may distribute this code under the same terms as Perl itself.
+This library is free software and may be distributed under the same terms
+as perl itself.
=cut
if ( $attrs->{join} || $attrs->{prefetch} ) {
- $self->throw_exception ('join/prefetch can not be used with a literal scalarref {from}')
+ $self->throw_exception ('join/prefetch can not be used with a custom {from}')
if ref $attrs->{from} ne 'ARRAY';
my $join = delete $attrs->{join} || {};
sub _calculate_score {
my ($self, $a, $b) = @_;
+ if (defined $a xor defined $b) {
+ return 0;
+ }
+ elsif (not defined $a) {
+ return 1;
+ }
+
if (ref $b eq 'HASH') {
my ($b_key) = keys %{$b};
if (ref $a eq 'HASH') {
my $type;
if ($force_left) {
$type = 'left';
- } else {
- $type = $rel_info->{attrs}{join_type} || '';
- $force_left = 1 if lc($type) eq 'left';
+ }
+ else {
+ $type = $rel_info->{attrs}{join_type};
+ $force_left = 1 if lc($type||'') eq 'left';
}
my $rel_src = $self->related_source($join);
foreach my $j (@join) {
my ($to, $on) = @$j;
+
# check whether a join type exists
- my $join_clause = '';
my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
- if (ref($to_jt) eq 'HASH' and exists($to_jt->{-join_type})) {
- $join_clause = ' '.uc($to_jt->{-join_type}).' JOIN ';
- } else {
- $join_clause = ' JOIN ';
+ my $join_type;
+ if (ref($to_jt) eq 'HASH' and defined($to_jt->{-join_type})) {
+ $join_type = $to_jt->{-join_type};
+ $join_type =~ s/^\s+ | \s+$//xg;
}
- push(@sqlf, $join_clause);
+
+ $join_type = $self->{_default_jointype} if not defined $join_type;
+
+ my $join_clause = sprintf ('%s JOIN ',
+ $join_type ? ' ' . uc($join_type) : ''
+ );
+ push @sqlf, $join_clause;
if (ref $to eq 'ARRAY') {
push(@sqlf, '(', $self->_recurse_from(@$to), ')');
return;
}
- eval 'require SQL::Translator "0.09003"';
- if ($@) {
- $self->throw_exception("SQL::Translator 0.09003 required");
- }
+ $self->throw_exception($self->_sqlt_version_error)
+ if (not $self->_sqlt_version_ok);
my $db_tr = SQL::Translator->new({
add_drop_table => 1,
## only prepped once.
sub insert_bulk {
my ($self, $source, $cols, $data) = @_;
+
+# redispatch to insert_bulk method of storage we reblessed into, if necessary
+ if (not $self->_driver_determined) {
+ $self->_determine_driver;
+ goto $self->can('insert_bulk');
+ }
+
my %colvalues;
my $table = $source->from;
@colvalues{@$cols} = (0..$#$cols);
my ($sql, @bind) = $self->sql_maker->insert($table, \%colvalues);
- $self->_determine_driver;
-
$self->_query_start( $sql, @bind );
my $sth = $self->sth($sql);
%{$sqltargs || {}}
};
- $self->throw_exception(q{Can't create a ddl file without SQL::Translator 0.09003: '}
- . $self->_check_sqlt_message . q{'})
- if !$self->_check_sqlt_version;
+ $self->throw_exception("Can't create a ddl file without SQL::Translator: " . $self->_sqlt_version_error)
+ if !$self->_sqlt_version_ok;
my $sqlt = SQL::Translator->new( $sqltargs );
return join('', @rows);
}
- $self->throw_exception(q{Can't deploy without SQL::Translator 0.09003: '}
- . $self->_check_sqlt_message . q{'})
- if !$self->_check_sqlt_version;
+ $self->throw_exception("Can't deploy without either SQL::Translator or a ddl_dir: " . $self->_sqlt_version_error )
+ if !$self->_sqlt_version_ok;
# sources needs to be a parser arg, but for simplicty allow at top level
# coming in
return $type;
}
-{
- my $_check_sqlt_version; # private
- my $_check_sqlt_message; # private
- sub _check_sqlt_version {
- return $_check_sqlt_version if defined $_check_sqlt_version;
- eval 'use SQL::Translator "0.09003"';
- $_check_sqlt_message = $@ || '';
- $_check_sqlt_version = !$@;
- }
-
- sub _check_sqlt_message {
- _check_sqlt_version if !defined $_check_sqlt_message;
- $_check_sqlt_message;
- }
-}
=head2 is_replicating
=head1 IMPLEMENTATION NOTES
+=head2 IDENTITY information
+
Microsoft SQL Server supports three methods of retrieving the IDENTITY
value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
SCOPE_IDENTITY is used here because it is the safest. However, it must
inserts into another table with an identity will give erroneous results on
recent versions of SQL Server.
+=head2 bulk_insert
+
+Be aware that we have tried to make things as simple as possible for our users.
+For MSSQL that means that when a user tries to do a populate/bulk_insert which
+includes an autoincrementing column, we will try to tell the database to allow
+the insertion of the autoinc column. But the user must have the db_ddladmin
+role membership, otherwise you will get a fairly opaque error message.
+
=head1 AUTHOR
See L<DBIx::Class/CONTRIBUTORS>.
$dbh->{mysql_insertid};
}
+# we need to figure out what mysql version we're running
+sub sql_maker {
+ my $self = shift;
+
+ unless ($self->_sql_maker) {
+ my $maker = $self->next::method (@_);
+
+ # mysql 3 does not understand a bare JOIN
+ my $mysql_ver = $self->_get_dbh->get_info(18);
+ $maker->{_default_jointype} = 'INNER' if $mysql_ver =~ /^3/;
+ }
+
+ return $self->_sql_maker;
+}
+
sub sqlt_type {
return 'MySQL';
}
use lib qw(t/lib);
use DBICTest;
use DBI::Const::GetInfoType;
+use DBIC::SqlMakerTest;
my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MYSQL_${_}" } qw/DSN USER PASS/};
plan skip_all => 'Set $ENV{DBICTEST_MYSQL_DSN}, _USER and _PASS to run this test'
unless ($dsn && $user);
-plan tests => 19;
-
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
my $dbh = $schema->storage->dbh;
my $type_info = $schema->storage->columns_info_for('artist');
is_deeply($type_info, $test_type_info, 'columns_info_for - column data types');
+
+
}
my $cd = $schema->resultset ('CD')->create ({});
my $producer = $schema->resultset ('Producer')->create ({});
lives_ok { $cd->set_producers ([ $producer ]) } 'set_relationship doesnt die';
+{
+ my $artist = $schema->resultset('Artist')->next;
+ my $cd = $schema->resultset('CD')->next;
+ $cd->set_from_related ('artist', $artist);
+ $cd->update;
+
+ my $rs = $schema->resultset('CD')->search ({}, { prefetch => 'artist' });
+
+ lives_ok sub {
+ my $cd = $rs->next;
+ is ($cd->artist->name, $artist->name, 'Prefetched artist');
+ }, 'join does not throw (mysql 3 test)';
+
+ # induce a jointype override, make sure it works even if we don't have mysql3
+ local $schema->storage->sql_maker->{_default_jointype} = 'inner';
+ is_same_sql_bind (
+ $rs->as_query,
+ '(
+ SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track,
+ artist.artistid, artist.name, artist.rank, artist.charfield
+ FROM cd me
+ INNER JOIN artist artist ON artist.artistid = me.artist
+ )',
+ [],
+ 'overriden default join type works',
+ );
+}
## Can we properly deal with the null search problem?
##
is $artist => undef
=> 'Nothing Found!';
}
+
+done_testing;
### auto-pk / last_insert_id / sequence discovery
{
+ local $SIG{__WARN__} = sub {};
+ _cleanup ($schema);
$schema->source("Artist")->name("testschema.artist");
my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 });
is($st->pkid1, 55, "Oracle Auto-PK without trigger: First primary key set manually");
-drop_test_schema($dbh);
-done_testing;
+sub _cleanup {
+ my $schema = shift or return;
+ local $SIG{__WARN__} = sub {};
exit;
END { drop_test_schema($dbh) }
return unless $dbh->ping;
for my $stat (
- 'DROP TABLE unq_nextval_schema2.artist',
- 'DROP SCHEMA unq_nextval_schema2',
- 'DROP SEQUENCE public.artist_artistid_seq',
- 'DROP TABLE unq_nextval_schema.artist',
- 'DROP SCHEMA unq_nextval_schema',
- 'DROP TABLE testschema.artist',
- 'DROP TABLE testschema.casecheck',
- 'DROP TABLE testschema.sequence_test',
- 'DROP TABLE testschema.array_test',
+ 'DROP SCHEMA testschema CASCADE',
+ 'DROP SCHEMA anothertestschema CASCADE',
+ 'DROP SCHEMA yetanothertestschema CASCADE',
'DROP SEQUENCE pkid1_seq',
'DROP SEQUENCE pkid2_seq',
'DROP SEQUENCE nonpkid_seq',
- 'DROP SCHEMA testschema',
- 'DROP TABLE anothertestschema.artist',
- 'DROP SCHEMA anothertestschema',
- 'DROP TABLE yetanothertestschema.artist',
- 'DROP SCHEMA yetanothertestschema',
) {
- eval { $dbh->do ($stat) };
+ eval { $schema->storage->_do_query ($stat) };
diag $@ if $@ && !$no_warn;
}
}
+done_testing;
+
+END { _cleanup($schema) }
});
lives_ok ( sub {
+ # start a new connection, make sure rebless works
+ my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
$schema->populate ('Owners', [
[qw/id name /],
[qw/1 wiggle/],
}, 'populate with PKs supplied ok' );
lives_ok ( sub {
+ # start a new connection, make sure rebless works
+ my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
$schema->populate ('BooksInLibrary', [
[qw/source owner title /],
[qw/Library 1 secrets0/],
use lib qw(t/lib);
use DBICTest;
-eval "use SQL::Translator";
-plan skip_all => 'SQL::Translator required' if $@;
+BEGIN {
+ require DBIx::Class;
+ plan skip_all =>
+ 'Test needs SQL::Translator ' . DBIx::Class->_sqlt_minimum_version
+ if not DBIx::Class->_sqlt_version_ok;
+}
my $schema = DBICTest->init_schema (no_deploy => 1);
#!/usr/bin/perl
+
use strict;
use warnings;
use Test::More;
plan skip_all => 'Set $ENV{DBICTEST_MYSQL_DSN}, _USER and _PASS to run this test'
unless ($dsn);
-
- eval "use DBD::mysql; use SQL::Translator 0.09003;";
- plan $@
- ? ( skip_all => 'needs DBD::mysql and SQL::Translator 0.09003 for testing' )
- : ( tests => 22 );
+ require DBIx::Class;
+ plan skip_all =>
+ 'Test needs SQL::Translator ' . DBIx::Class->_sqlt_minimum_version
+ if not DBIx::Class->_sqlt_version_ok;
}
my $version_table_name = 'dbix_class_schema_versions';
unless ($ENV{DBICTEST_KEEP_VERSIONING_DDL}) {
unlink $_ for (values %$fn);
}
+
+done_testing;
use lib qw(t/lib);
use DBICTest;
-
BEGIN {
- eval "use SQL::Translator 0.09003;";
- if ($@) {
- plan skip_all => 'needs SQL::Translator 0.09003 for testing';
- }
+ require DBIx::Class;
+ plan skip_all =>
+ 'Test needs SQL::Translator ' . DBIx::Class->_sqlt_minimum_version
+ if not DBIx::Class->_sqlt_version_ok;
}
my $schema = DBICTest->init_schema();
$schema->sources
;
-plan tests => ( @sources * 3);
-
{
my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { } } });
}
}
+done_testing;
+
sub create_schema {
my $args = shift;
projects / dbsrgits/DBIx-Class.git / commitdiff