From: ivan <ivan>
Date: Wed, 27 Sep 2000 18:26:42 +0000 (+0000)
Subject: bugfixes
X-Git-Tag: DBIx_DBSchema_0_01~1
X-Git-Url: http://git.freeside.biz/gitweb/?a=commitdiff_plain;h=ea6ab476e4b6dad1fd7550f8339ab223b90da4b5;p=DBIx-DBSchema.git

bugfixes
---

diff --git a/DBSchema.pm b/DBSchema.pm
index 36775e0..84f7fa2 100644
--- a/DBSchema.pm
+++ b/DBSchema.pm
@@ -231,7 +231,8 @@ sub pretty_print {
                          "    '$_', ".
                          "'". $self->table($table)->column($_)->type. "', ".
                          "'". $self->table($table)->column($_)->null. "', ". 
-                         "'". $self->table($table)->column($_)->length. "',\n"
+                         "'". $self->table($table)->column($_)->length. "', ".
+                         "'". $self->table($table)->column($_)->local. "',\n"
                        } $self->table($table)->columns
           ).
         "  ],\n".
@@ -264,7 +265,7 @@ sub pretty_read {
     my(@columns);
     while ( @{$href->{$_}{'columns'}} ) {
       push @columns, DBIx::DBSchema::Column->new(
-        splice @{$href->{$_}{'columns'}}, 0, 4
+        splice @{$href->{$_}{'columns'}}, 0, 5
       );
     }
     DBIx::DBSchema::Table->new(
diff --git a/DBSchema/Column.pm b/DBSchema/Column.pm
index b7ab18f..7e2aad2 100644
--- a/DBSchema/Column.pm
+++ b/DBSchema/Column.pm
@@ -20,6 +20,7 @@ DBIx::DBSchema::Column - Column objects
   $column = new DBIx::DBSchema::Column ( $name, $sql_type, 'NULL' );
   $column = new DBIx::DBSchema::Column ( $name, $sql_type, '', $length );
   $column = new DBIx::DBSchema::Column ( $name, $sql_type, 'NULL', $length );
+  $column = new DBIx::DBSchema::Column ( $name, $sql_type, 'NULL', $length, $local );
 
   $name = $column->name;
   $column->name( 'name' );
@@ -48,17 +49,17 @@ L<DBIx::DBSchema::Table>).
 
 =over 4
 
-=item new [ NAME [ , SQL_TYPE [ , NULL [ , LENGTH ] ] ] ]
+=item new [ NAME [ , SQL_TYPE [ , NULL [ , LENGTH  [ , LOCAL ] ] ] ] ]
 
 Creates a new DBIx::DBSchema::Column object.  NAME is the name of the column.
 SQL_TYPE is the SQL data type.  NULL is the nullability of the column (the
 empty string is equivalent to `NOT NULL').  LENGTH is the SQL length of the
-column.
+column.  LOCAL is reserved for database-specific information.
 
 =cut
 
 sub new {
-  my($proto,$name,$type,$null,$length)=@_;
+  my($proto,$name,$type,$null,$length,$local)=@_;
 
   #croak "Illegal name: $name" if grep $name eq $_, @reserved_words;
 
@@ -71,6 +72,7 @@ sub new {
     'type'   => $type,
     'null'   => $null,
     'length' => $length,
+    'local'  => $local,
   };
 
   bless ($self, $class);
@@ -141,6 +143,21 @@ sub length {
   }
 }
 
+=item local [ LOCAL ]
+
+Returns or sets the database-specific field.
+
+=cut
+
+sub local {
+  my($self,$value)=@_;
+  if ( defined($value) ) {
+    $self->{'local'} = $value;
+  } else {
+    $self->{'local'};
+  }
+}
+
 =item line [ $datasrc ]
 
 Returns an SQL column definition.
@@ -166,6 +183,10 @@ sub line {
     $self->name,
     $self->type. ( $self->length ? '('.$self->length.')' : '' ),
     $null,
+    ( ( $datasrc =~ /^dbi:mysql:/i )
+      ? $self->local
+      : ''
+    ),
   );
 }
 
diff --git a/DBSchema/DBD.pm b/DBSchema/DBD.pm
index a3a65f2..c9ce8e4 100644
--- a/DBSchema/DBD.pm
+++ b/DBSchema/DBD.pm
@@ -24,8 +24,8 @@ following class methods:
 =item columns CLASS DBI_DBH TABLE
 
 Given an active DBI database handle, return a listref of listrefs (see
-L<perllol>), each containing four elements: column name, column type,
-nullability, and column length.
+L<perllol>), each containing five elements: column name, column type,
+nullability, column length, and a field reserved for driver-specific use.
 
 =item primary_key CLASS DBI_DBH TABLE
 
diff --git a/DBSchema/DBD/Pg.pm b/DBSchema/DBD/Pg.pm
index b41a98c..2dfeec0 100644
--- a/DBSchema/DBD/Pg.pm
+++ b/DBSchema/DBD/Pg.pm
@@ -37,9 +37,11 @@ END
       $_->{'attname'},
       $_->{'typname'},
       ! $_->{'attnotnull'},
-      $_->{'attlen'} == -1
+      ( $_->{'attlen'} == -1
         ? $_->{'atttypmod'} - 4
         : ''
+      ),
+      ''
     ]
   } @{ $sth->fetchall_arrayref({}) };
 }
diff --git a/DBSchema/DBD/mysql.pm b/DBSchema/DBD/mysql.pm
index 08c457b..e378861 100644
--- a/DBSchema/DBD/mysql.pm
+++ b/DBSchema/DBD/mysql.pm
@@ -31,7 +31,7 @@ sub columns {
     $_->{'Type'} =~ /^(\w+)\(?([\d\,]+)?\)?( unsigned)?$/
       or die "Illegal type: ". $_->{'Type'}. "\n";
     my($type, $length) = ($1, $2);
-    [ $_->{'Field'}, $type, $_->{'Null'}, $length ]
+    [ $_->{'Field'}, $type, $_->{'Null'}, $length, $_->{'Extra'} ]
   } @{ $sth->fetchall_arrayref( {} ) };
 }
 
diff --git a/DBSchema/Table.pm b/DBSchema/Table.pm
index 10c11ce..179bbe8 100644
--- a/DBSchema/Table.pm
+++ b/DBSchema/Table.pm
@@ -72,17 +72,19 @@ sub new {
   my($proto,$name,$primary_key,$unique,$index,@columns)=@_;
 
   my(%columns) = map { $_->name, $_ } @columns;
+  my(@column_order) = map { $_->name } @columns;
 
   #check $primary_key, $unique and $index to make sure they are $columns ?
   # (and sanity check?)
 
   my $class = ref($proto) || $proto;
   my $self = {
-    'name'        => $name,
-    'primary_key' => $primary_key,
-    'unique'      => $unique,
-    'index'       => $index,
-    'columns'     => \%columns,
+    'name'         => $name,
+    'primary_key'  => $primary_key,
+    'unique'       => $unique,
+    'index'        => $index,
+    'columns'      => \%columns,
+    'column_order' => \@column_order,
   };
 
   bless ($self, $class);
@@ -180,6 +182,7 @@ Adds this DBIx::DBSchema::Column object.
 sub addcolumn {
   my($self,$column)=@_;
   ${$self->{'columns'}}{$column->name}=$column; #sanity check?
+  push @{$self->{'column_order'}}, $column->name;
 }
 
 =item name [ TABLE_NAME ]
@@ -256,7 +259,9 @@ Returns a list consisting of the names of all columns.
 
 sub columns {
   my($self)=@_;
-  keys %{$self->{'columns'}};
+  #keys %{$self->{'columns'}};
+  #must preserve order
+  @{ $self->{'column_order'} };
 }
 
 =item column COLUMN_NAME