X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI%2FSQLite.pm;h=347f9529ea59b8ac76e5ac8bcf008af361e2058a;hb=fdd8ff1628c48e9c540958039b5bc1f490af8d88;hp=10af19b9c911788b7097e967a42ec278e9357f02;hpb=7e6d4a22657f67cd655181f7a1a686f416e8e71f;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 10af19b..347f952 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/SQLite.pm @@ -7,6 +7,8 @@ use Carp::Clan qw/^DBIx::Class/; use Text::Balanced qw( extract_bracketed ); use Class::C3; +our $VERSION = '0.04999_11'; + =head1 NAME DBIx::Class::Schema::Loader::DBI::SQLite - DBIx::Class::Schema::Loader::DBI SQLite Implementation. @@ -16,7 +18,7 @@ DBIx::Class::Schema::Loader::DBI::SQLite - DBIx::Class::Schema::Loader::DBI SQLi package My::Schema; use base qw/DBIx::Class::Schema::Loader/; - __PACKAGE__->loader_optoins( relationships => 1 ); + __PACKAGE__->loader_options( debug => 1 ); 1; @@ -24,14 +26,33 @@ DBIx::Class::Schema::Loader::DBI::SQLite - DBIx::Class::Schema::Loader::DBI SQLi See L. +=head1 METHODS + +=head2 rescan + +SQLite will fail all further commands on a connection if the +underlying schema has been modified. Therefore, any runtime +changes requiring C also require us to re-connect +to the database. The C method here handles that +reconnection for you, but beware that this must occur for +any other open sqlite connections as well. + =cut +sub rescan { + my ($self, $schema) = @_; + + $schema->storage->disconnect if $schema->storage; + $self->next::method($schema); +} + # XXX this really needs a re-factor sub _sqlite_parse_table { my ($self, $table) = @_; my @rels; my @uniqs; + my %auto_inc; my $dbh = $self->schema->storage->dbh; my $sth = $self->{_cache}->{sqlite_master} @@ -42,7 +63,7 @@ sub _sqlite_parse_table { $sth->finish; # Cut "CREATE TABLE ( )" blabla... - $sql =~ /^[\w\s]+\((.*)\)$/si; + $sql =~ /^[\w\s']+\((.*)\)$/si; my $cols = $1; # strip single-line comments @@ -90,6 +111,11 @@ sub _sqlite_parse_table { push(@uniqs, [ $name => \@cols ]); } + if ($col =~ /AUTOINCREMENT/i) { + $col =~ /^(\S+)/; + $auto_inc{lc $1} = 1; + } + next if $col !~ /^(.*\S)\s+REFERENCES\s+(\w+) (?: \s* \( (.*) \) )? /ix; my ($cols, $f_table, $f_cols) = ($1, $2, $3); @@ -117,7 +143,22 @@ sub _sqlite_parse_table { }); } - return { rels => \@rels, uniqs => \@uniqs }; + return { rels => \@rels, uniqs => \@uniqs, auto_inc => \%auto_inc }; +} + +sub _extra_column_info { + my ($self, $table, $col_name, $sth, $col_num) = @_; + ($table, $col_name) = @{$table}{qw/TABLE_NAME COLUMN_NAME/} if ref $table; + my %extra_info; + + $self->{_sqlite_parse_data}->{$table} ||= + $self->_sqlite_parse_table($table); + + if ($self->{_sqlite_parse_data}->{$table}->{auto_inc}->{$col_name}) { + $extra_info{is_auto_increment} = 1; + } + + return \%extra_info; } sub _table_fk_info { @@ -147,8 +188,10 @@ sub _tables_list { my @tables; while ( my $row = $sth->fetchrow_hashref ) { next unless lc( $row->{type} ) eq 'table'; + next if $row->{tbl_name} =~ /^sqlite_/; push @tables, $row->{tbl_name}; } + $sth->finish; return @tables; } @@ -157,6 +200,15 @@ sub _tables_list { L, L, L +=head1 AUTHOR + +See L. + +=head1 LICENSE + +This library is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + =cut 1;