moved shit to trunk

21 files changed, 1076 insertions, 0 deletions

diff --git a/t/01app.t b/t/01app.t
new file mode 100644
index 0000000..c72e2c7
--- /dev/null
+++ b/t/01app.t
@@ -0,0 +1,7 @@
+use strict;
+use warnings;
+use Test::More tests => 2;
+
+BEGIN { use_ok 'Catalyst::Test', 'ComponentUI' }
+
+ok( request('/')->is_success, 'Request should succeed' );
diff --git a/t/02pod.t b/t/02pod.t
new file mode 100644
index 0000000..251640d
--- /dev/null
+++ b/t/02pod.t
@@ -0,0 +1,9 @@
+use strict;
+use warnings;
+use Test::More;
+
+eval "use Test::Pod 1.14";
+plan skip_all => 'Test::Pod 1.14 required' if $@;
+plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+all_pod_files_ok();
diff --git a/t/03podcoverage.t b/t/03podcoverage.t
new file mode 100644
index 0000000..d8b1422
--- /dev/null
+++ b/t/03podcoverage.t
@@ -0,0 +1,30 @@
+use strict;
+use warnings;
+use Test::More;
+
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@;
+plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+my @modules = sort { $a cmp $b } (Test::Pod::Coverage::all_modules());
+@modules = grep {!/^ComponentUI::/} @modules;
+plan tests => scalar(@modules);
+
+# methods to ignore on all modules
+my $exceptions = {
+  ignore => [
+              qw/ BUILD build_ can_ clear_ has_ do_ adopt_ accept_
+                  apply_ layout value meta /
+            ]
+};
+
+foreach my $module (@modules) {
+  # build parms up from ignore list
+  my $parms = {};
+  $parms->{trustme} =
+    [ map { qr/^$_/ } @{ $exceptions->{ignore} } ]
+    if exists($exceptions->{ignore});
+
+  # run the test with the potentially modified parm set
+  pod_coverage_ok($module, $parms, "$module POD coverage");
+}
diff --git a/t/04load_all.t b/t/04load_all.t
new file mode 100644
index 0000000..a7923fc
--- /dev/null
+++ b/t/04load_all.t
@@ -0,0 +1,15 @@
+use strict;
+use warnings;
+use Test::More ();
+
+Test::More::plan('no_plan');
+
+use Module::Pluggable::Object;
+
+my $finder = Module::Pluggable::Object->new(
+               search_path => [ 'Reaction' ],
+             );
+
+foreach my $class (sort $finder->plugins) {
+  Test::More::use_ok($class);
+}
diff --git a/t/05reflect_attr_from.t b/t/05reflect_attr_from.t
new file mode 100644
index 0000000..67974ba
--- /dev/null
+++ b/t/05reflect_attr_from.t
@@ -0,0 +1,34 @@
+package TestMe2;
+use strict;
+use warnings;
+use Reaction::Class;
+use Reaction::Types::DateTime;
+
+has id         => (is => 'ro', required => 1, isa => 'Int');
+has username   => (is => 'rw', required => 1, isa => 'NonEmptySimpleStr');
+has created_d  => (is => 'rw', required => 1, isa => 'DateTime');
+
+1;
+
+package TestMe;
+use strict;
+use warnings;
+use Reaction::Class;
+
+reflect_attributes_from('TestMe2' => qw(id username created_d));
+
+1;
+
+package main;
+use strict;
+use warnings;
+use Data::Dumper;
+use Test::More;
+
+plan tests => 1;
+
+my @test_list  = TestMe->meta->get_attribute_list;
+my @test2_list = TestMe2->meta->get_attribute_list;
+is_deeply(\@test_list, \@test2_list, "Attribute lists match");
+
+1;
diff --git a/t/im_dbic.t b/t/im_dbic.t
new file mode 100644
index 0000000..db4f772
--- /dev/null
+++ b/t/im_dbic.t
@@ -0,0 +1,15 @@
+use lib 't/lib';
+use strict;
+use warnings;
+
+use Test::Class;
+use RTest::InterfaceModel::DBIC;
+use RTest::InterfaceModel::Reflector::DBIC;
+
+Test::Class->runtests(
+  RTest::InterfaceModel::DBIC->new(),
+);
+
+Test::Class->runtests(
+  RTest::InterfaceModel::Reflector::DBIC->new(),
+);
diff --git a/t/lib/RTest/InterfaceModel/DBIC.pm b/t/lib/RTest/InterfaceModel/DBIC.pm
new file mode 100644
index 0000000..3a2bf57
--- /dev/null
+++ b/t/lib/RTest/InterfaceModel/DBIC.pm
@@ -0,0 +1,140 @@
+package RTest::InterfaceModel::DBIC;
+
+use base qw/Reaction::Test::WithDB Reaction::Object/;
+use Reaction::Class;
+use ComponentUI::TestModel;
+use Test::More ();
+
+has '+schema_class' => (default => sub { 'RTest::TestDB' });
+
+has im_schema => (is =>'ro', isa => 'ComponentUI::TestModel', lazy_build => 1);
+sub build_im_schema{
+  my $self = shift;
+
+  my (@dm) = ComponentUI::TestModel->domain_models;
+  Test::More::ok(@dm == 1, 'Correct number of Domain Models');
+  my $dm = shift @dm;
+  Test::More::ok($dm->name eq '_testdb_schema', 'Domain Model created correctly');
+
+  ComponentUI::TestModel->new($dm->name => $self->schema);
+}
+
+sub test_SchemaClass :Tests {
+  my $self = shift;
+  my $s = $self->im_schema;
+
+  #just make sure here...
+  Test::More::isa_ok( $s, 'Reaction::InterfaceModel::Object',
+                  'Correctly override default base object' );
+
+  my %pa = map{$_->name => $_ } $s->parameter_attributes;
+  Test::More::ok(keys %pa == 3,  'Correct number of Parameter Attributes');
+
+  Test::More::ok($pa{Foo} && $pa{'Bar'} && $pa{'Baz'},
+                 'Parameter Attributes named correctly');
+
+  #for now since we have no generic collection object
+  Test::More::ok
+      ( $pa{Foo}->_isa_metadata eq 'Reaction::InterfaceModel::DBIC::Collection',
+        'Parameter Attributes typed correctly' );
+
+  Test::More::is($pa{Baz}->reader, 'bazes', 'Correct Baz reader created');
+  Test::More::is($pa{Foo}->reader, 'foo_collection', 'Correct Foo reader created');
+  Test::More::is($pa{Bar}->reader, 'bar_collection', 'Correct Bar reader created');
+
+  #is this check good enough? Moose will take care of checking the type constraints,
+  # so i dont need tocheck that Moose++ !!
+  my $foo1 = $s->foo_collection;
+  my $foo2 = $s->foo_collection;
+  Test::More::ok
+      (Scalar::Util::refaddr($foo1) ne Scalar::Util::refaddr($foo2),
+       'Fresh Collections work');
+}
+
+sub test_ObjectClass :Tests  {
+  my $self = shift;
+
+  my $collection = $self->im_schema->foo_collection;
+  Test::More::ok( my $im = $collection->find({ id => 1}), 'Find call successful');
+
+  Test::More::isa_ok( $im, 'ComponentUI::TestModel::Foo',
+                  'Correct result class set' );
+
+  my %pa = map{$_->name => $_ } $im->parameter_attributes;
+  Test::More::ok(keys %pa == 4,  'Correct number of Parameter Attributes');
+
+  Test::More::is( $pa{first_name}->_isa_metadata, 'NonEmptySimpleStr'
+                  ,'Column ParameterAttribute typed correctly');
+
+  Test::More::is
+      ($pa{baz_list}->_isa_metadata, 'Reaction::InterfaceModel::DBIC::Collection',
+       "Relationship detected successfully");
+
+  my (@dm) = $im->domain_models;
+  Test::More::ok(@dm == 1, 'Correct number of Domain Models');
+  my $dm = shift @dm;
+  Test::More::is($dm->name, '_foo_store', 'Domain Model created correctly');
+
+  my $rs = $collection->_override_action_args_for->{target_model};
+  Test::More::isa_ok( $rs, 'DBIx::Class::ResultSet',
+                      'Collection target_type ISA ResultSet' );
+
+  my $row = $im->_default_action_args_for->{target_model};
+  Test::More::isa_ok( $row, 'DBIx::Class::Row', 'Collection target_type ISA Row' );
+
+  my $ctx = $self->simple_mock_context;
+
+  my $create = $collection->action_for('Create', ctx => $ctx);
+  Test::More::isa_ok( $create, 'Reaction::InterfaceModel::Action',
+                      'Create action isa Action' );
+
+  Test::More::isa_ok( $create, 'ComponentUI::TestModel::Foo::Action::Create',
+                      'Create action has correct name' );
+
+  Test::More::isa_ok
+      ( $create, 'Reaction::InterfaceModel::Action::DBIC::ResultSet::Create',
+        'Create action isa Action::DBIC::ResultSet::Create' );
+
+
+  my $update = $im->action_for('Update', ctx => $ctx);
+  Test::More::isa_ok( $update, 'Reaction::InterfaceModel::Action',
+                      'Update action isa Action' );
+
+  Test::More::isa_ok( $update, 'ComponentUI::TestModel::Foo::Action::Update',
+                      'Update action has correct name' );
+
+  Test::More::isa_ok
+      ( $update, 'Reaction::InterfaceModel::Action::DBIC::Result::Update',
+        'Update action isa Action::DBIC::ResultSet::Update' );
+
+  my $delete = $im->action_for('Delete', ctx => $ctx);
+  Test::More::isa_ok( $delete, 'Reaction::InterfaceModel::Action',
+                      'Delete action isa Action' );
+
+  Test::More::isa_ok( $delete, 'ComponentUI::TestModel::Foo::Action::Delete',
+                      'Delete action has correct name' );
+
+  Test::More::isa_ok
+      ( $delete, 'Reaction::InterfaceModel::Action::DBIC::Result::Delete',
+        'Delete action isa Action::DBIC::ResultSet::Delete' );
+
+
+  my $custom = $im->action_for('CustomAction', ctx => $ctx);
+  Test::More::isa_ok( $custom, 'Reaction::InterfaceModel::Action',
+                      'CustomAction isa Action' );
+
+  Test::More::isa_ok( $custom, 'ComponentUI::TestModel::Foo::Action::CustomAction',
+                      'CustomAction has correct name' );
+
+  my %params = map {$_->name => $_ } $custom->parameter_attributes;
+  Test::More::ok(exists $params{$_}, "Field ${_} reflected")
+      for qw(first_name last_name baz_list);
+
+  #TODO -- will I need a mock $c object or what? I dont really know much about
+  # testingcat apps, who wants to volunteer?
+  # main things needing testing is attribute reflection
+  # and correct action class creation (superclasses)
+}
+
+
+1;
diff --git a/t/lib/RTest/InterfaceModel/Reflector/DBIC.pm b/t/lib/RTest/InterfaceModel/Reflector/DBIC.pm
new file mode 100644
index 0000000..1215788
--- /dev/null
+++ b/t/lib/RTest/InterfaceModel/Reflector/DBIC.pm
@@ -0,0 +1,317 @@
+package RTest::InterfaceModel::Reflector::DBIC;
+
+use base qw/Reaction::Test::WithDB Reaction::Object/;
+use Reaction::Class;
+use Class::MOP ();
+use ComponentUI::TestModel;
+use Test::More ();
+use Reaction::InterfaceModel::Reflector::DBIC;
+
+has '+schema_class' => (default => sub { 'RTest::TestDB' });
+
+has im_schema => (is =>'ro', isa => 'RTest::TestIM', lazy_build => 1);
+
+#at the moment I am only testing with the "reflect all" functionality
+#when I have time I will write test cases that cover all the other bases
+#it's just kind of a pain in the ass right now and I am behind on a lot of other shit.
+
+sub build_im_schema{
+  my $self = shift;
+
+  my $reflector = Reaction::InterfaceModel::Reflector::DBIC
+    ->new(model_class => 'RTest::TestIM');
+
+  $reflector->reflect_model(
+                            domain_model_class => 'RTest::TestDB',
+                            #exclude_submodels  => ['FooBaz'],
+                            reflect_submodels  => [qw/Foo Bar Baz/]
+                           );
+  my (@dm) = RTest::TestIM->domain_models;
+  Test::More::ok(@dm == 1, 'Correct number of Domain Models');
+  my $dm = shift @dm;
+
+  print STDERR "instantiating with domain name of " . $dm->name . "\n";
+  RTest::TestIM->new($dm->name => $self->schema);
+}
+
+sub test_classnames : Tests{
+  my $self = shift;
+
+  my $reflector = Reaction::InterfaceModel::Reflector::DBIC
+    ->new(model_class => 'RTest::__TestIM');
+
+  Test::More::ok(
+                 Class::MOP::is_class_loaded( 'RTest::__TestIM'),
+                 "Successfully created IM class"
+                );
+
+  Test::More::is(
+                 $reflector->submodel_classname_from_source_name('Foo'),
+                 'RTest::__TestIM::Foo',
+                 'Correct naming scheme for submodels'
+                );
+
+  Test::More::is(
+                 $reflector->classname_for_collection_of('RTest::__TestIM::Foo'),
+                 'RTest::__TestIM::Foo::Collection',
+                 'Correct naming scheme for submodel collections'
+                );
+}
+
+sub test_reflect_model :Tests {
+  my $self = shift;
+  my $s = $self->im_schema;
+
+    Test::More::isa_ok( $s, 'Reaction::InterfaceModel::Object',
+                        'Correct base' );
+
+  my %pa = map{$_->name => $_ } $s->parameter_attributes;
+  Test::More::ok(keys %pa == 3,  'Correct number of Parameter Attributes');
+
+  Test::More::ok($pa{Foo} && $pa{'Bar'} && $pa{'Baz'},
+                 'Parameter Attributes named correctly');
+
+  for my $submodel (values %pa){
+    Test::More::ok(
+                   $submodel->_isa_metadata->isa('Reaction::InterfaceModel::Collection::Virtual::ResultSet'),
+                   'Parameter Attribute typed correctly'
+                  );
+  }
+
+  Test::More::can_ok($s, qw/foo_collection bar_collection baz_collection/);
+
+  for ( qw/Foo Bar Baz/ ){
+    Test::More::ok(
+                   Class::MOP::is_class_loaded("RTest::TestIM::${_}"),
+                   "Successfully created ${_} IM class"
+                  );
+    Test::More::ok(
+                   Class::MOP::is_class_loaded("RTest::TestIM::${_}::Collection"),
+                   "Successfully created ${_} IM class Collection"
+                  );
+  }
+}
+
+
+sub test_add_submodel_to_model :Tests {
+  my $self = shift;
+  my $s = $self->im_schema;
+
+  for (qw/Foo Bar Baz /) {
+    my $attr = $s->meta->find_attribute_by_name($_);
+    my $reader = $_;
+    $reader =~ s/([a-z0-9])([A-Z])/${1}_${2}/g ;
+    $reader = lc($reader) . "_collection";
+
+    Test::More::ok( $attr->is_required,           "${_} is required");
+    Test::More::ok( $attr->has_reader,            "${_} has a reader");
+    Test::More::ok( $attr->has_predicate,         "${_} has a predicate");
+    Test::More::ok( $attr->has_domain_model,      "${_} has a domain_model");
+    Test::More::ok( $attr->has_default,           "${_} has a default");
+    Test::More::ok( $attr->is_default_a_coderef,  "${_}'s defaultis a coderef");
+    Test::More::is( $attr->reader,   $reader,     "Correct ${_} reader");
+    Test::More::is( $attr->domain_model, "_RTest_TestDB", "Correct ${_} domain_model");
+
+    Test::More::isa_ok(
+                       $s->$reader,
+                       "RTest::TestIM::${_}::Collection",
+                       "${_} default method works"
+                      );
+
+  }
+}
+
+sub test_reflect_collection_for :Tests{
+  my $self = shift;
+  my $s = $self->im_schema;
+
+  for ( qw/Foo Bar Baz/ ){
+    my $reader = $s->meta->find_attribute_by_name($_)->reader;
+    my $collection = $s->$reader;
+
+    Test::More::is(
+                   $collection->meta->name,
+                   "RTest::TestIM::${_}::Collection",
+                   "Correct Classname"
+                  );
+    Test::More::isa_ok(
+                       $collection,
+                       'Reaction::InterfaceModel::Collection',
+                       "Collection ISA Collection"
+                      );
+    Test::More::isa_ok(
+                       $collection,
+                       'Reaction::InterfaceModel::Collection::Virtual',
+                       "Collection ISA virtual collection"
+                      );
+    Test::More::isa_ok(
+                       $collection,
+                       'Reaction::InterfaceModel::Collection::Virtual::ResultSet',
+                       "Collection ISA virtual resultset"
+                      );
+    Test::More::can_ok($collection, '_build_im_class');
+    Test::More::is(
+                   $collection->_build_im_class,
+                   "RTest::TestIM::${_}",
+                   "Collection has correct _im_class"
+                  );
+  }
+}
+
+sub test_reflect_submodel :Tests{
+  my $self = shift;
+  my $s = $self->im_schema;
+
+  for my $sm ( qw/Foo Bar Baz/ ){
+    my $reader = $s->meta->find_attribute_by_name($sm)->reader;
+    my $collection = $s->$reader;
+    my ($member) = $collection->members;
+    Test::More::ok($member, "Successfully retrieved member");
+    Test::More::isa_ok(
+                       $member,
+                       "Reaction::InterfaceModel::Object",
+                       "Member isa IM::Object"
+                      );
+    Test::More::isa_ok($member, $collection->_im_class);
+
+    my (@dm) = $member->domain_models;
+    Test::More::ok(@dm == 1, 'Correct number of Domain Models');
+    my $dm = shift @dm;
+
+    my $dm_name = $sm;
+    $dm_name =~ s/([a-z0-9])([A-Z])/${1}_${2}/g ;
+    $dm_name = "_" . lc($dm_name) . "_store";
+
+    Test::More::is($dm->_is_metadata, "rw", "Correct is metadata");
+    Test::More::ok($dm->is_required,  "DM is_required");
+    Test::More::is($dm->name, $dm_name, "Correct DM name");
+    Test::More::can_ok($member, "inflate_result");
+    Test::More::is(
+                   $dm->_isa_metadata,
+                   "RTest::TestDB::${sm}",
+                   "Correct isa metadata"
+                  );
+
+    my %attrs = map { $_->name => $_ } $member->parameter_attributes;
+    my $target;
+    if(   $sm eq "Bar"){$target = 4; }
+    elsif($sm eq "Baz"){$target = 3; }
+    elsif($sm eq "Foo"){$target = 4; }
+    Test::More::is( scalar keys %attrs, $target, "Correct # of attributes");
+
+    for my $attr_name (keys %attrs){
+      my $attr = $attrs{$attr_name};
+      Test::More::ok($attr->is_lazy,                "is lazy");
+      Test::More::ok($attr->is_required,            "is required");
+      Test::More::ok($attr->has_clearer,            "has clearer");
+      Test::More::ok($attr->has_default,            "has defau;t");
+      Test::More::ok($attr->has_predicate,          "has predicate");
+      Test::More::ok($attr->has_domain_model,       "has domain model");
+      Test::More::ok($attr->has_orig_attr_name,     "has orig attr name");
+      Test::More::ok($attr->is_default_a_coderef,   "default is coderef");
+      Test::More::is($attr->_is_metadata,  "ro",    "Correct is metadata");
+      Test::More::is($attr->domain_model, $dm_name, "Correct domain model");
+      Test::More::is($attr->orig_attr_name, $attr_name, "Correct orig attr name");
+    }
+
+    if($sm eq "Foo"){
+      Test::More::is($attrs{id}->_isa_metadata, "Int", "Correct id isa metadata");
+      Test::More::is($attrs{first_name}->_isa_metadata, "NonEmptySimpleStr", "Correct first_name isa metadata");
+      Test::More::is($attrs{last_name}->_isa_metadata,  "NonEmptySimpleStr", "Correct last_name isa metadata");
+      Test::More::is(
+                     $attrs{baz_list}->_isa_metadata,
+                     "RTest::TestIM::Baz::Collection",
+                     "Correct baz_list isa metadata"
+                    );
+    } elsif($sm eq 'Bar'){
+      Test::More::is($attrs{name}->_isa_metadata, "NonEmptySimpleStr", "Correct name isa metadata");
+      Test::More::is($attrs{foo}->_isa_metadata, "RTest::TestIM::Foo", "Correct foo isa metadata");
+      Test::More::is($attrs{published_at}->_isa_metadata, "DateTime",  "Correct published_at isa metadata");
+      Test::More::is($attrs{avatar}->_isa_metadata, "File",            "Correct avatar isa metadata");
+    } elsif($sm eq "Baz"){
+      Test::More::is($attrs{id}->_isa_metadata, "Int", "Correct id isa metadata");
+      Test::More::is($attrs{name}->_isa_metadata, "NonEmptySimpleStr", "Correct name isa metadata");
+      Test::More::is(
+                     $attrs{foo_list}->_isa_metadata,
+                     "RTest::TestIM::Foo::Collection",
+                     "Correct foo_list isa metadata"
+                    );
+    }
+
+  }
+}
+
+sub test_reflect_submodel_action :Tests{
+  my $self = shift;
+  my $s = $self->im_schema;
+
+  for my $sm ( qw/Foo Bar Baz/ ){
+    my $reader = $s->meta->find_attribute_by_name($sm)->reader;
+    my $collection = $s->$reader;
+    my ($member) = $collection->members;
+    Test::More::ok($member, "Successfully retrieved member");
+    Test::More::isa_ok(
+                       $member,
+                       "Reaction::InterfaceModel::Object",
+                       "Member isa IM::Object"
+                      );
+    Test::More::isa_ok($member, $collection->_im_class);
+
+    my $ctx = $self->simple_mock_context;
+    foreach my $action_name (qw/Update Delete Create/){
+
+      my $target_im = $action_name eq 'Create' ? $collection : $member;
+      my $action = $target_im->action_for($action_name, ctx => $ctx);
+
+      Test::More::isa_ok( $action, "Reaction::InterfaceModel::Action",
+                          "Create action isa Action" );
+      Test::More::is(
+                     $action->meta->name,
+                     "RTest::TestIM::${sm}::Action::${action_name}",
+                     "${action_name} action has correct name"
+                    );
+
+      my $base = 'Reaction::InterfaceModel::Action::DBIC' .
+        ($action_name eq 'Create' ? '::ResultSet::Create' : "::Result::${action_name}");
+      Test::More::isa_ok($action, $base, 'Create action has correct base');
+
+
+      my %attrs = map { $_->name => $_ } $action->parameter_attributes;
+      my $attr_num;
+      if($action_name eq 'Delete'){next; }
+      elsif($sm eq "Bar"){$attr_num = 4; }
+      elsif($sm eq "Baz"){$attr_num = 1; }
+      elsif($sm eq "Foo"){$attr_num = 3; }
+      Test::More::is( scalar keys %attrs, $attr_num, "Correct # of attributes");
+      if($attr_num != keys %attrs ){
+        print STDERR "\t..." . join ", ", keys %attrs, "\n";
+      }
+
+      for my $attr_name (keys %attrs){
+        my $attr = $attrs{$attr_name};
+        Test::More::ok($attr->has_predicate,        "has predicate");
+        Test::More::is($attr->_is_metadata,  "rw",  "Correct is metadata");
+        if ($attr->is_required){
+          Test::More::ok($attr->is_lazy,     "is lazy");
+          Test::More::ok($attr->has_default, "has default");
+          Test::More::ok($attr->is_default_a_coderef, "default is coderef");
+        }
+      }
+
+      if($sm eq "Foo"){
+        Test::More::is($attrs{first_name}->_isa_metadata, "NonEmptySimpleStr", "Correct first_name isa metadata");
+        Test::More::is($attrs{last_name}->_isa_metadata,  "NonEmptySimpleStr", "Correct last_name isa metadata");
+        Test::More::is($attrs{baz_list}->_isa_metadata,  "ArrayRef", "Correct baz_list isa metadata");
+      } elsif($sm eq 'Bar'){
+        Test::More::is($attrs{name}->_isa_metadata, "NonEmptySimpleStr",  "Correct name isa metadata");
+        Test::More::is($attrs{foo}->_isa_metadata,  "RTest::TestDB::Foo", "Correct foo isa metadata");
+        Test::More::is($attrs{published_at}->_isa_metadata, "DateTime",   "Correct published_at isa metadata");
+        Test::More::is($attrs{avatar}->_isa_metadata, "File",             "Correct avatar isa metadata");
+      } elsif($sm eq "Baz"){
+        Test::More::is($attrs{name}->_isa_metadata, "NonEmptySimpleStr",  "Correct name isa metadata");
+      }
+    }
+  }
+}
+
+1;
diff --git a/t/lib/RTest/TestDB.pm b/t/lib/RTest/TestDB.pm
new file mode 100644
index 0000000..25012d2
--- /dev/null
+++ b/t/lib/RTest/TestDB.pm
@@ -0,0 +1,29 @@
+package # hide from PAUSE
+  RTest::TestDB;
+
+use base qw/DBIx::Class::Schema/;
+
+use DateTime;
+
+__PACKAGE__->load_classes;
+
+sub setup_test_data {
+  my $self = shift;
+  $self->populate('Foo' => [
+    [ qw/ first_name last_name / ],
+    map { (
+      [ "Joe", "Bloggs $_" ],
+      [ "John", "Smith $_" ],
+    ) } (1 .. 50)
+  ]);
+  $self->populate('Baz' => [
+    [ qw/ name / ],
+    map { [ "Baz $_" ] } (1 .. 4)
+  ]);
+  $self->populate('Bar' => [
+    [ qw/ name foo_id / ],
+    map { [ "Bar $_", $_ ] } (1 .. 4)
+  ]);
+}
+
+1;
diff --git a/t/lib/RTest/TestDB/Bar.pm b/t/lib/RTest/TestDB/Bar.pm
new file mode 100644
index 0000000..4e22d06
--- /dev/null
+++ b/t/lib/RTest/TestDB/Bar.pm
@@ -0,0 +1,34 @@
+package # hide from PAUSE
+  RTest::TestDB::Bar;
+
+use DBIx::Class 0.07;
+
+use base qw/DBIx::Class Reaction::Object/;
+use Reaction::Class;
+use Reaction::Types::DateTime;
+use Reaction::Types::File;
+
+has 'name' => (isa => 'NonEmptySimpleStr', is => 'rw', required => 1);
+has 'foo' => (isa => 'RTest::TestDB::Foo', is => 'rw', required => 1);
+has 'published_at' => (isa => 'DateTime', is => 'rw');
+has 'avatar' => (isa => 'File', is => 'rw');
+
+__PACKAGE__->load_components(qw/InflateColumn::DateTime Core/);
+
+__PACKAGE__->table('bar');
+
+__PACKAGE__->add_columns(
+  name => { data_type => 'varchar', size => 255 },
+  foo_id => { data_type => 'integer', size => 16 },
+  published_at => { data_type => 'datetime', is_nullable => 1 },
+  avatar => { data_type => 'blob', is_nullable => 1 },
+);
+
+__PACKAGE__->set_primary_key('name');
+
+__PACKAGE__->belongs_to(
+  'foo' => 'RTest::TestDB::Foo',
+  { 'foreign.id' => 'self.foo_id' }
+);
+
+1;
diff --git a/t/lib/RTest/TestDB/Baz.pm b/t/lib/RTest/TestDB/Baz.pm
new file mode 100644
index 0000000..848cb4f
--- /dev/null
+++ b/t/lib/RTest/TestDB/Baz.pm
@@ -0,0 +1,29 @@
+package # hide from PAUSE
+  RTest::TestDB::Baz;
+
+use DBIx::Class 0.07;
+
+use base qw/DBIx::Class Reaction::Object/;
+use Reaction::Class;
+
+has 'id' => (isa => 'Int', is => 'ro', required => 1);
+has 'name' => (isa => 'NonEmptySimpleStr', is => 'rw', required => 1);
+has 'foo_list' => (isa => 'ArrayRef', is => 'ro', required => 1);
+
+__PACKAGE__->load_components(qw/InflateColumn::DateTime Core/);
+
+__PACKAGE__->table('baz');
+
+__PACKAGE__->add_columns(
+  id => { data_type => 'integer', size => 16, is_auto_increment => 1 },
+  name => { data_type => 'varchar', size => 255 },
+);
+
+sub display_name { shift->name; }
+
+__PACKAGE__->set_primary_key('id');
+
+__PACKAGE__->has_many('links_to_foo_list' => 'RTest::TestDB::FooBaz', 'baz');
+__PACKAGE__->many_to_many('foo_list' => 'links_to_foo_list' => 'foo');
+
+1;
diff --git a/t/lib/RTest/TestDB/Foo.pm b/t/lib/RTest/TestDB/Foo.pm
new file mode 100644
index 0000000..5733054
--- /dev/null
+++ b/t/lib/RTest/TestDB/Foo.pm
@@ -0,0 +1,42 @@
+package # hide from PAUSE
+  RTest::TestDB::Foo;
+
+use DBIx::Class 0.07;
+
+use base qw/DBIx::Class Reaction::Object/;
+use Reaction::Class;
+
+has 'id' => (isa => 'Int', is => 'ro', required => 1);
+has 'first_name' => (isa => 'NonEmptySimpleStr', is => 'rw', required => 1);
+has 'last_name' => (isa => 'NonEmptySimpleStr', is => 'rw', required => 1);
+has 'baz_list' => (
+  isa => 'ArrayRef', is => 'rw', required => 1,
+  reader => 'get_baz_list', writer => 'set_baz_list'
+);
+
+__PACKAGE__->load_components(qw/InflateColumn::DateTime Core/);
+
+__PACKAGE__->table('foo');
+
+__PACKAGE__->add_columns(
+  id => { data_type => 'integer', size => 16, is_auto_increment => 1 },
+  first_name => { data_type => 'varchar', size => 255 },
+  last_name => { data_type => 'varchar', size => 255 },
+);
+
+sub display_name {
+  my $self = shift;
+  return join(' ', $self->first_name, $self->last_name);
+}
+
+__PACKAGE__->set_primary_key('id');
+
+__PACKAGE__->has_many('links_to_baz_list' => 'RTest::TestDB::FooBaz', 'foo');
+__PACKAGE__->many_to_many('baz_list' => 'links_to_baz_list' => 'baz');
+
+{
+  no warnings 'redefine';
+  *get_baz_list = sub { [ shift->baz_list->all ] };
+}
+
+1;
diff --git a/t/lib/RTest/TestDB/FooBaz.pm b/t/lib/RTest/TestDB/FooBaz.pm
new file mode 100644
index 0000000..695b141
--- /dev/null
+++ b/t/lib/RTest/TestDB/FooBaz.pm
@@ -0,0 +1,22 @@
+package # hide from PAUSE
+  RTest::TestDB::FooBaz;
+
+use DBIx::Class 0.07;
+
+use base qw/DBIx::Class/;
+
+__PACKAGE__->load_components(qw/InflateColumn::DateTime Core/);
+
+__PACKAGE__->table('foo_baz');
+
+__PACKAGE__->add_columns(
+  foo => { data_type => 'integer', size => 16 },
+  baz => { data_type => 'integer', size => 16 },
+);
+
+__PACKAGE__->set_primary_key(qw/foo baz/);
+
+__PACKAGE__->belongs_to('foo' => 'RTest::TestDB::Foo');
+__PACKAGE__->belongs_to('baz' => 'RTest::TestDB::Baz');
+
+1;
diff --git a/t/lib/RTest/UI/FocusStack.pm b/t/lib/RTest/UI/FocusStack.pm
new file mode 100644
index 0000000..b30f060
--- /dev/null
+++ b/t/lib/RTest/UI/FocusStack.pm
@@ -0,0 +1,56 @@
+package RTest::UI::FocusStack;
+
+use base qw/Test::Class/;
+use Reaction::Class;
+use Reaction::UI::FocusStack;
+use aliased "Reaction::UI::ViewPort";
+use Test::More ();
+use Test::Memory::Cycle;
+
+has 'stack' => (isa => 'Reaction::UI::FocusStack', is => 'rw', set_or_lazy_build('stack'));
+
+sub build_stack {
+  return Reaction::UI::FocusStack->new;
+}
+
+sub test_stack :Tests {
+  my $self = shift;
+  my $stack = $self->build_stack;
+  my $ctx = bless({}, 'Catalyst');
+  Test::More::ok(!$stack->has_loc_prefix, 'No location prefix');
+  Test::More::cmp_ok($stack->vp_count, '==', 0, 'Empty viewport stack');
+  my $vp = $stack->push_viewport(ViewPort, ctx => $ctx);
+  Test::More::is($vp->location, '0', 'New vp has location 0');
+  Test::More::cmp_ok($stack->vp_count, '==', 1, 'Viewport count 1');
+  Test::More::is($stack->vp_head, $vp, 'Head set ok');
+  Test::More::is($stack->vp_tail, $vp, 'Tail set ok');
+  my $vp2 = $stack->push_viewport(ViewPort, ctx => $ctx);
+  Test::More::is($vp2->location, '1', 'New vp has location 1');
+  Test::More::cmp_ok($stack->vp_count, '==', 2, 'Viewport count 2');
+  Test::More::is($stack->vp_head, $vp, 'Head set ok');
+  Test::More::is($stack->vp_tail, $vp2, 'Tail set ok');
+  Test::More::is($vp->inner, $vp2, 'Inner ok on head');
+  Test::More::is($vp2->outer, $vp, 'Outer ok on tail');
+  Test::More::is($vp->focus_stack, $stack, 'Head focus_stack ok');
+  Test::More::is($vp2->focus_stack, $stack, 'Tail focus_stack ok');
+  memory_cycle_ok($stack, 'No cycles in the stack');
+  my $vp3 = $stack->push_viewport(ViewPort, ctx => $ctx);
+  my $vp4 = $stack->push_viewport(ViewPort, ctx => $ctx);
+  Test::More::is($stack->vp_tail, $vp4, 'Tail still ok');
+  Test::More::cmp_ok($stack->vp_count, '==', 4, 'Count still ok');
+  $stack->pop_viewports_to($vp3);
+  Test::More::is($stack->vp_tail, $vp2, 'Correct pop to');
+  Test::More::cmp_ok($stack->vp_count, '==', 2, 'Count after pop to');
+  Test::More::is($stack->vp_head, $vp, 'Head unchanged');
+  Test::More::is($stack->vp_tail, $vp2, 'Tail back to vp2');
+  my $pop_ret = $stack->pop_viewport;
+  Test::More::is($vp2, $pop_ret, 'Correct viewport popped');
+  Test::More::is($stack->vp_head, $vp, 'Head unchanged');
+  Test::More::is($stack->vp_tail, $vp, 'Tail now head');
+  $stack->pop_viewport;
+  Test::More::ok(!defined($stack->vp_head), 'Head cleared');
+  Test::More::ok(!defined($stack->vp_tail), 'Tail cleared');
+  Test::More::cmp_ok($stack->vp_count, '==', 0, 'Count Zero');
+}
+
+1;  
diff --git a/t/lib/RTest/UI/ViewPort/ListView.pm b/t/lib/RTest/UI/ViewPort/ListView.pm
new file mode 100644
index 0000000..02d00ba
--- /dev/null
+++ b/t/lib/RTest/UI/ViewPort/ListView.pm
@@ -0,0 +1,102 @@
+package RTest::UI::ViewPort::ListView;
+
+use base qw/Reaction::Test::WithDB/;
+use Reaction::Class;
+
+use Reaction::UI::ViewPort::ListView;
+use RTest::TestDB;
+use Test::More ();
+
+has '+schema_class' => (default => sub { 'RTest::TestDB' });
+
+has 'viewport' => (
+  isa => 'Reaction::UI::ViewPort::ListView',
+  is => 'rw', set_or_lazy_build('viewport'),
+  clearer => 'clear_viewport',
+);
+
+has 'collection' => (
+  isa => 'DBIx::Class::ResultSet',
+  is => 'rw', set_or_lazy_build('collection'),
+  clearer => 'clear_collection',
+);
+
+sub build_collection {
+  shift->schema->resultset('Foo');
+}
+
+sub build_viewport {
+  my ($self) = @_;
+  my $vp = Reaction::UI::ViewPort::ListView->new(
+    location => 0,
+    collection => $self->collection,
+    ctx => $self->simple_mock_context,
+    column_order => [qw(id first_name last_name)],
+  );
+  return $vp;
+}
+
+sub init_viewport :Tests {
+  my ($self) = @_;
+
+  $self->clear_viewport;
+
+  Test::More::cmp_ok($self->viewport->page, '==', 1, "Default page");
+  Test::More::cmp_ok($self->viewport->per_page, '==', 10, "Default per page");
+
+  my @columns = qw(id first_name last_name);
+  Test::More::is_deeply($self->viewport->field_names, \@columns, "Field names");
+  Test::More::is($self->viewport->field_label('first_name'), 'First Name', 'Field label');
+
+  my @rows = $self->viewport->current_rows;
+  Test::More::cmp_ok(@rows, '==', 10, 'Row count');
+  Test::More::isa_ok($rows[0], 'RTest::TestDB::Foo', 'First row class');
+  Test::More::cmp_ok($rows[0]->id, '==', 1, 'First row id');
+
+  my $pager = $self->viewport->pager;
+  Test::More::cmp_ok($pager->current_page, '==', 1, 'Pager current page');
+  Test::More::cmp_ok($pager->next_page, '==', 2, 'Pager next page');
+  Test::More::ok(!defined($pager->previous_page), 'Pager previous page');
+  Test::More::cmp_ok($pager->entries_per_page, '==', 10, 'Pager entries per page');
+}
+
+sub modify_viewport :Tests {
+  my ($self) = @_;
+
+  $self->clear_viewport;
+
+  $self->viewport->per_page(20);
+  $self->viewport->page(2);
+
+  my $pager = $self->viewport->pager;
+
+  Test::More::cmp_ok($pager->current_page, '==', 2, 'Pager current page');
+  Test::More::cmp_ok($pager->last_page, '==', 5, 'Pager last page');
+}
+
+sub viewport_to_csv :Tests {
+  my ($self) = @_;
+
+  $self->clear_viewport;
+
+  $self->viewport->export_to_csv;
+
+  Test::More::like($self->viewport->ctx->res->body,
+    qr/^Id,"First Name","Last Name"\r
+1,Joe,"Bloggs 1"\r
+2,John,"Smith 1"\r
+3,Joe,"Bloggs 2"\r
+4,John,"Smith 2"\r
+5,Joe,"Bloggs 3"\r
+6,John,"Smith 3"\r
+7,Joe,"Bloggs 4"\r
+8,John,"Smith 4"\r
+9,Joe,"Bloggs 5"\r
+10,John,"Smith 5"\r
+/, "CSV export head ok");
+  Test::More::like($self->viewport->ctx->res->body,
+    qr/100,John,"Smith 50"\r\n$/, "CSV export tail ok");
+
+}
+
+1;
diff --git a/t/lib/RTest/UI/Window.pm b/t/lib/RTest/UI/Window.pm
new file mode 100644
index 0000000..2528f03
--- /dev/null
+++ b/t/lib/RTest/UI/Window.pm
@@ -0,0 +1,110 @@
+package RTest::UI::Window;
+
+use aliased 'Reaction::UI::ViewPort';
+
+use base qw/Reaction::Test/;
+use Reaction::Class;
+
+BEGIN {
+
+  package RTest::UI::Window::_::view;
+
+  use base qw/Reaction::UI::Renderer::XHTML/;
+
+  sub render {
+    return $_[0]->{render}->(@_);
+  }
+
+  package RTest::UI::Window::_::TestViewPort;
+
+  use Reaction::Class;
+
+  extends 'Reaction::UI::ViewPort';
+
+  register_inc_entry;
+
+  sub handle_events {
+    $_[0]->{handle_events}->(@_);
+  }
+
+};
+
+use Test::More ();
+use Reaction::UI::Window;
+use aliased 'RTest::UI::Window::_::TestViewPort';
+
+has 'window' => (
+  isa => 'Reaction::UI::Window', is => 'rw',
+  set_or_lazy_build('window')
+);
+
+sub build_window {
+  my $self = shift;
+  return Reaction::UI::Window->new(
+           ctx => bless({}, 'Reaction::Test::Mock::Context'),
+           view_name => 'Test',
+           content_type => 'text/html',
+         );
+}
+
+sub test_window :Tests {
+  my $self = shift;
+  my $window = $self->build_window;
+  my $view = bless({}, 'RTest::UI::Window::_::view');
+  $window->ctx->{view} = sub {
+    Test::More::is($_[1], 'Test', 'View name ok');
+    return $view;
+  };
+  Test::More::is($window->view, $view, 'View retrieved from context');
+  my %param;
+  $window->ctx->{req} = sub {
+    return bless({
+             query_parameters => sub { \%param },
+             body_parameters => sub { {} },
+           }, 'Reaction::Test::Mock::Request');
+  };
+  $window->ctx->{res} = sub {
+    return bless({
+             status => sub { 200 },
+             body => sub { '' },
+           }, 'Reaction::Test::Mock::Response');
+  };
+  eval { $window->flush };
+  Test::More::like($@, qr/empty focus stack/, 'Error thrown without viewports');
+  my @vp;
+  push(@vp, $window->focus_stack
+    ->push_viewport(ViewPort, ctx => $window->ctx));
+  push(@vp, $window->focus_stack
+    ->push_viewport(ViewPort, ctx => $window->ctx));
+  my $i;
+  $view->{render} = sub {
+    my $expect_vp = $vp[$i++];
+    Test::More::is($_[1], $window->ctx, 'Context ok');
+    Test::More::is($_[2], 'component', 'Component template');
+    Test::More::is($_[3]->{self}, $expect_vp, 'Viewport');
+    $_[3]->{window}->render_viewport($expect_vp->inner);
+    return "foo";
+  };
+  my $body;
+  $window->ctx->{res} = sub {
+    return bless({
+             body => sub { shift; return '' unless @_; $body = shift; },
+             content_type => sub { },
+             status => sub { 200 },
+           }, 'Reaction::Test::Mock::Response');
+  };
+  $window->flush;
+  Test::More::is($body, 'foo', 'body set ok');
+  my $test_vp = $vp[1]->create_tangent('foo')
+                      ->push_viewport(TestViewPort,
+                                      ctx => bless({}, 'Catalyst'));
+  my $param_name = '1.foo.0:name';
+  Test::More::is($test_vp->event_id_for('name'), $param_name, 'Event id ok');
+  $param{$param_name} = 'blah';
+  $test_vp->{handle_events} = sub {
+    Test::More::is($_[1]->{name}, 'blah', 'Event delivered ok');
+  };
+  $window->flush_events;
+}
+
+1;
diff --git a/t/simple.pl b/t/simple.pl
new file mode 100644
index 0000000..0244f7c
--- /dev/null
+++ b/t/simple.pl
@@ -0,0 +1,11 @@
+use strict;
+use warnings;
+
+use lib 'lib';
+use ComponentUI;
+
+my $ctx = bless({ stash => {} }, 'ComponentUI');
+
+my $view = ComponentUI->view('TT');
+
+print $view->render($ctx, 'textfield', { self => { label => 'Label', message => 'Status message.' }, blocks => {} });
diff --git a/t/ui_focus_stack.t b/t/ui_focus_stack.t
new file mode 100644
index 0000000..15bf439
--- /dev/null
+++ b/t/ui_focus_stack.t
@@ -0,0 +1,11 @@
+use lib 't/lib';
+use strict;
+use warnings;
+
+use Test::Class;
+use RTest::UI::FocusStack;
+
+Test::Class->runtests(
+  RTest::UI::FocusStack->new,
+);
+
diff --git a/t/ui_viewport.t b/t/ui_viewport.t
new file mode 100644
index 0000000..0cff6d8
--- /dev/null
+++ b/t/ui_viewport.t
@@ -0,0 +1,10 @@
+use lib 't/lib';
+use strict;
+use warnings;
+
+use Test::Class;
+use RTest::UI::ViewPort::ListView;
+
+Test::Class->runtests(
+  RTest::UI::ViewPort::ListView->new,
+);
diff --git a/t/ui_widget_listview.show b/t/ui_widget_listview.show
new file mode 100644
index 0000000..05e3ab8
--- /dev/null
+++ b/t/ui_widget_listview.show
@@ -0,0 +1,43 @@
+use strict;
+use warnings;
+use Reaction::UI::Widget::ListView;
+use Data::Dump::Streamer qw(Dump);
+
+my ($name, $data);
+
+sub FakeRCTX::render {
+  shift;
+  ($name, $data) = @_;
+}
+
+sub FakeVP::field_names { [ qw(foo bar baz) ] }
+
+sub FakeVP::field_label_map { ({ foo => 'Foo', bar => 'Bar', baz => 'Baz' }); }
+
+my $w = bless({ viewport => 'VIEWPORT' }, 'Reaction::UI::Widget::ListView');
+
+my $rctx = bless({}, 'FakeRCTX');
+
+$w->render_header($rctx, { self => $w, viewport => bless({}, 'FakeVP') });
+
+print "Name: ${name}\n";
+print "Data: ";
+print Dump($data);
+
+my $first = $data->{_}->();
+
+print "First: ";
+print Dump($first);
+
+$first->($rctx);
+
+print "Name: ${name}\n";
+print "Data: ";
+print Dump($data);
+
+my $inner = $data->{_}->();
+
+print "Inner: ";
+print Dump($inner);
+
+print $inner->();
diff --git a/t/ui_window.t b/t/ui_window.t
new file mode 100644
index 0000000..0fcd1e8
--- /dev/null
+++ b/t/ui_window.t
@@ -0,0 +1,10 @@
+use lib 't/lib';
+use strict;
+use warnings;
+
+use Test::Class;
+use RTest::UI::Window;
+
+Test::Class->runtests(
+  RTest::UI::Window->new,
+);