X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI%2FSQLite.pm;h=e3099bce7cf7a9296410edada839f8ff564848a2;hb=b95e25c90262dc58ddd27980556164c7df498bba;hp=f77dc4cf48f6c1dd5f0a8fd75bcaa955fca5dd90;hpb=007e35115cb7dd95dd4205cebb4dee1c8af2a744;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm b/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm index f77dc4c..e3099bc 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm @@ -2,15 +2,11 @@ package DBIx::Class::Schema::Loader::DBI::SQLite; use strict; use warnings; -use base qw/ - DBIx::Class::Schema::Loader::DBI::Component::QuotedDefault - DBIx::Class::Schema::Loader::DBI -/; -use Carp::Clan qw/^DBIx::Class/; -use Text::Balanced qw( extract_bracketed ); -use Class::C3; +use base 'DBIx::Class::Schema::Loader::DBI::Component::QuotedDefault'; +use mro 'c3'; +use DBIx::Class::Schema::Loader::Table (); -our $VERSION = '0.07000'; +our $VERSION = '0.07026'; =head1 NAME @@ -40,6 +36,15 @@ sub _setup { if (not defined $self->preserve_case) { $self->preserve_case(0); } + + if ($self->db_schema) { + warn <<'EOF'; +db_schema is not supported on SQLite, the option is implemented only for qualify_objects testing. +EOF + if ($self->db_schema->[0] eq '%') { + $self->db_schema(undef); + } + } } sub rescan { @@ -55,36 +60,42 @@ sub _columns_info_for { my $result = $self->next::method(@_); - my $dbh = $self->schema->storage->dbh; - local $dbh->{FetchHashKeyName} = 'NAME_lc'; - - my $has_autoinc = eval { - my $get_seq = $self->{_cache}{sqlite_sequence} - ||= $dbh->prepare(q{SELECT count(*) FROM sqlite_sequence WHERE name = ?}); - $get_seq->execute($table); - my ($ret) = $get_seq->fetchrow_array; - $get_seq->finish; - $ret; - }; - - if (!$@ && $has_autoinc) { - my $sth = $dbh->prepare( - "pragma table_info(" . $dbh->quote_identifier($table) . ")" - ); - $sth->execute; - my $cols = $sth->fetchall_hashref('name'); + local $self->dbh->{FetchHashKeyName} = 'NAME_lc'; - while (my ($col_name, $info) = each %$result) { - if ($cols->{$col_name}{pk}) { - $info->{is_auto_increment} = 1; - } + my $sth = $self->dbh->prepare( + "pragma table_info(" . $self->dbh->quote_identifier($table) . ")" + ); + $sth->execute; + my $cols = $sth->fetchall_hashref('name'); + + # copy and case according to preserve_case mode + # no need to check for collisions, SQLite does not allow them + my %cols; + while (my ($col, $info) = each %$cols) { + $cols{ $self->_lc($col) } = $info; + } + + my ($num_pk, $pk_col) = (0); + # SQLite doesn't give us the info we need to do this nicely :( + # If there is exactly one column marked PK, and its type is integer, + # set it is_auto_increment. This isn't 100%, but it's better than the + # alternatives. + while (my ($col_name, $info) = each %$result) { + if ($cols{$col_name}{pk}) { + $num_pk++; + if (lc($cols{$col_name}{type}) eq 'integer') { + $pk_col = $col_name; } + } } while (my ($col, $info) = each %$result) { - if (eval { ${ $info->{default_value} } eq 'CURRENT_TIMESTAMP' }) { + if ((eval { ${ $info->{default_value} } }||'') eq 'CURRENT_TIMESTAMP') { ${ $info->{default_value} } = 'current_timestamp'; } + if ($num_pk == 1 and defined $pk_col and $pk_col eq $col) { + $info->{is_auto_increment} = 1; + } } return $result; @@ -93,9 +104,8 @@ sub _columns_info_for { sub _table_fk_info { my ($self, $table) = @_; - my $dbh = $self->schema->storage->dbh; - my $sth = $dbh->prepare( - "pragma foreign_key_list(" . $dbh->quote_identifier($table) . ")" + my $sth = $self->dbh->prepare( + "pragma foreign_key_list(" . $self->dbh->quote_identifier($table) . ")" ); $sth->execute; @@ -104,14 +114,21 @@ sub _table_fk_info { my $rel = $rels[ $fk->{id} ] ||= { local_columns => [], remote_columns => undef, - remote_table => $fk->{table} + remote_table => DBIx::Class::Schema::Loader::Table->new( + loader => $self, + name => $fk->{table}, + ($self->db_schema ? ( + schema => $self->db_schema->[0], + ignore_schema => 1, + ) : ()), + ), }; push @{ $rel->{local_columns} }, $self->_lc($fk->{from}); push @{ $rel->{remote_columns} }, $self->_lc($fk->{to}) if defined $fk->{to}; warn "This is supposed to be the same rel but remote_table changed from ", - $rel->{remote_table}, " to ", $fk->{table} - if $rel->{remote_table} ne $fk->{table}; + $rel->{remote_table}->name, " to ", $fk->{table} + if $rel->{remote_table}->name ne $fk->{table}; } $sth->finish; return \@rels; @@ -120,24 +137,29 @@ sub _table_fk_info { sub _table_uniq_info { my ($self, $table) = @_; - my $dbh = $self->schema->storage->dbh; - my $sth = $dbh->prepare( - "pragma index_list(" . $dbh->quote($table) . ")" + my $sth = $self->dbh->prepare( + "pragma index_list(" . $self->dbh->quote($table) . ")" ); $sth->execute; my @uniqs; while (my $idx = $sth->fetchrow_hashref) { next unless $idx->{unique}; + my $name = $idx->{name}; - my $get_idx_sth = $dbh->prepare("pragma index_info(" . $dbh->quote($name) . ")"); + my $get_idx_sth = $self->dbh->prepare("pragma index_info(" . $self->dbh->quote($name) . ")"); $get_idx_sth->execute; my @cols; while (my $idx_row = $get_idx_sth->fetchrow_hashref) { push @cols, $self->_lc($idx_row->{name}); } $get_idx_sth->finish; + + # Rename because SQLite complains about sqlite_ prefixes on identifiers + # and ignores constraint names in DDL. + $name = (join '_', @cols) . '_unique'; + push @uniqs, [ $name => \@cols ]; } $sth->finish; @@ -147,14 +169,20 @@ sub _table_uniq_info { sub _tables_list { my ($self, $opts) = @_; - my $dbh = $self->schema->storage->dbh; - my $sth = $dbh->prepare("SELECT * FROM sqlite_master"); + my $sth = $self->dbh->prepare("SELECT * FROM sqlite_master"); $sth->execute; my @tables; while ( my $row = $sth->fetchrow_hashref ) { next unless $row->{type} =~ /^(?:table|view)\z/i; next if $row->{tbl_name} =~ /^sqlite_/; - push @tables, $row->{tbl_name}; + push @tables, DBIx::Class::Schema::Loader::Table->new( + loader => $self, + name => $row->{tbl_name}, + ($self->db_schema ? ( + schema => $self->db_schema->[0], + ignore_schema => 1, # for qualify_objects tests + ) : ()), + ); } $sth->finish; return $self->_filter_tables(\@tables, $opts);