[Catalyst-commits] r8239 - in CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib: My MyApp MyApp/Controller MyApp/Form MyApp/Model

karpet at dev.catalyst.perl.org karpet at dev.catalyst.perl.org
Thu Aug 21 06:53:18 BST 2008


Author: karpet
Date: 2008-08-21 06:53:17 +0100 (Thu, 21 Aug 2008)
New Revision: 8239

Added:
   CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/Bar.pm
   CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/DB.pm
   CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/FooBar.pm
   CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Controller/Foo.pm
   CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Form/
   CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Form/Foo.pm
   CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Model/Bar.pm
Log:
expand tests

Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/Bar.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/Bar.pm	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/Bar.pm	2008-08-21 05:53:17 UTC (rev 8239)
@@ -0,0 +1,39 @@
+package My::Bar;
+use strict;
+use base qw( 
+    Rose::DB::Object 
+    Rose::DB::Object::Helpers 
+    Rose::DBx::Object::MoreHelpers    
+);
+use Carp;
+use Data::Dump qw( dump );
+use My::DB;
+
+__PACKAGE__->meta->setup(
+    table   => 'bars',
+    columns => [
+        id   => { type => 'serial',  not_null => 1, primary_key => 1 },
+        name => { type => 'varchar', length   => 16 },
+    ],
+    
+    primary_key_columns => ['id'],
+
+    relationships => [
+        foo => {
+            class      => 'My::FooBar',
+            column_map => { id => 'bar_id' },
+            type       => 'one to many',
+        },
+
+        foos => {
+            map_class => 'My::FooBar',
+            type      => 'many to many',
+        }
+    ],
+);
+
+sub init_db {
+    return My::DB->new;
+}
+
+1;

Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/DB.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/DB.pm	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/DB.pm	2008-08-21 05:53:17 UTC (rev 8239)
@@ -0,0 +1,50 @@
+package My::DB;
+use strict;
+use warnings;
+use base qw( Rose::DB );
+use Carp;
+
+# create a temp db
+my $db = Rose::DBx::TestDB->new;
+
+{
+    my $dbh = $db->dbh;
+
+    # create a schema to match this class
+    $dbh->do(
+        "create table foos 
+            ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(16) );"
+    );
+
+    $dbh->do(
+        "create table bars 
+            ( id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(16) );"
+    );
+
+    $dbh->do(
+        "create table foo_bars 
+            ( foo_id INTEGER references foos(id), bar_id INTEGER references bars(id) );"
+    );
+
+    # create some data
+    $dbh->do("insert into foos (name) values ('blue');");
+    $dbh->do("insert into bars (name) values ('green');");
+    $dbh->do("insert into bars (name) values ('red');");
+    $dbh->do("insert into foo_bars (foo_id, bar_id) values (1,1);");
+
+    # double check
+    my $sth = $dbh->prepare("SELECT * FROM foos");
+    $sth->execute;
+    croak "bad seed data in sqlite"
+        unless $sth->fetchall_arrayref->[0]->[0] == 1;
+
+    $sth = undef;    # http://rt.cpan.org/Ticket/Display.html?id=22688
+                     # does not seem to work.
+
+}
+
+sub new {
+    return $db;
+}
+
+1;

Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/FooBar.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/FooBar.pm	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/My/FooBar.pm	2008-08-21 05:53:17 UTC (rev 8239)
@@ -0,0 +1,37 @@
+package My::FooBar;
+use strict;
+use base qw(
+    Rose::DB::Object
+    Rose::DB::Object::Helpers
+    Rose::DBx::Object::MoreHelpers
+);
+use Carp;
+use Data::Dump qw( dump );
+use My::DB;
+
+__PACKAGE__->meta->setup(
+    table   => 'foo_bars',
+    columns => [
+        foo_id => { type => 'integer', not_null => 1 },
+        bar_id => { type => 'integer', not_null => 1 },
+    ],
+
+    primary_key_columns => [ 'foo_id', 'bar_id' ],
+
+    foreign_keys => [
+        foo => {
+            class       => 'My::Foo',
+            key_columns => { foo_id => 'id' }
+        },
+        bar => {
+            class       => 'My::Bar',
+            key_columns => { bar_id => 'id' }
+        },
+    ],
+);
+
+sub init_db {
+    return My::DB->new;
+}
+
+1;

Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Controller/Foo.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Controller/Foo.pm	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Controller/Foo.pm	2008-08-21 05:53:17 UTC (rev 8239)
@@ -0,0 +1,48 @@
+package MyApp::Controller::Foo;
+use strict;
+use base qw( CatalystX::CRUD::Test::Controller );
+use Carp;
+use MyApp::Form::Foo;
+
+__PACKAGE__->config(
+    form_class            => 'MyApp::Form::Foo',
+    form_fields           => [qw( id name )],
+    init_form             => 'init_with_foo',
+    init_object           => 'foo_from_form',
+    default_template      => 'no/such/file',
+    model_name            => 'Foo',
+    primary_key           => 'id',
+    view_on_single_result => 0,
+    page_size             => 50,
+    allow_GET_writes      => 0,
+);
+
+sub test : Local {
+
+    my ( $self, $c, @arg ) = @_;
+
+    my $thing = $c->model('Foo')->new_object( id => 1 );
+
+    for my $m (qw( create read update delete)) {
+        croak unless $thing->can($m);
+    }
+
+    # try fetching our seed data
+    $thing->read();
+
+    unless ( $thing->delegate->name eq 'blue' and $thing->name eq 'blue' ) {
+        $c->error('bad read');
+        return;
+    }
+
+    $c->res->body("foo is a-ok");
+
+}
+
+sub end : Private {
+    my ( $self, $c ) = @_;
+    $c->log->debug( "resp status = " . $c->res->status ) if $c->debug;
+    1;
+}
+
+1;

Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Form/Foo.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Form/Foo.pm	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Form/Foo.pm	2008-08-21 05:53:17 UTC (rev 8239)
@@ -0,0 +1,15 @@
+package MyApp::Form::Foo;
+use strict;
+use base qw( CatalystX::CRUD::Test::Form );
+
+sub foo_from_form {
+    my $self = shift;
+    return $self->SUPER::object_from_form(@_);
+}
+
+sub init_with_foo {
+    my $self = shift;
+    return $self->SUPER::init_with_object(@_);
+}
+
+1;

Added: CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Model/Bar.pm
===================================================================
--- CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Model/Bar.pm	                        (rev 0)
+++ CatalystX-CRUD/CatalystX-CRUD-Model-RDBO/trunk/t/lib/MyApp/Model/Bar.pm	2008-08-21 05:53:17 UTC (rev 8239)
@@ -0,0 +1,6 @@
+package MyApp::Model::Bar;
+use base qw( CatalystX::CRUD::Model::RDBO );
+__PACKAGE__->config->{object_class} = 'MyApp::Object';
+__PACKAGE__->config->{name}         = 'My::Bar';
+
+1;




More information about the Catalyst-commits mailing list