[Rt-commit] r2988 - in DBIx-SearchBuilder/trunk: . SearchBuilder ex ex/Example ex/Example/Model t

glasser at bestpractical.com glasser at bestpractical.com
Mon May 30 22:55:05 EDT 2005


Author: glasser
Date: Mon May 30 22:55:04 2005
New Revision: 2988

Added:
   DBIx-SearchBuilder/trunk/ex/
   DBIx-SearchBuilder/trunk/ex/Example/
   DBIx-SearchBuilder/trunk/ex/Example/Model/
   DBIx-SearchBuilder/trunk/ex/Example/Model/Address.pm
   DBIx-SearchBuilder/trunk/ex/Example/Model/Employee.pm
   DBIx-SearchBuilder/trunk/ex/create_tables.pl
Modified:
   DBIx-SearchBuilder/trunk/   (props changed)
   DBIx-SearchBuilder/trunk/Makefile.PL
   DBIx-SearchBuilder/trunk/SearchBuilder/Record.pm
   DBIx-SearchBuilder/trunk/SearchBuilder/SchemaGenerator.pm
   DBIx-SearchBuilder/trunk/t/10schema.t
   DBIx-SearchBuilder/trunk/t/testmodels.pl
Log:
 r33503 at stratton-five-seventy:  glasser | 2005-05-30 22:54:29 -0400
  * Make schema generation an optional feature 
  * Provide a stub _Init in D::S::Record
  * Change TableDescription to Schema
  * fix the isa check in AddModel to actually instantiate
  * add create_tables script


Modified: DBIx-SearchBuilder/trunk/Makefile.PL
==============================================================================
--- DBIx-SearchBuilder/trunk/Makefile.PL	(original)
+++ DBIx-SearchBuilder/trunk/Makefile.PL	Mon May 30 22:55:04 2005
@@ -12,9 +12,13 @@
 
 features(
 	'Lower case API' => [
-		-defaults => 0,
+		-default => 0,
 		'capitalization' => '0.03',
 	],
+	'Schema generation' => [
+	  -default => 1,
+	  'DBIx::DBSchema' => '',
+	],
 );
 auto_install();
 

Modified: DBIx-SearchBuilder/trunk/SearchBuilder/Record.pm
==============================================================================
--- DBIx-SearchBuilder/trunk/SearchBuilder/Record.pm	(original)
+++ DBIx-SearchBuilder/trunk/SearchBuilder/Record.pm	Mon May 30 22:55:04 2005
@@ -356,7 +356,6 @@
 =cut
 
 
-
 sub new  {
     my $proto = shift;
    
@@ -370,6 +369,9 @@
 
 # }}}
 
+# Not yet documented here.  Should generally be overloaded.
+sub _Init {}
+
 # {{{ sub Id and id
 
 =head2 id

Modified: DBIx-SearchBuilder/trunk/SearchBuilder/SchemaGenerator.pm
==============================================================================
--- DBIx-SearchBuilder/trunk/SearchBuilder/SchemaGenerator.pm	(original)
+++ DBIx-SearchBuilder/trunk/SearchBuilder/SchemaGenerator.pm	Mon May 30 22:55:04 2005
@@ -38,6 +38,8 @@
 of a subclass of C<DBIx::SearchBuilder::Record>, or the name of such a subclass; in the
 latter case, C<AddModel> will instantiate an object of the subclass.
 
+The model must define the instance methods C<Schema> and C<Table>.
+
 Returns true if the model was added successfully; returns a false C<Class::ReturnValue> error
 otherwise.
 
@@ -50,7 +52,7 @@
   # $model could either be a (presumably unfilled) object of a subclass of
   # DBIx::SearchBuilder::Record, or it could be the name of such a subclass.
   
-  unless (UNIVERSAL::isa($model, 'DBIx::SearchBuilder::Record')) {
+  unless (ref $model and UNIVERSAL::isa($model, 'DBIx::SearchBuilder::Record')) {
     my $new_model;
     eval { $new_model = $model->new; };
     
@@ -81,7 +83,7 @@
 sub CreateTableSQL {
   my $self = shift;
   # The sort here is to make it predictable, so that we can write tests.
-  return join "\n\n", map { "$_ ;" } sort $self->_db_schema->sql($self->handle->dbh);
+  return join "\n", map { "$_ ;\n" } sort $self->_db_schema->sql($self->handle->dbh);
 }
 
 =for private_doc _DBSchemaTableFromModel MODEL
@@ -96,22 +98,23 @@
   my $model = shift;
   
   my $table_name = $model->Table;
-  my $desc       = $model->TableDescription;
+  my $schema     = $model->Schema;
   
   my $primary = "id"; # TODO allow override
   my $primary_col = DBIx::DBSchema::Column->new({
     name => $primary,
     type => 'serial',
+    null => 'NOT NULL',
   });
   
   my @cols = ($primary_col);
   
   # The sort here is to make it predictable, so that we can write tests.
-  for my $field (sort keys %$desc) {
+  for my $field (sort keys %$schema) {
     push @cols, DBIx::DBSchema::Column->new({
       name => $field,
-      type => $desc->{$field}{'TYPE'},
-      null => 'null',
+      type => $schema->{$field}{'TYPE'},
+      null => 'NULL',
     });
   }
   

Added: DBIx-SearchBuilder/trunk/ex/Example/Model/Address.pm
==============================================================================
--- (empty file)
+++ DBIx-SearchBuilder/trunk/ex/Example/Model/Address.pm	Mon May 30 22:55:04 2005
@@ -0,0 +1,19 @@
+package Example::Model::Address;
+
+use base qw/DBIx::SearchBuilder::Record/;
+
+# Class and instance method
+
+sub Table { "Addresses" }
+
+# Class and instance method
+
+sub Schema {
+    return {
+        Name => { TYPE => 'varchar', },
+        Phone => { TYPE => 'varchar', },
+#        EmployeeId => { REFERENCES => 'Example::Model::Employee', },
+    }
+}
+
+1;
\ No newline at end of file

Added: DBIx-SearchBuilder/trunk/ex/Example/Model/Employee.pm
==============================================================================
--- (empty file)
+++ DBIx-SearchBuilder/trunk/ex/Example/Model/Employee.pm	Mon May 30 22:55:04 2005
@@ -0,0 +1,14 @@
+package Example::Model::Employee;
+
+use base qw/DBIx::SearchBuilder::Record/;
+
+sub Table { "Employees" }
+
+sub Schema {
+    return {
+      Name => { TYPE => 'varchar', },
+      Dexterity => { TYPE => 'integer', },
+    }
+}
+
+1;
\ No newline at end of file

Added: DBIx-SearchBuilder/trunk/ex/create_tables.pl
==============================================================================
--- (empty file)
+++ DBIx-SearchBuilder/trunk/ex/create_tables.pl	Mon May 30 22:55:04 2005
@@ -0,0 +1,58 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+# Note: this script does not actually *create* the tables;
+# however, it needs to connect to the database in order to
+# get the specific capabilities of your database (like type info).
+# CHANGE THIS TO FIT YOUR DATABASE:
+my @CONNECT_ARGS = (
+  Driver => 'Pg',
+  Database => 'test',
+  Host => 'localhost',
+  User => 'postgres',
+  Password => '',
+);
+
+use DBIx::SearchBuilder::Handle;
+use DBIx::SearchBuilder::SchemaGenerator;
+
+my $BaseClass;
+
+BEGIN {
+  unless (@ARGV) {
+    die <<USAGE;
+usage: $0 Base::Class [libpath ...]
+  This script will search \@INC (with the given paths added
+  to its beginning) for all classes beginning with Base::Class::,
+  which should be subclasses of DBIx::SearchBuilder::Record implementing
+  Schema and Table.  It prints SQL to generate tables standard output.
+  
+  While it does not actually create the tables, it needs to connect to your
+  database (for now, must be Pg or maybe mysql) in order to discover specific
+  capabilities of the target database.  You should edit \@CONNECT_ARGS in this
+  script to provide an appropriate database driver, database name, host, user, 
+  and password.
+USAGE
+  }
+  $BaseClass = shift;
+  unshift @INC, @ARGV;
+}  
+
+use Module::Pluggable search_path => $BaseClass, sub_name => 'models', instantiate => 'new';
+
+my $handle = DBIx::SearchBuilder::Handle->new;
+
+$handle->Connect( @CONNECT_ARGS );
+	
+my $SG = DBIx::SearchBuilder::SchemaGenerator->new($handle);
+
+die "Couldn't make SchemaGenerator" unless $SG;
+
+for my $model (__PACKAGE__->models) {
+  my $ret = $SG->AddModel($model);
+  $ret or die "couldn't add model $model: ".$ret->error_message;
+}
+
+print $SG->CreateTableSQL;

Modified: DBIx-SearchBuilder/trunk/t/10schema.t
==============================================================================
--- DBIx-SearchBuilder/trunk/t/10schema.t	(original)
+++ DBIx-SearchBuilder/trunk/t/10schema.t	Mon May 30 22:55:04 2005
@@ -4,14 +4,17 @@
 use warnings;
 use Test::More;
 
-use constant TESTS_PER_DRIVER => 12;
+use constant TESTS_PER_DRIVER => 13;
 our @AvailableDrivers;
 
 BEGIN {
   require("t/utils.pl");
   my $total = 3 + scalar(@AvailableDrivers) * TESTS_PER_DRIVER;
-
-  plan tests => $total;
+  if( not eval { require DBIx::DBSchema } ) {
+    plan skip_all => "DBIx::DBSchema not installed";
+  } else {
+    plan tests => $total;
+  }
 }
 
 BEGIN { 
@@ -65,10 +68,14 @@
       PRIMARY KEY (id)
     ) ;
 END_SCHEMA
+
+    my $employee = Sample::Employee->new;
+    
+    isa_ok($employee, 'Sample::Employee');
     
-    $ret = $SG->AddModel('Sample::Employee');
+    $ret = $SG->AddModel($employee);
 
-    ok($ret != 0, "added model from another real class");
+    ok($ret != 0, "added model from an instantiated object");
 
     is_ignoring_space($SG->CreateTableSQL, <<END_SCHEMA, "got the right schema");
     CREATE TABLE Addresses ( 

Modified: DBIx-SearchBuilder/trunk/t/testmodels.pl
==============================================================================
--- DBIx-SearchBuilder/trunk/t/testmodels.pl	(original)
+++ DBIx-SearchBuilder/trunk/t/testmodels.pl	Mon May 30 22:55:04 2005
@@ -8,7 +8,7 @@
 
 # Class and instance method
 
-sub TableDescription {
+sub Schema {
     return {
         Name => { TYPE => 'varchar', },
         Phone => { TYPE => 'varchar', },
@@ -22,7 +22,7 @@
 
 sub Table { "Employees" }
 
-sub TableDescription {
+sub Schema {
     return {
       Name => { TYPE => 'varchar', },
       Dexterity => { TYPE => 'integer', },


More information about the Rt-commit mailing list