1 package DBIx::Class::Schema::Loader::SQLite;
4 use base qw/DBIx::Class::Schema::Loader::Generic/;
5 use Text::Balanced qw( extract_bracketed );
10 DBIx::Class::Schema::Loader::SQLite - DBIx::Class::Schema::Loader SQLite Implementation.
14 use DBIx::Class::Schema::Loader;
16 # $loader is a DBIx::Class::Schema::Loader::SQLite
17 my $loader = DBIx::Class::Schema::Loader->new(
18 dsn => "dbi:SQLite:dbname=/path/to/dbfile",
23 See L<DBIx::Class::Schema::Loader>.
28 return qw/DBIx::Class::PK::Auto::SQLite/;
33 foreach my $table ( $class->tables ) {
35 my $dbh = $class->storage->dbh;
36 my $sth = $dbh->prepare(<<"");
37 SELECT sql FROM sqlite_master WHERE tbl_name = ?
39 $sth->execute($table);
40 my ($sql) = $sth->fetchrow_array;
43 # Cut "CREATE TABLE ( )" blabla...
44 $sql =~ /^[\w\s]+\((.*)\)$/si;
47 # strip single-line comments
48 $cols =~ s/\-\-.*\n/\n/g;
50 # temporarily replace any commas inside parens,
51 # so we don't incorrectly split on them below
52 my $cols_no_bracketed_commas = $cols;
53 while ( my $extracted =
54 ( extract_bracketed( $cols, "()", "[^(]*" ) )[0] )
56 my $replacement = $extracted;
57 $replacement =~ s/,/--comma--/g;
58 $replacement =~ s/^\(//;
59 $replacement =~ s/\)$//;
60 $cols_no_bracketed_commas =~ s/$extracted/$replacement/m;
63 # Split column definitions
64 for my $col ( split /,/, $cols_no_bracketed_commas ) {
66 # put the paren-bracketed commas back, to help
67 # find multi-col fks below
68 $col =~ s/\-\-comma\-\-/,/g;
70 # CDBI doesn't have built-in support multi-col fks, so ignore them
71 next if $col =~ s/^\s*FOREIGN\s+KEY\s*//i && $col =~ /^\([^,)]+,/;
73 # Strip punctuations around key and table names
74 $col =~ s/[()\[\]'"]/ /g;
78 if ( $col =~ /^(\w+).*REFERENCES\s+(\w+)\s*(\w+)?/i ) {
80 warn qq/\# Found foreign key definition "$col"\n\n/
81 if $class->debug_loader;
82 eval { $class->_belongs_to_many( $table, $1, $2, $3 ) };
83 warn qq/\# belongs_to_many failed "$@"\n\n/
84 if $@ && $class->debug_loader;
92 my $dbh = $class->storage->dbh;
93 my $sth = $dbh->prepare("SELECT * FROM sqlite_master");
96 while ( my $row = $sth->fetchrow_hashref ) {
97 next unless lc( $row->{type} ) eq 'table';
98 push @tables, $row->{tbl_name};
104 my ( $class, $table ) = @_;
107 my $dbh = $class->storage->dbh;
108 my $sth = $dbh->prepare("PRAGMA table_info('$table')");
111 while ( my $row = $sth->fetchrow_hashref ) {
112 push @columns, $row->{name};
116 # find primary key. so complex ;-(
117 $sth = $dbh->prepare(<<'SQL');
118 SELECT sql FROM sqlite_master WHERE tbl_name = ?
120 $sth->execute($table);
121 my ($sql) = $sth->fetchrow_array;
123 my ($primary) = $sql =~ m/
124 (?:\(|\,) # either a ( to start the definition or a , for next
125 \s* # maybe some whitespace
127 [^,]* # anything but the end or a ',' for next column
135 my ($pks) = $sql =~ m/PRIMARY\s+KEY\s*\(\s*([^)]+)\s*\)/i;
136 @pks = split( m/\s*\,\s*/, $pks ) if $pks;
138 return ( \@columns, \@pks );
143 L<DBIx::Schema::Class::Loader>