1 package SQL::Translator::Producer::SQLite;
3 # -------------------------------------------------------------------
4 # $Id: SQLite.pm,v 1.3 2003-04-25 11:47:25 dlc Exp $
5 # -------------------------------------------------------------------
6 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
7 # darren chamberlain <darren@cpan.org>,
8 # Chris Mungall <cjm@fruitfly.org>
10 # This program is free software; you can redistribute it and/or
11 # modify it under the terms of the GNU General Public License as
12 # published by the Free Software Foundation; version 2.
14 # This program is distributed in the hope that it will be useful, but
15 # WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 # General Public License for more details.
19 # You should have received a copy of the GNU General Public License
20 # along with this program; if not, write to the Free Software
21 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
23 # -------------------------------------------------------------------
27 use SQL::Translator::Utils qw(debug header_comment);
29 use vars qw[ $VERSION $DEBUG $WARN ];
31 $VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/;
32 $DEBUG = 0 unless defined $DEBUG;
33 $WARN = 0 unless defined $WARN;
35 my %used_identifiers = ();
36 my $max_id_length = 30;
41 my ($translator, $data) = @_;
42 local $DEBUG = $translator->debug;
43 local $WARN = $translator->show_warnings;
44 my $no_comments = $translator->no_comments;
45 my $add_drop_table = $translator->add_drop_table;
47 debug("PKG: Beginning production\n");
50 $create .= header_comment unless ($no_comments);
52 for my $table ( keys %{ $data } ) {
53 debug("PKG: Looking at table '$table'\n");
54 my $table_data = $data->{$table};
56 $table_data->{'fields'}->{$a}->{'order'}
58 $table_data->{'fields'}->{$b}->{'order'}
59 } keys %{$table_data->{'fields'}};
62 # Header. Should this look like what mysqldump produces?
64 $create .= "--\n-- Table: $table\n--\n" unless $no_comments;
65 $create .= qq[DROP TABLE $table;\n] if $add_drop_table;
66 $create .= "CREATE TABLE $table (";
71 for (my $i = 0; $i <= $#fields; $i++) {
72 my $field = $fields[$i];
73 debug("PKG: Looking at field '$field'\n");
74 my $field_data = $table_data->{'fields'}->{$field};
75 my @fdata = ("", $field);
80 my $data_type = lc $field_data->{'data_type'};
81 my $list = $field_data->{'list'} || [];
82 my $commalist = join ",", @$list;
85 if ( $data_type eq 'set' ) {
86 $data_type = 'varchar';
87 $size = length $commalist;
90 $size = join( ', ', @{ $field_data->{'size'} || [] } );
93 # SQLite is generally typeless, but newer versions will
94 # make a field autoincrement if it is declared as (and
95 # *only* as) INTEGER PRIMARY KEY
96 if ($field_data->{'is_auto_inc'}) {
97 $data_type = 'INTEGER PRIMARY KEY';
101 push @fdata, sprintf "%s%s", $data_type, (!$is_autoinc && $size) ? "($size)" : '';
104 # for my $qual ( qw[ binary unsigned zerofill ] ) {
106 # if $field_data->{ $qual } ||
107 # $field_data->{ uc $qual };
111 push @fdata, "NOT NULL" unless $field_data->{'null'};
113 # Default? XXX Need better quoting!
114 my $default = $field_data->{'default'};
115 if ( defined $default ) {
116 if ( uc $default eq 'NULL') {
117 push @fdata, "DEFAULT NULL";
119 push @fdata, "DEFAULT '$default'";
124 $create .= (join " ", '', @fdata);
125 $create .= "," unless ($i == $#fields);
131 my $idx_name_default = 'A';
132 for my $index ( @{ $table_data->{'indices'} || [] } ) {
133 my ($name, $type, $fields) = @{ $index }{ qw[ name type fields ] };
135 my $index_type = $type eq 'unique' ? 'UNIQUE INDEX' : 'INDEX';
136 $name = mk_name($table, $name || ++$idx_name_default);
138 "CREATE $index_type $name on $table ".
139 '(' . join( ', ', @$fields ) . ')';
144 for my $index_create ( @index_creates ) {
145 $create .= "$index_create;\n";
155 # -------------------------------------------------------------------
157 my ($basename, $type, $scope, $critical) = @_;
158 my $basename_orig = $basename;
160 ? $max_id_length - (length($type) + 1)
162 $basename = substr( $basename, 0, $max_name )
163 if length( $basename ) > $max_name;
164 my $name = $type ? "${type}_$basename" : $basename;
166 if ( $basename ne $basename_orig and $critical ) {
167 my $show_type = $type ? "+'$type'" : "";
168 warn "Truncating '$basename_orig'$show_type to $max_id_length ",
169 "character limit to make '$name'\n" if $WARN;
170 $truncated{ $basename_orig } = $name;
173 $scope ||= \%global_names;
174 if ( my $prev = $scope->{ $name } ) {
175 my $name_orig = $name;
176 $name .= sprintf( "%02d", ++$prev );
177 substr($name, $max_id_length - 3) = "00"
178 if length( $name ) > $max_id_length;
180 warn "The name '$name_orig' has been changed to ",
181 "'$name' to make it unique.\n" if $WARN;
183 $scope->{ $name_orig }++;
195 SQL::Translator::Producer::SQLite - SQLite-specific producer for SQL::Translator
199 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>