[Rt-commit] r3060 - in DBIx-SearchBuilder/trunk: . SearchBuilder
inc/Module inc/Module/Install t
glasser at bestpractical.com
glasser at bestpractical.com
Thu Jun 2 20:11:25 EDT 2005
Author: glasser
Date: Thu Jun 2 20:11:24 2005
New Revision: 3060
Added:
DBIx-SearchBuilder/trunk/t/11schema_records.t
Modified:
DBIx-SearchBuilder/trunk/ (props changed)
DBIx-SearchBuilder/trunk/SearchBuilder/Record.pm
DBIx-SearchBuilder/trunk/inc/Module/Install.pm
DBIx-SearchBuilder/trunk/inc/Module/Install/AutoInstall.pm
DBIx-SearchBuilder/trunk/inc/Module/Install/Base.pm
DBIx-SearchBuilder/trunk/inc/Module/Install/Makefile.pm
DBIx-SearchBuilder/trunk/inc/Module/Install/Metadata.pm
DBIx-SearchBuilder/trunk/t/10schema.t
DBIx-SearchBuilder/trunk/t/testmodels.pl
Log:
r33831 at tin-foil: glasser | 2005-06-02 17:03:22 -0400
got ->1 REFERENCES working
Modified: DBIx-SearchBuilder/trunk/SearchBuilder/Record.pm
==============================================================================
--- DBIx-SearchBuilder/trunk/SearchBuilder/Record.pm (original)
+++ DBIx-SearchBuilder/trunk/SearchBuilder/Record.pm Thu Jun 2 20:11:24 2005
@@ -8,7 +8,6 @@
use Class::ReturnValue;
-
# {{{ Doc
=head1 NAME
@@ -369,8 +368,12 @@
# }}}
-# Not yet documented here. Should generally be overloaded.
-sub _Init {}
+# Not yet documented here. Should almost certainly be overloaded.
+sub _Init {
+ my $self = shift;
+ my $handle = shift;
+ $self->_Handle($handle);
+}
# {{{ sub Id and id
@@ -593,6 +596,30 @@
# }}}
+sub _ToRecord {
+ my $self = shift;
+ my $field = shift;
+ my $value = shift;
+
+ return unless defined $value;
+
+ my $schema = $self->Schema;
+ my $description = $schema->{$field};
+
+ return unless $description;
+
+ return $value unless $description->{'REFERENCES'};
+
+ my $classname = $description->{'REFERENCES'};
+
+ return unless UNIVERSAL::isa($classname, 'DBIx::SearchBuilder::Record');
+
+ # XXX TODO FIXME perhaps this is not what should be passed to new, but it needs it
+ my $object = $classname->new( $self->_Handle );
+ $object->LoadById( $value );
+ return $object;
+}
+
# sub {{{ ReadableAttributes
=head2 ReadableAttributes
@@ -641,7 +668,8 @@
sub __Value {
my $self = shift;
- my $field = lc(shift);
+ my $origfield = shift;
+ my $field = lc $origfield;
if (!$self->{'fetched'}{$field} and my $id = $self->id() ) {
my $pkey = $self->_PrimaryKey();
@@ -654,7 +682,11 @@
$self->{'fetched'}{$field} = 1;
}
- return($self->{'values'}{$field});
+ my $value = $self->{'values'}{$field};
+
+ $value = $self->_ToRecord($origfield, $value) if $self->can('Schema');
+
+ return $value;
}
# }}}
# {{{ sub _Value
@@ -895,6 +927,10 @@
Subclasses can override _Object to insert custom access control or
define default contructor arguments.
+Note that if you are using a C<Schema> with a C<REFERENCES> field,
+this is unnecessary: the method to access the column's value will
+automatically turn it into the appropriate object.
+
=cut
sub _Object {
Modified: DBIx-SearchBuilder/trunk/inc/Module/Install.pm
==============================================================================
--- DBIx-SearchBuilder/trunk/inc/Module/Install.pm (original)
+++ DBIx-SearchBuilder/trunk/inc/Module/Install.pm Thu Jun 2 20:11:24 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install.pm - /usr/local/share/perl/5.8.4/Module/Install.pm"
+#line 1 "inc/Module/Install.pm - /Library/Perl/5.8.6/Module/Install.pm"
package Module::Install;
$VERSION = '0.36';
Modified: DBIx-SearchBuilder/trunk/inc/Module/Install/AutoInstall.pm
==============================================================================
--- DBIx-SearchBuilder/trunk/inc/Module/Install/AutoInstall.pm (original)
+++ DBIx-SearchBuilder/trunk/inc/Module/Install/AutoInstall.pm Thu Jun 2 20:11:24 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/AutoInstall.pm - /usr/local/share/perl/5.8.4/Module/Install/AutoInstall.pm"
+#line 1 "inc/Module/Install/AutoInstall.pm - /Library/Perl/5.8.6/Module/Install/AutoInstall.pm"
package Module::Install::AutoInstall;
use Module::Install::Base; @ISA = qw(Module::Install::Base);
Modified: DBIx-SearchBuilder/trunk/inc/Module/Install/Base.pm
==============================================================================
--- DBIx-SearchBuilder/trunk/inc/Module/Install/Base.pm (original)
+++ DBIx-SearchBuilder/trunk/inc/Module/Install/Base.pm Thu Jun 2 20:11:24 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/Base.pm - /usr/local/share/perl/5.8.4/Module/Install/Base.pm"
+#line 1 "inc/Module/Install/Base.pm - /Library/Perl/5.8.6/Module/Install/Base.pm"
package Module::Install::Base;
#line 28
Modified: DBIx-SearchBuilder/trunk/inc/Module/Install/Makefile.pm
==============================================================================
--- DBIx-SearchBuilder/trunk/inc/Module/Install/Makefile.pm (original)
+++ DBIx-SearchBuilder/trunk/inc/Module/Install/Makefile.pm Thu Jun 2 20:11:24 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/Makefile.pm - /usr/local/share/perl/5.8.4/Module/Install/Makefile.pm"
+#line 1 "inc/Module/Install/Makefile.pm - /Library/Perl/5.8.6/Module/Install/Makefile.pm"
package Module::Install::Makefile;
use Module::Install::Base; @ISA = qw(Module::Install::Base);
Modified: DBIx-SearchBuilder/trunk/inc/Module/Install/Metadata.pm
==============================================================================
--- DBIx-SearchBuilder/trunk/inc/Module/Install/Metadata.pm (original)
+++ DBIx-SearchBuilder/trunk/inc/Module/Install/Metadata.pm Thu Jun 2 20:11:24 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/Metadata.pm - /usr/local/share/perl/5.8.4/Module/Install/Metadata.pm"
+#line 1 "inc/Module/Install/Metadata.pm - /Library/Perl/5.8.6/Module/Install/Metadata.pm"
package Module::Install::Metadata;
use Module::Install::Base; @ISA = qw(Module::Install::Base);
Modified: DBIx-SearchBuilder/trunk/t/10schema.t
==============================================================================
--- DBIx-SearchBuilder/trunk/t/10schema.t (original)
+++ DBIx-SearchBuilder/trunk/t/10schema.t Thu Jun 2 20:11:24 2005
@@ -63,6 +63,7 @@
is_ignoring_space($SG->CreateTableSQLText, <<END_SCHEMA, "got the right schema");
CREATE TABLE Addresses (
id serial NOT NULL ,
+ EmployeeId integer ,
Name varchar ,
Phone varchar ,
PRIMARY KEY (id)
@@ -80,6 +81,7 @@
is_ignoring_space($SG->CreateTableSQLText, <<END_SCHEMA, "got the right schema");
CREATE TABLE Addresses (
id serial NOT NULL ,
+ EmployeeId integer ,
Name varchar ,
Phone varchar ,
PRIMARY KEY (id)
@@ -106,4 +108,4 @@
unshift @_, $b; unshift @_, $a;
goto &is;
-}
\ No newline at end of file
+}
Added: DBIx-SearchBuilder/trunk/t/11schema_records.t
==============================================================================
--- (empty file)
+++ DBIx-SearchBuilder/trunk/t/11schema_records.t Thu Jun 2 20:11:24 2005
@@ -0,0 +1,135 @@
+#!/usr/bin/perl -w
+
+
+use strict;
+use warnings;
+use File::Spec;
+use Test::More;
+
+BEGIN { require "t/utils.pl" }
+our (@AvailableDrivers);
+
+use constant TESTS_PER_DRIVER => 10;
+
+my $total = scalar(@AvailableDrivers) * TESTS_PER_DRIVER;
+plan tests => $total;
+
+foreach my $d ( @AvailableDrivers ) {
+SKIP: {
+ unless( has_schema( 'TestApp', $d ) ) {
+ skip "No schema for '$d' driver", TESTS_PER_DRIVER;
+ }
+ unless( should_test( $d ) ) {
+ skip "ENV is not defined for driver '$d'", TESTS_PER_DRIVER;
+ }
+
+ my $handle = get_handle( $d );
+ connect_handle( $handle );
+ isa_ok($handle->dbh, 'DBI::db', "Got handle for $d");
+
+ my $ret = init_schema( 'TestApp', $handle );
+ isa_ok($ret,'DBI::st', "Inserted the schema. got a statement handle back");
+
+ my $emp = TestApp::Employee->new($handle);
+ my $e_id = $emp->Create( Name => 'RUZ' );
+ ok($e_id, "Got an id for the new employee: $e_id");
+ my $phone = TestApp::Phone->new($handle);
+ isa_ok( $phone, 'TestApp::Phone');
+ my $p_id = $phone->Create( Employee => $e_id, Phone => '+7(903)264-03-51');
+ # XXX: test fails if next string is commented
+ is($p_id, 1, "Loaded phone $p_id");
+ $phone->Load( $p_id );
+
+ my $obj = $phone->Employee;
+
+ ok($obj, "Employee #$e_id has phone #$p_id");
+ isa_ok( $obj, 'TestApp::Employee');
+ is($obj->id, $e_id);
+ is($obj->Name, 'RUZ');
+
+ # tests for no object mapping
+ my $val = $phone->Phone;
+ is( $val, '+7(903)264-03-51', 'Non-object things still work');
+
+ cleanup_schema( 'TestApp', $handle );
+}} # SKIP, foreach blocks
+
+1;
+
+
+package TestApp;
+sub schema_sqlite {
+[
+q{
+CREATE TABLE Employees (
+ id integer primary key,
+ Name varchar(36)
+)
+}, q{
+CREATE TABLE Phones (
+ id integer primary key,
+ Employee integer NOT NULL,
+ Phone varchar(18)
+) }
+]
+}
+
+sub schema_mysql {
+[ q{
+CREATE TEMPORARY TABLE Employees (
+ id integer AUTO_INCREMENT primary key,
+ Name varchar(36)
+)
+}, q{
+CREATE TEMPORARY TABLE Phones (
+ id integer AUTO_INCREMENT primary key,
+ Employee integer NOT NULL,
+ Phone varchar(18)
+)
+} ]
+}
+
+sub schema_pg {
+[ q{
+CREATE TEMPORARY TABLE Employees (
+ id serial PRIMARY KEY,
+ Name varchar
+)
+}, q{
+CREATE TEMPORARY TABLE Phones (
+ id serial PRIMARY KEY,
+ Employee integer references Employees(id),
+ Phone varchar
+)
+} ]
+}
+
+package TestApp::Employee;
+
+use base qw/DBIx::SearchBuilder::Record/;
+
+sub Table { 'Employees' }
+
+sub Schema {
+ return {
+ Name => { TYPE => 'varchar' },
+ };
+}
+
+1;
+
+package TestApp::Phone;
+
+use base qw/DBIx::SearchBuilder::Record/;
+
+sub Table { 'Phones' }
+
+sub Schema {
+ return {
+ Employee => { REFERENCES => 'TestApp::Employee' },
+ Phone => { TYPE => 'varchar' },
+ }
+}
+
+
+1;
Modified: DBIx-SearchBuilder/trunk/t/testmodels.pl
==============================================================================
--- DBIx-SearchBuilder/trunk/t/testmodels.pl (original)
+++ DBIx-SearchBuilder/trunk/t/testmodels.pl Thu Jun 2 20:11:24 2005
@@ -12,7 +12,7 @@
return {
Name => { TYPE => 'varchar', },
Phone => { TYPE => 'varchar', },
-# EmployeeId => { REFERENCES => 'Sample::Employee', },
+ EmployeeId => { REFERENCES => 'Sample::Employee', },
}
}
More information about the Rt-commit
mailing list