From: ivan <ivan>
Date: Mon, 28 Nov 2005 12:53:10 +0000 (+0000)
Subject: Initial SQLite support from Jesse Vincent
X-Git-Tag: DBIx_DBSchema_0_28~2
X-Git-Url: http://git.freeside.biz/gitweb/?a=commitdiff_plain;h=67e4411ab8dbc6e529c4124388101eda0e0ab3fe;p=DBIx-DBSchema.git

Initial SQLite support from Jesse Vincent
---

diff --git a/Changes b/Changes
index 9cdb498..ae69082 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
 Revision history for Perl extension DBIx::DBSchema.
 
 0.28 unreleased
+        - Initial SQLite support from Jesse Vincent
 	- fix typo in DBIx::DBSchema::DBD POD doc
 
 0.27 Mon Aug 15 23:31:54 PDT 2005
diff --git a/DBSchema/Column.pm b/DBSchema/Column.pm
index a5b054a..363c98c 100644
--- a/DBSchema/Column.pm
+++ b/DBSchema/Column.pm
@@ -277,7 +277,7 @@ sub line {
   if ( $driver eq 'mysql' ) { #yucky mysql hack
     $null ||= "NOT NULL";
     $self->local('AUTO_INCREMENT') if uc($self->type) eq 'SERIAL';
-  } elsif ( $driver eq 'Pg' ) { #yucky Pg hack
+  } elsif ( $driver =~ /^(?:Pg|SQLite)$/ ) { #yucky Pg hack
     $null ||= "NOT NULL";
     $null =~ s/^NULL$//;
   }
diff --git a/DBSchema/DBD/SQLite.pm b/DBSchema/DBD/SQLite.pm
new file mode 100644
index 0000000..8bc52c8
--- /dev/null
+++ b/DBSchema/DBD/SQLite.pm
@@ -0,0 +1,196 @@
+package DBIx::DBSchema::DBD::SQLite;
+
+use strict;
+use vars qw($VERSION @ISA %typemap);
+use DBIx::DBSchema::DBD;
+
+$VERSION = '0.01';
+@ISA = qw(DBIx::DBSchema::DBD);
+
+%typemap = (
+'SERIAL' => 'INTEGER PRIMARY KEY'
+);
+
+=head1 NAME
+
+DBIx::DBSchema::DBD::SQLite - SQLite native driver for DBIx::DBSchema
+
+=head1 SYNOPSIS
+
+use DBI;
+use DBIx::DBSchema;
+
+$dbh = DBI->connect('dbi:SQLite:tns_service_name', 'user','pass');
+$schema = new_native DBIx::DBSchema $dbh;
+
+=head1 DESCRIPTION
+
+This module implements a SQLite-native driver for DBIx::DBSchema.
+
+=head1 AUTHOR
+
+Jesse Vincent <jesse@bestpractical.com>
+
+=cut 
+
+=head1 API 
+
+=over
+
+
+=item columns CLASS DBI_DBH TABLE
+
+Given an active DBI database handle, return a listref of listrefs (see
+L<perllol>), each containing six elements: column name, column type,
+nullability, column length, column default, and a field reserved for
+driver-specific use (which for sqlite is whether this col is a primary key)
+
+
+=cut
+
+sub columns {
+    my ( $proto, $dbh, $table ) = @_;
+    my $sth  = $dbh->prepare('PRAGMA table_info($table)');
+        $sth->execute();
+    my $rows = [];
+
+    while ( my $row = $sth->fetchrow_hashref ) {
+
+        #  notnull #  pk #  name #  type #  cid #  dflt_value
+        push @$rows,
+            [
+            $row->{'name'},    
+            $row->{'type'},
+            ( $row->{'notnull'} ? 0 : 1 ), 
+            undef,
+            $row->{'dflt_value'}, 
+            $row->{'pk'}
+            ];
+
+    }
+
+    return $rows;
+}
+
+
+=item primary_key CLASS DBI_DBH TABLE
+
+Given an active DBI database handle, return the primary key for the specified
+table.
+
+=cut
+
+sub primary_key {
+  my ($proto, $dbh, $table) = @_;
+
+        my $cols = $proto->columns($dbh,$table);
+        foreach my $col (@$cols) {
+                return ($col->[1]) if ($col->[5]);
+        }
+        
+        return undef;
+}
+
+
+
+=item unique CLASS DBI_DBH TABLE
+
+Given an active DBI database handle, return a hashref of unique indices.  The
+keys of the hashref are index names, and the values are arrayrefs which point
+a list of column names for each.  See L<perldsc/"HASHES OF LISTS"> and
+L<DBIx::DBSchema::ColGroup>.
+
+=cut
+
+sub unique {
+  my ($proto, $dbh, $table) = @_;
+  my @names;
+        my $indexes = $proto->_index_info($dbh, $table);
+   foreach my $row (@$indexes) {
+        push @names, $row->{'name'} if ($row->{'unique'});
+
+    }
+    my $info  = {};
+        foreach my $name (@names) {
+                $info->{'name'} = $proto->_index_cols($dbh, $name);
+        }
+    return $info;
+}
+
+
+=item index CLASS DBI_DBH TABLE
+
+Given an active DBI database handle, return a hashref of (non-unique) indices.
+The keys of the hashref are index names, and the values are arrayrefs which
+point a list of column names for each.  See L<perldsc/"HASHES OF LISTS"> and
+L<DBIx::DBSchema::ColGroup>.
+
+=cut
+
+sub index {
+  my ($proto, $dbh, $table) = @_;
+  my @names;
+        my $indexes = $proto->_index_info($dbh, $table);
+   foreach my $row (@$indexes) {
+        push @names, $row->{'name'} if not ($row->{'unique'});
+
+    }
+    my $info  = {};
+        foreach my $name (@names) {
+                $info->{'name'} = $proto->_index_cols($dbh, $name);
+        }
+
+  return $info;
+}
+
+
+
+sub _index_list {
+
+        my $proto = shift;
+        my $dbh = shift;
+        my $table = shift;
+
+my $sth  = $dbh->prepare('PRAGMA index_list($table)');
+$sth->execute();
+my $rows = [];
+
+while ( my $row = $sth->fetchrow_hashref ) {
+    # Keys are "name" and "unique"
+    push @$rows, $row;
+
+}
+
+return $rows;
+}
+
+
+
+sub _index_cols {
+        my $proto  = shift;
+        my $dbh = shift;
+        my $index = shift;
+        
+        my $sth  = $dbh->prepare('PRAGMA index_info($index)');
+        $sth->execute();
+        my $data = {}; 
+while ( my $row = $sth->fetchrow_hashref ) {
+    # Keys are "name" and "seqno"
+        $data->{$row->{'seqno'}} = $data->{'name'};
+}
+        my @results; 
+        foreach my $key (sort keys %$data) {
+              push @results, $data->{$key}; 
+        }
+
+        return \@results;
+
+}
+
+=begin pod
+
+=back
+
+=cut
+
+1;
diff --git a/DBSchema/Table.pm b/DBSchema/Table.pm
index 0066115..70b2cdf 100644
--- a/DBSchema/Table.pm
+++ b/DBSchema/Table.pm
@@ -370,7 +370,7 @@ sub sql_create_table {
   my $created_dbh = 0;
   unless ( ref($dbh) || ! @_ ) {
     $dbh = DBI->connect( $dbh, @_ ) or die $DBI::errstr;
-    my $gratuitous = $DBI::errstr; #surpress superfluous `used only once' error
+    my $gratuitous = $DBI::errstr; #surpress superfluous 'used only once' error
     $created_dbh = 1;
   }
   my $driver = _load_driver($dbh);
@@ -392,7 +392,9 @@ sub sql_create_table {
 
   push @columns, "PRIMARY KEY (". $self->primary_key. ")"
     #if $self->primary_key && $driver ne 'Pg';
-    if $self->primary_key;
+    # SQLite needs to declare its autoincrementing columns as PRIMARY KEYS inline
+    # otherwise they have no magic
+    if ($self->primary_key and not ( grep { /PRIMARY KEY/ } @columns));
 
   my $indexnum = 1;
 
diff --git a/MANIFEST b/MANIFEST
index ed3a45a..733c803 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,23 +1,25 @@
 Changes
-MANIFEST
-MANIFEST.SKIP
-README
-TODO
-Makefile.PL
 DBSchema.pm
-t/load.t
-t/load-mysql.t
-t/load-pg.t
-t/load-sybase.t
-t/load-oracle.t
-DBSchema/Table.pm
 DBSchema/ColGroup.pm
 DBSchema/ColGroup/Index.pm
 DBSchema/ColGroup/Unique.pm
 DBSchema/Column.pm
-DBSchema/_util.pm
 DBSchema/DBD.pm
-DBSchema/DBD/mysql.pm
+DBSchema/DBD/Oracle.pm
 DBSchema/DBD/Pg.pm
+DBSchema/DBD/SQLite.pm
 DBSchema/DBD/Sybase.pm
-DBSchema/DBD/Oracle.pm
+DBSchema/DBD/mysql.pm
+DBSchema/Table.pm
+DBSchema/_util.pm
+MANIFEST
+MANIFEST.SKIP
+Makefile.PL
+README
+TODO
+t/load-mysql.t
+t/load-oracle.t
+t/load-pg.t
+t/load-sqlite.t
+t/load-sybase.t
+t/load.t
diff --git a/TODO b/TODO
index 50369ef..3cd57ad 100644
--- a/TODO
+++ b/TODO
@@ -1,7 +1,14 @@
+named indices (index representation needs an overhaul)
+
+multiple primary keys (oracle, db2, others?)
+
+better documentation for Column::sql_add_column
+
+Additional transformations (deleted, modified columns, added/modified/indices
+(probably need em named first), added/deleted tables
+
 port and test with additional databases
 
 sql CREATE TABLE output should convert integers
 (i.e. use DBI qw(:sql_types);) to local types using DBI->type_info plus a hash
 to fudge things
-
-index representation needs an overhaul.  named indices.
diff --git a/t/load-sqlite.t b/t/load-sqlite.t
new file mode 100644
index 0000000..786091e
--- /dev/null
+++ b/t/load-sqlite.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use DBIx::DBSchema::DBD::SQLite;
+$loaded = 1;
+print "ok 1\n";