added typemap foo and default values

diff --git a/DBSchema.pm b/DBSchema.pm
index 8801737..847873d 100644 (file)
--- a/DBSchema.pm
+++ b/DBSchema.pm
@@ -14,7 +14,7 @@ use DBIx::DBSchema::ColGroup::Index;
 #@ISA = qw(Exporter);
 @ISA = ();
 
-$VERSION = "0.11";
+$VERSION = "0.12";
 
 =head1 NAME
 
@@ -43,7 +43,7 @@ DBIx::DBSchema - Database-independent schema objects
 
   $perl_code = $schema->pretty_print;
   %hash = eval $perl_code;
-  $schema = pretty_read DBIx::DBSchema \%hash;
+  use DBI qw(:sql_types); $schema = pretty_read DBIx::DBSchema \%hash;
 
 =head1 DESCRIPTION
 
@@ -232,6 +232,7 @@ sub pretty_print {
                          "'". $self->table($table)->column($_)->type. "', ".
                          "'". $self->table($table)->column($_)->null. "', ". 
                          "'". $self->table($table)->column($_)->length. "', ".
+                         "'". $self->table($table)->column($_)->default. "', ".
                          "'". $self->table($table)->column($_)->local. "',\n"
                        } $self->table($table)->columns
           ).
@@ -265,7 +266,7 @@ sub pretty_read {
     my(@columns);
     while ( @{$href->{$_}{'columns'}} ) {
       push @columns, DBIx::DBSchema::Column->new(
-        splice @{$href->{$_}{'columns'}}, 0, 5
+        splice @{$href->{$_}{'columns'}}, 0, 6
       );
     }
     DBIx::DBSchema::Table->new(
@@ -282,7 +283,15 @@ sub pretty_read {
 
 sub _load_driver {
   my($dbh) = @_;
-  my $driver = $dbh->{Driver}->{Name};
+  my $driver;
+  if ( ref($dbh) ) {
+    $driver = $dbh->{Driver}->{Name};
+  } else {
+    $dbh =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i #nicked from DBI->connect
+                        or '' =~ /()/; # ensure $1 etc are empty if match fails
+    $driver = $1 or die "can't parse data source: $dbh";
+  }
+
   #require "DBIx/DBSchema/DBD/$driver.pm";
   #$driver;
   eval 'require "DBIx/DBSchema/DBD/$driver.pm"' and $driver;
@@ -318,6 +327,9 @@ within the SQL database engine (DBI data source).
 
 pretty_print is actually pretty ugly.
 
+Perhaps pretty_read should eval column types so that we can use DBI
+qw(:sql_types) here instead of externally.
+
 =head1 SEE ALSO
 
 L<DBIx::DBSchema::Table>, L<DBIx::DBSchema::ColGroup>,

diff --git a/DBSchema/Column.pm b/DBSchema/Column.pm
index 7e2aad2..617d720 100644 (file)
--- a/DBSchema/Column.pm
+++ b/DBSchema/Column.pm
@@ -20,7 +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 );
+  $column = new DBIx::DBSchema::Column ( $name, $sql_type, 'NULL', $length, $default, $local );
 
   $name = $column->name;
   $column->name( 'name' );
@@ -37,6 +37,9 @@ DBIx::DBSchema::Column - Column objects
   $column->length( '10' );
   $column->length( '8,2' );
 
+  $default = $column->default;
+  $column->default( 'Roo' );
+
   $sql_line = $column->line;
   $sql_line = $column->line($datasrc);
 
@@ -49,17 +52,18 @@ L<DBIx::DBSchema::Table>).
 
 =over 4
 
-=item new [ NAME [ , SQL_TYPE [ , NULL [ , LENGTH  [ , LOCAL ] ] ] ] ]
+=item new [ NAME [ , SQL_TYPE [ , NULL [ , LENGTH  [ , DEFAULT [ , 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.  LOCAL is reserved for database-specific information.
+column.  DEFAULT is the default value of the column.  LOCAL is reserved for
+database-specific information.
 
 =cut
 
 sub new {
-  my($proto,$name,$type,$null,$length,$local)=@_;
+  my($proto,$name,$type,$null,$length,$default,$local)=@_;
 
   #croak "Illegal name: $name" if grep $name eq $_, @reserved_words;
 
@@ -68,11 +72,12 @@ sub new {
 
   my $class = ref($proto) || $proto;
   my $self = {
-    'name'   => $name,
-    'type'   => $type,
-    'null'   => $null,
-    'length' => $length,
-    'local'  => $local,
+    'name'    => $name,
+    'type'    => $type,
+    'null'    => $null,
+    'length'  => $length,
+    'default' => $default,
+    'local'   => $local,
   };
 
   bless ($self, $class);
@@ -143,6 +148,22 @@ sub length {
   }
 }
 
+=item default [ LOCAL ]
+
+Returns or sets the default value.
+
+=cut
+
+sub default {
+  my($self,$value)=@_;
+  if ( defined($value) ) {
+    $self->{'default'} = $value;
+  } else {
+    $self->{'default'};
+  }
+}
+
+
 =item local [ LOCAL ]
 
 Returns or sets the database-specific field.
@@ -171,7 +192,15 @@ for other engines (if applicable) may also be supported in the future.
 
 sub line {
   my($self,$datasrc)=@_;
+  
+  my $driver = DBIx::DBSchema::_load_driver($datasrc);
+  my %typemap = eval "\%DBIx::DBSchema::DBD::${driver}::typemap";
+  my $type = defined( $typemap{uc($self->type)} )
+    ? $typemap{uc($self->type)}
+    : $self->type;
+
   my($null)=$self->null;
+
   if ( $datasrc =~ /^dbi:mysql:/i ) { #yucky mysql hack
     $null ||= "NOT NULL"
   }
@@ -179,15 +208,21 @@ sub line {
     $null ||= "NOT NULL";
     $null =~ s/^NULL$//;
   }
+
   join(' ',
     $self->name,
-    $self->type. ( $self->length ? '('.$self->length.')' : '' ),
+    $type. ( $self->length ? '('.$self->length.')' : '' ),
     $null,
+    ( ( defined($self->default) && $self->default ne '' )
+      ? 'DEFAULT '. $self->default
+      : ''
+    ),
     ( ( $datasrc =~ /^dbi:mysql:/i )
       ? $self->local
       : ''
     ),
   );
+
 }
 
 =back

diff --git a/DBSchema/DBD.pm b/DBSchema/DBD.pm
index c9ce8e4..c0a8652 100644 (file)
--- a/DBSchema/DBD.pm
+++ b/DBSchema/DBD.pm
@@ -3,16 +3,20 @@ package DBIx::DBSchema::DBD;
 use strict;
 use vars qw($VERSION);
 
-$VERSION = '0.01';
+$VERSION = '0.02';
 
 =head1 NAME
 
-DBIx::DBSchema::DBD - DBIx::DBSchema Driver Writer's Guide
+DBIx::DBSchema::DBD - DBIx::DBSchema Driver Writer's Guide and Base Class
 
 =head1 SYNOPSIS
 
   perldoc DBIx::DBSchema::DBD
 
+  package DBIx::DBSchema::DBD::FooBase
+  use DBIx::DBSchmea::DBD;
+  @ISA = qw(DBIx::DBSchema::DBD);
+
 =head1 DESCRIPTION
 
 Drivers should be named DBIx::DBSchema::DBD::DatabaseName, where DatabaseName
@@ -24,8 +28,25 @@ 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 five elements: column name, column type,
-nullability, column length, and a field reserved for driver-specific use.
+L<perllol>), each containing six elements: column name, column type,
+nullability, column length, column default, and a field reserved for
+driver-specific use.
+
+=item column CLASS DBI_DBH TABLE COLUMN
+
+Same as B<columns> above, except return the listref for a single column.  You
+can inherit from DBIx::DBSchema::DBD to provide this function.
+
+=cut
+
+sub column {
+  my($proto, $dbh, $table, $column) = @_;
+  #@a = grep { $_->[0] eq $column } @{ $proto->columns( $dbh, $table ) };
+  #$a[0];
+  @{ [
+    grep { $_->[0] eq $column } @{ $proto->columns( $dbh, $table ) }
+  ] }[0]; #force list context on grep, return scalar of first element
+}
 
 =item primary_key CLASS DBI_DBH TABLE
 
@@ -62,6 +83,8 @@ the same terms as Perl itself.
 
 =head1 BUGS
 
+%typemap needs to be documented.
+
 =head1 SEE ALSO
 
 L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD::mysql>, L<DBIx::DBSchema::DBD::Pg>,

diff --git a/DBSchema/DBD/Pg.pm b/DBSchema/DBD/Pg.pm
index 2dfeec0..23ab42b 100644 (file)
--- a/DBSchema/DBD/Pg.pm
+++ b/DBSchema/DBD/Pg.pm
@@ -1,9 +1,15 @@
 package DBIx::DBSchema::DBD::Pg;
 
 use strict;
-use vars qw($VERSION);
+use vars qw($VERSION @ISA %typemap);
+use DBIx::DBSchema::DBD;
 
-$VERSION = '0.01';
+$VERSION = '0.02';
+@ISA = qw(DBIx::DBSchema::DBD);
+
+%typemap = (
+  'BLOB' => 'TEXT',
+);
 
 =head1 NAME
 
@@ -41,7 +47,8 @@ END
         ? $_->{'atttypmod'} - 4
         : ''
       ),
-      ''
+      '', #default
+      ''  #local
     ]
   } @{ $sth->fetchall_arrayref({}) };
 }
@@ -128,6 +135,8 @@ the same terms as Perl itself.
 
 Yes.
 
+columns doesn't return column default information.
+
 =head1 SEE ALSO
 
 L<DBIx::DBSchema>, L<DBIx::DBSchema::DBD>, L<DBI>, L<DBI::DBD>

diff --git a/DBSchema/DBD/mysql.pm b/DBSchema/DBD/mysql.pm
index e378861..63877f7 100644 (file)
--- a/DBSchema/DBD/mysql.pm
+++ b/DBSchema/DBD/mysql.pm
@@ -1,9 +1,15 @@
 package DBIx::DBSchema::DBD::mysql;
 
 use strict;
-use vars qw($VERSION);
+use vars qw($VERSION @ISA %typemap);
+use DBIx::DBSchema::DBD;
 
-$VERSION = '0.01';
+$VERSION = '0.02';
+@ISA = qw(DBIx::DBSchema::DBD);
+
+%typemap = (
+  'TIMESTAMP' => 'DATETIME',
+);
 
 =head1 NAME
 
@@ -31,7 +37,14 @@ sub columns {
     $_->{'Type'} =~ /^(\w+)\(?([\d\,]+)?\)?( unsigned)?$/
       or die "Illegal type: ". $_->{'Type'}. "\n";
     my($type, $length) = ($1, $2);
-    [ $_->{'Field'}, $type, $_->{'Null'}, $length, $_->{'Extra'} ]
+    [
+      $_->{'Field'},
+      $type,
+      $_->{'Null'},
+      $length,
+      $_->{'Default'},
+      $_->{'Extra'}
+    ]
   } @{ $sth->fetchall_arrayref( {} ) };
 }
 

diff --git a/DBSchema/Table.pm b/DBSchema/Table.pm
index 179bbe8..6919331 100644 (file)
--- a/DBSchema/Table.pm
+++ b/DBSchema/Table.pm
@@ -137,10 +137,13 @@ sub new_odbc {
       new DBIx::DBSchema::Column
           $_,
           $type_info->{'TYPE_NAME'},
+          #"SQL_". uc($type_info->{'TYPE_NAME'}),
           $sth->{NULLABLE}->[$sthpos],
-          &{
-            $create_params{ $type_info->{CREATE_PARAMS} }
-          }( $sth, $sthpos++ )
+          &{ $create_params{ $type_info->{CREATE_PARAMS} } }( $sth, $sthpos++ ),          $driver && #default
+            ${ [
+              eval "DBIx::DBSchema::DBD::$driver->column(\$dbh, \$name, \$_)"
+            ] }[4]
+          # DB-local
     } @{$sth->{NAME}}
   );
 }

diff --git a/MANIFEST b/MANIFEST
index 165823a..2178549 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,5 +1,6 @@
 Changes
 MANIFEST
+MANIFEST.SKIP
 README
 Makefile.PL
 DBSchema.pm

diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
new file mode 100644 (file)
index 0000000..ae335e7
--- /dev/null
+++ b/MANIFEST.SKIP
@@ -0,0 +1 @@
+CVS/