From: ivan <ivan>
Date: Fri, 29 Nov 2002 23:03:04 +0000 (+0000)
Subject: Sybase patch from Bernd Dulfer <bernd@widd.de>
X-Git-Tag: DBIx_DBSchema_0_22~4
X-Git-Url: http://git.freeside.biz/gitweb/?a=commitdiff_plain;h=f6e142d7bc4e515604882564308fd9c76b2608c1;p=DBIx-DBSchema.git

Sybase patch from Bernd Dulfer <bernd@widd.de>
---

diff --git a/DBSchema.pm b/DBSchema.pm
index ef975b6..885a1d0 100644
--- a/DBSchema.pm
+++ b/DBSchema.pm
@@ -14,7 +14,7 @@ use DBIx::DBSchema::ColGroup::Index;
 #@ISA = qw(Exporter);
 @ISA = ();
 
-$VERSION = "0.21";
+$VERSION = "0.22";
 
 =head1 NAME
 
diff --git a/DBSchema/DBD/Sybase.pm b/DBSchema/DBD/Sybase.pm
index 95e2d1a..4a74069 100755
--- a/DBSchema/DBD/Sybase.pm
+++ b/DBSchema/DBD/Sybase.pm
@@ -4,17 +4,13 @@ use strict;
 use vars qw($VERSION @ISA %typemap);
 use DBIx::DBSchema::DBD;
 
-$VERSION = '0.02';
+$VERSION = '0.03';
 @ISA = qw(DBIx::DBSchema::DBD);
 
 %typemap = (
 #  'empty' => 'empty'
 );
 
-#
-# Return this from uncompleted driver calls.
-#
-
 =head1 NAME
 
 DBIx::DBSchema::DBD::Sybase - Sybase database driver for DBIx::DBSchema
@@ -34,24 +30,25 @@ This module implements a Sybase driver for DBIx::DBSchema.
 =cut
 
 sub columns {
-
   my($proto, $dbh, $table) = @_;
 
   my $sth = $dbh->prepare("sp_columns \@table_name=$table") 
   or die $dbh->errstr;
 
   $sth->execute or die $sth->errstr;
-  map {
+  my @cols = map {
     [
-      $_->{'COLUMN_NAME'},
-      $_->{'TYPE_NAME'},
-      ($_->{'NULLABLE'} ? 1 : ''),
-      $_->{'LENGTH'},
+      $_->{'column_name'},
+      $_->{'type_name'},
+      ($_->{'nullable'} ? 1 : ''),
+      $_->{'length'},
       '', #default
       ''  #local
     ]
   } @{ $sth->fetchall_arrayref({}) };
+  $sth->finish;
 
+  @cols;
 }
 
 sub primary_key {
@@ -60,25 +57,55 @@ sub primary_key {
 
 
 sub unique {
+  my($proto, $dbh, $table) = @_;
+  my $gratuitous = { map { $_ => [ $proto->_index_fields($dbh, $table, $_ ) ] }
+      grep { $proto->_is_unique($dbh, $_ ) }
+        $proto->_all_indices($dbh, $table)
+  };
+}
 
-    my %stubList = (
-	  'stubfirstUniqueIndex' => ['stubfirstUniqueIndex'],
-	  'stubtwostUniqueIndex' => ['stubtwostUniqueIndex']
-			);
+sub index {
+  my($proto, $dbh, $table) = @_;
+  my $gratuitous = { map { $_ => [ $proto->_index_fields($dbh, $table, $_ ) ] }
+      grep { ! $proto->_is_unique($dbh, $_ ) }
+        $proto->_all_indices($dbh, $table)
+  };
+}
 
-   return ( { %stubList } );
+sub _all_indices {
+  my($proto, $dbh, $table) = @_;
 
+  my $sth = $dbh->prepare_cached(<<END) or die $dbh->errstr;
+    SELECT name
+    FROM sysindexes
+    WHERE id = object_id('$table') and indid between 1 and 254
+END
+  $sth->execute or die $sth->errstr;
+  my @indices = map { $_->[0] } @{ $sth->fetchall_arrayref() };
+  $sth->finish;
+  $sth = undef;
+  @indices;
 }
 
-sub index {
+sub _index_fields {
+  my($proto, $dbh, $table, $index) = @_;
+
+  my @keys;
+
+  my ($indid) = $dbh->selectrow_array("select indid from sysindexes where id = object_id('$table') and name = '$index'");
+  for (1..30) {
+    push @keys, $dbh->selectrow_array("select index_col('$table', $indid, $_)") || ();
+  }
 
-    my %stubList = (
-	  'stubfirstIndex' => ['stubfirstUniqueIndex'],
-	  'stubtwostIndex' => ['stubtwostUniqueIndex']
-			);
+  return @keys;
+}
+
+sub _is_unique {
+  my($proto, $dbh, $table, $index) = @_;
 
-    return ( { %stubList } );
+  my ($isunique) = $dbh->selectrow_array("select status & 2 from sysindexes where id = object_id('$table') and name = '$index'");
 
+  return $isunique;
 }
 
 =head1 AUTHOR
@@ -88,6 +115,8 @@ Charles Shapiro <charles.shapiro@numethods.com>
 
 Mitchell Friedman <mitchell.friedman@numethods.com>
 
+Bernd Dulfer <bernd@widd.de>
+
 =head1 COPYRIGHT
 
 Copyright (c) 2001 Charles Shapiro, Mitchell J. Friedman
@@ -100,10 +129,7 @@ the same terms as Perl itself.
 
 Yes.
 
-Most of this is not implemented.
-
-the "columns" method works; primary key, unique and index do not yet.  Please
-send any patches to all three addresses listed above.
+The B<primary_key> method does not yet work.
 
 =head1 SEE ALSO
 
diff --git a/MANIFEST b/MANIFEST
index de52251..c57d874 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -14,3 +14,4 @@ DBSchema/Column.pm
 DBSchema/DBD.pm
 DBSchema/DBD/mysql.pm
 DBSchema/DBD/Pg.pm
+DBSchema/DBD/Sybase.pm
diff --git a/README b/README
index 8924120..e020427 100644
--- a/README
+++ b/README
@@ -12,11 +12,10 @@ schema from an existing database.  You can save the schema to disk and restore
 it from different process.  Most importantly, DBIx::DBSchema can write SQL
 CREATE statements for different databases from a single source.
 
-Currently supported databases are MySQL and PostgreSQL.  Sybase support is
-partially implemented.  DBIx::DBSchema will attempt to use generic SQL syntax
-for other databases.  Assistance adding support for other databases is
-welcomed.  See the DBIx::DBSchema::DBD manpage, "Driver Writer's Guide and
-Base Class".
+Currently supported databases are MySQL, PostgreSQL and Sybase.
+DBIx::DBSchema will attempt to use generic SQL syntax for other databases.
+Assistance adding support for other databases is welcomed.  See the
+DBIx::DBSchema::DBD manpage, "Driver Writer's Guide and Base Class".
 
 To install:
 	perl Makefile.PL
@@ -40,4 +39,4 @@ A mailing list is available.  Send a blank message to
 
 Homepage: <http://www.420.am/dbix-dbschema>
 
-$Id: README,v 1.8 2002-03-04 13:01:55 ivan Exp $
+$Id: README,v 1.9 2002-11-29 23:03:04 ivan Exp $