1 package DBIx::Class::Schema::Loader::DBI::SQLite;
6 DBIx::Class::Schema::Loader::DBI::Component::QuotedDefault
7 DBIx::Class::Schema::Loader::DBI
9 use Carp::Clan qw/^DBIx::Class/;
10 use Text::Balanced qw( extract_bracketed );
13 our $VERSION = '0.05002';
17 DBIx::Class::Schema::Loader::DBI::SQLite - DBIx::Class::Schema::Loader::DBI SQLite Implementation.
22 use base qw/DBIx::Class::Schema::Loader/;
24 __PACKAGE__->loader_options( debug => 1 );
30 See L<DBIx::Class::Schema::Loader::Base>.
36 SQLite will fail all further commands on a connection if the
37 underlying schema has been modified. Therefore, any runtime
38 changes requiring C<rescan> also require us to re-connect
39 to the database. The C<rescan> method here handles that
40 reconnection for you, but beware that this must occur for
41 any other open sqlite connections as well.
46 my ($self, $schema) = @_;
48 $schema->storage->disconnect if $schema->storage;
49 $self->next::method($schema);
52 # XXX this really needs a re-factor
53 sub _sqlite_parse_table {
54 my ($self, $table) = @_;
60 my $dbh = $self->schema->storage->dbh;
61 my $sth = $self->{_cache}->{sqlite_master}
62 ||= $dbh->prepare(q{SELECT sql FROM sqlite_master WHERE tbl_name = ?});
64 $sth->execute($table);
65 my ($sql) = $sth->fetchrow_array;
68 # Cut "CREATE TABLE ( )" blabla...
69 $sql =~ /^[\w\s"]+\((.*)\)$/si;
72 # strip single-line comments
73 $cols =~ s/\-\-.*\n/\n/g;
75 # temporarily replace any commas inside parens,
76 # so we don't incorrectly split on them below
77 my $cols_no_bracketed_commas = $cols;
78 while ( my $extracted =
79 ( extract_bracketed( $cols, "()", "[^(]*" ) )[0] )
81 my $replacement = $extracted;
82 $replacement =~ s/,/--comma--/g;
83 $replacement =~ s/^\(//;
84 $replacement =~ s/\)$//;
85 $cols_no_bracketed_commas =~ s/$extracted/$replacement/m;
88 # Split column definitions
89 for my $col ( split /,/, $cols_no_bracketed_commas ) {
91 # put the paren-bracketed commas back, to help
92 # find multi-col fks below
93 $col =~ s/\-\-comma\-\-/,/g;
95 $col =~ s/^\s*FOREIGN\s+KEY\s*//i;
97 # Strip punctuations around key and table names
98 $col =~ s/[\[\]'"]/ /g;
104 if($col =~ /^(.*)\s+UNIQUE/i) {
106 $colname =~ s/\s+.*$//;
107 push(@uniqs, [ "${colname}_unique" => [ lc $colname ] ]);
109 elsif($col =~/^\s*UNIQUE\s*\(\s*(.*)\)/i) {
112 my @cols = map { lc } split(/\s*,\s*/, $cols);
113 my $name = join(q{_}, @cols) . '_unique';
114 push(@uniqs, [ $name => \@cols ]);
117 if ($col =~ /AUTOINCREMENT/i) {
119 $auto_inc{lc $1} = 1;
122 next if $col !~ /^(.*\S)\s+REFERENCES\s+(\w+) (?: \s* \( (.*) \) )? /ix;
124 my ($cols, $f_table, $f_cols) = ($1, $2, $3);
126 if($cols =~ /^\(/) { # Table-level
134 my @cols = map { s/\s*//g; lc $_ } split(/\s*,\s*/,$cols);
137 my @f_cols = map { s/\s*//g; lc $_ } split(/\s*,\s*/,$f_cols);
138 croak "Mismatched column count in rel for $table => $f_table"
143 local_columns => \@cols,
144 remote_columns => $rcols,
145 remote_table => $f_table,
149 return { rels => \@rels, uniqs => \@uniqs, auto_inc => \%auto_inc };
152 sub _extra_column_info {
153 my ($self, $table, $col_name, $sth, $col_num) = @_;
154 ($table, $col_name) = @{$table}{qw/TABLE_NAME COLUMN_NAME/} if ref $table;
157 $self->{_sqlite_parse_data}->{$table} ||=
158 $self->_sqlite_parse_table($table);
160 if ($self->{_sqlite_parse_data}->{$table}->{auto_inc}->{$col_name}) {
161 $extra_info{is_auto_increment} = 1;
168 my ($self, $table) = @_;
170 $self->{_sqlite_parse_data}->{$table} ||=
171 $self->_sqlite_parse_table($table);
173 return $self->{_sqlite_parse_data}->{$table}->{rels};
176 sub _table_uniq_info {
177 my ($self, $table) = @_;
179 $self->{_sqlite_parse_data}->{$table} ||=
180 $self->_sqlite_parse_table($table);
182 return $self->{_sqlite_parse_data}->{$table}->{uniqs};
188 my $dbh = $self->schema->storage->dbh;
189 my $sth = $dbh->prepare("SELECT * FROM sqlite_master");
192 while ( my $row = $sth->fetchrow_hashref ) {
193 next unless lc( $row->{type} ) eq 'table';
194 next if $row->{tbl_name} =~ /^sqlite_/;
195 push @tables, $row->{tbl_name};
203 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
204 L<DBIx::Class::Schema::Loader::DBI>
208 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
212 This library is free software; you can redistribute it and/or modify it under
213 the same terms as Perl itself.