1package RTest::InterfaceModel::Reflector::DBIC;
2
3use base qw/Reaction::Test::WithDB Reaction::Object/;
4use Reaction::Class;
5use Class::MOP ();
6use ComponentUI::TestModel;
7use Test::More ();
8use Reaction::InterfaceModel::Reflector::DBIC;
9
10has '+schema_class' => (default => sub { 'RTest::TestDB' });
11
12has im_schema => (is =>'ro', isa => 'RTest::TestIM', lazy_build => 1);
13
14#at the moment I am only testing with the "reflect all" functionality
15#when I have time I will write test cases that cover all the other bases
16#it's just kind of a pain in the ass right now and I am behind on a lot of other shit.
17
18sub _build_im_schema{
19  my $self = shift;
20
21  my $reflector = Reaction::InterfaceModel::Reflector::DBIC->new;
22
23  $reflector->reflect_schema(
24                             model_class  => 'RTest::TestIM',
25                             schema_class => 'RTest::TestDB',
26                             sources => [qw/Foo Bar Baz/]
27                           );
28  my (@dm) = RTest::TestIM->domain_models;
29  Test::More::ok(@dm == 1, 'Correct number of Domain Models');
30  my $dm = shift @dm;
31  RTest::TestIM->new($dm->name => $self->schema);
32}
33
34sub test_classnames : Tests{
35  my $self = shift;
36
37  my $reflector = Reaction::InterfaceModel::Reflector::DBIC->new;
38
39
40  Test::More::is(
41                 $reflector->class_name_from_source_name('RTest::__TestIM','Foo'),
42                 'RTest::__TestIM::Foo',
43                 'Correct naming scheme for submodels'
44                );
45  Test::More::is(
46                 $reflector->class_name_for_collection_of('RTest::__TestIM::Foo'),
47                 'RTest::__TestIM::Foo::Collection',
48                 'Correct naming scheme for submodel collections'
49                );
50}
51
52sub test_reflect_schema :Tests {
53  my $self = shift;
54  my $s = $self->im_schema;
55
56  Test::More::isa_ok( $s, 'Reaction::InterfaceModel::Object', 'Correct base' );
57
58  my %pa = map{$_->name => $_ } $s->parameter_attributes;
59  Test::More::ok(keys %pa == 3,  'Correct number of Parameter Attributes');
60
61  Test::More::ok($pa{Foo} && $pa{'Bar'} && $pa{'Baz'},
62                 'Parameter Attributes named correctly');
63
64  for my $submodel (values %pa){
65    Test::More::ok(
66                   $submodel->_isa_metadata->isa('Reaction::InterfaceModel::Collection::Virtual::ResultSet'),
67                   'Parameter Attribute typed correctly'
68                  );
69  }
70
71  Test::More::can_ok($s, qw/foo_collection bar_collection baz_collection/);
72
73  for ( qw/Foo Bar Baz/ ){
74    Test::More::ok(
75                   Class::MOP::is_class_loaded("RTest::TestIM::${_}"),
76                   "Successfully created ${_} IM class"
77                  );
78    Test::More::ok(
79                   Class::MOP::is_class_loaded("RTest::TestIM::${_}::Collection"),
80                   "Successfully created ${_} IM class Collection"
81                  );
82  }
83}
84
85
86sub test_add_source_to_model :Tests {
87  my $self = shift;
88  my $s = $self->im_schema;
89
90  for (qw/Foo Bar Baz /) {
91    my $attr = $s->meta->find_attribute_by_name($_);
92    my $reader = $_;
93    $reader =~ s/([a-z0-9])([A-Z])/${1}_${2}/g ;
94    $reader = lc($reader) . "_collection";
95
96    Test::More::ok( $attr->is_required,           "${_} is required");
97    Test::More::ok( $attr->has_reader,            "${_} has a reader");
98    Test::More::ok( $attr->has_predicate,         "${_} has a predicate");
99    Test::More::ok( $attr->has_domain_model,      "${_} has a domain_model");
100    Test::More::ok( $attr->has_default,           "${_} has a default");
101    Test::More::ok( $attr->is_default_a_coderef,  "${_}'s defaultis a coderef");
102    Test::More::is( $attr->reader,   $reader,     "Correct ${_} reader");
103    SKIP: {
104      Test::More::skip "Not working", 1;
105      Test::More::is( $attr->domain_model, "_rtest_testdb_store", "Correct ${_} domain_model");
106    }
107    Test::More::isa_ok(
108                       $s->$reader,
109                       "RTest::TestIM::${_}::Collection",
110                       "${_} default method works"
111                      );
112
113  }
114}
115
116sub test_reflect_collection_for :Tests{
117  my $self = shift;
118  my $s = $self->im_schema;
119
120  for ( qw/Foo Bar Baz/ ){
121    my $reader = $s->meta->find_attribute_by_name($_)->reader;
122    my $collection = $s->$reader;
123
124    Test::More::is(
125                   $collection->meta->name,
126                   "RTest::TestIM::${_}::Collection",
127                   "Correct Classname"
128                  );
129    Test::More::isa_ok(
130                       $collection,
131                       'Reaction::InterfaceModel::Collection',
132                       "Collection ISA Collection"
133                      );
134    Test::More::isa_ok(
135                       $collection,
136                       'Reaction::InterfaceModel::Collection::Virtual',
137                       "Collection ISA virtual collection"
138                      );
139    Test::More::isa_ok(
140                       $collection,
141                       'Reaction::InterfaceModel::Collection::Virtual::ResultSet',
142                       "Collection ISA virtual resultset"
143                      );
144    SKIP: {
145      Test::More::skip 'Does not work', 2;
146      Test::More::can_ok($collection, '_build__im_class');
147      Test::More::is(
148                   $collection->_build__im_class,
149                   "RTest::TestIM::${_}",
150                   "Collection has correct _im_class"
151                  );
152    }
153  }
154}
155
156sub test_reflect_submodel :Tests{
157  my $self = shift;
158  my $s = $self->im_schema;
159
160  for my $sm ( qw/Foo Bar Baz/ ){
161    my $reader = $s->meta->find_attribute_by_name($sm)->reader;
162    my $collection = $s->$reader;
163    my ($member) = $collection->members;
164    Test::More::ok($member, "Successfully retrieved member");
165    Test::More::isa_ok(
166                       $member,
167                       "Reaction::InterfaceModel::Object",
168                       "Member isa IM::Object"
169                      );
170    SKIP: {
171      Test::More::skip 'Attribute does not exist', 1;
172      Test::More::isa_ok($member, $collection->_im_class);
173    }
174
175    my (@dm) = $member->domain_models;
176    Test::More::ok(@dm == 1, 'Correct number of Domain Models');
177    my $dm = shift @dm;
178
179    my $dm_name = Reaction::InterfaceModel::Reflector::DBIC
180      ->dm_name_from_source_name($sm);
181
182    Test::More::is($dm->_is_metadata, "rw", "Correct is metadata");
183    Test::More::ok($dm->is_required,  "DM is_required");
184    Test::More::is($dm->name, $dm_name, "Correct DM name");
185    Test::More::can_ok($member, "inflate_result");
186    SKIP: {
187      Test::More::skip 'Does not exist', 1;
188      Test::More::is(
189                   $dm->_isa_metadata,
190                   "RTest::TestDB::${sm}",
191                   "Correct isa metadata"
192                  );
193    }
194
195    my %attrs = map { $_->name => $_ } $member->parameter_attributes;
196    my $target;
197    if(   $sm eq "Bar"){$target = 4; }
198    elsif($sm eq "Baz"){$target = 5; }
199    elsif($sm eq "Foo"){$target = 5; }
200    Test::More::is( scalar keys %attrs, $target, "Correct # of attributes for $sm");
201
202    for my $attr_name (keys %attrs){
203      my $attr = $attrs{$attr_name};
204      Test::More::ok($attr->is_lazy,                "is lazy");
205      Test::More::ok($attr->is_required,            "is required");
206      Test::More::ok($attr->has_clearer,            "has clearer");
207      Test::More::ok($attr->has_default,            "has defau;t");
208      Test::More::ok($attr->has_predicate,          "has predicate");
209      Test::More::ok($attr->has_domain_model,       "has domain model");
210      Test::More::ok($attr->has_orig_attr_name,     "has orig attr name");
211      Test::More::ok($attr->is_default_a_coderef,   "default is coderef");
212      Test::More::is($attr->_is_metadata,  "ro",    "Correct is metadata");
213      Test::More::is($attr->domain_model, $dm_name, "Correct domain model");
214      Test::More::is($attr->orig_attr_name, $attr_name, "Correct orig attr name");
215    }
216
217    SKIP: {
218      if($sm eq "Foo"){
219        Test::More::skip '_isa_metadata does not exist', 4;
220
221        Test::More::is($attrs{id}->_isa_metadata, "Int", "Correct id isa metadata");
222        Test::More::is($attrs{first_name}->_isa_metadata, "Reaction::Types::Core::NonEmptySimpleStr", "Correct first_name isa metadata");
223        Test::More::is($attrs{last_name}->_isa_metadata,  "Reaction::Types::Core::NonEmptySimpleStr", "Correct last_name isa metadata");
224        Test::More::is(
225                       $attrs{baz_list}->_isa_metadata,
226                       "RTest::TestIM::Baz::Collection",
227                       "Correct baz_list isa metadata"
228                      );
229      } elsif($sm eq 'Bar'){
230        Test::More::skip '_isa_metadata does not exist', 4;
231
232        Test::More::is($attrs{name}->_isa_metadata, "Reaction::Types::Core::NonEmptySimpleStr", "Correct name isa metadata");
233        Test::More::is($attrs{foo}->_isa_metadata, "RTest::TestIM::Foo", "Correct foo isa metadata");
234        Test::More::is($attrs{published_at}->_isa_metadata, "DateTime",  "Correct published_at isa metadata");
235        Test::More::is($attrs{avatar}->_isa_metadata, "File",            "Correct avatar isa metadata");
236      } elsif($sm eq "Baz"){
237        Test::More::skip '_isa_metadata does not exist', 3;
238
239        Test::More::is($attrs{id}->_isa_metadata, "Int", "Correct id isa metadata");
240        Test::More::is($attrs{name}->_isa_metadata, "Reaction::Types::Core::NonEmptySimpleStr", "Correct name isa metadata");
241        Test::More::is(
242                       $attrs{foo_list}->_isa_metadata,
243                       "RTest::TestIM::Foo::Collection",
244                       "Correct foo_list isa metadata"
245                      );
246      }
247    }
248
249  }
250}
251
252sub test_reflect_submodel_action :Tests{
253  my $self = shift;
254  my $s = $self->im_schema;
255
256  for my $sm ( qw/Foo Bar Baz/ ){
257    my $reader = $s->meta->find_attribute_by_name($sm)->reader;
258    my $collection = $s->$reader;
259    my ($member) = $collection->members;
260    Test::More::ok($member, "Successfully retrieved member");
261    Test::More::isa_ok(
262                       $member,
263                       "Reaction::InterfaceModel::Object",
264                       "Member isa IM::Object"
265                      );
266    SKIP: {
267      Test::More::skip 'Does not exist any more', 1;
268      Test::More::isa_ok($member, $collection->_im_class);
269    }
270
271    my $ctx = $self->simple_mock_context;
272    foreach my $action_name (qw/Update Delete DeleteAll Create/){
273
274      my $target_im = $action_name =~ /(?:Create|DeleteAll)/ ? $collection : $member;
275      my $action = $target_im->action_for($action_name, ctx => $ctx);
276
277      Test::More::isa_ok( $action, "Reaction::InterfaceModel::Action",
278                          "Create action isa Action" );
279      Test::More::is(
280                     $action->meta->name,
281                     "RTest::TestIM::${sm}::Action::${action_name}",
282                     "${action_name} action has correct name"
283                    );
284
285      my $base = 'Reaction::InterfaceModel::Action::DBIC'.
286        ($action_name =~ /(?:Create|DeleteAll)/
287         ? "::ResultSet::${action_name}" : "::Result::${action_name}");
288      Test::More::isa_ok($action, $base, "${action_name} has correct base");
289
290
291      my %attrs = map { $_->name => $_ } $action->parameter_attributes;
292      my $attr_num;
293      if($action_name =~ /Delete/){next; }
294      elsif($sm eq "Bar"){$attr_num = 4; }
295      elsif($sm eq "Baz"){$attr_num = 4; }
296      elsif($sm eq "Foo"){$attr_num = 3; }
297      Test::More::is( scalar keys %attrs, $attr_num, "Correct # of attributes for $sm");
298      if($attr_num != keys %attrs ){
299        print STDERR "\t..." . join ", ", keys %attrs, "\n";
300      }
301
302      for my $attr_name (keys %attrs){
303        my $attr = $attrs{$attr_name};
304        Test::More::ok($attr->has_predicate,        "has predicate");
305        Test::More::is($attr->_is_metadata,  "rw",  "Correct is metadata");
306        if ($attr->is_required){
307          Test::More::ok($attr->is_lazy,     "is lazy");
308          Test::More::ok($attr->has_default, "has default");
309          Test::More::ok($attr->is_default_a_coderef, "default is coderef");
310        }
311      }
312
313      SKIP: {
314        if($sm eq "Foo"){
315          Test::More::skip '_isa_metadata no longer exists', 3;
316
317          Test::More::is($attrs{first_name}->_isa_metadata, "Reaction::Types::Core::NonEmptySimpleStr", "Correct first_name isa metadata");
318          Test::More::is($attrs{last_name}->_isa_metadata,  "Reaction::Types::Core::NonEmptySimpleStr", "Correct last_name isa metadata");
319          Test::More::is($attrs{baz_list}->_isa_metadata,  "ArrayRef", "Correct baz_list isa metadata");
320        } elsif($sm eq 'Bar'){
321          Test::More::skip '_isa_metadata no longer exists', 4;
322
323          Test::More::is($attrs{name}->_isa_metadata, "Reaction::Types::Core::NonEmptySimpleStr",  "Correct name isa metadata");
324          Test::More::is($attrs{foo}->_isa_metadata,  "RTest::TestDB::Foo", "Correct foo isa metadata");
325          Test::More::is($attrs{published_at}->_isa_metadata, "DateTime",   "Correct published_at isa metadata");
326          Test::More::is($attrs{avatar}->_isa_metadata, "File",             "Correct avatar isa metadata");
327        } elsif($sm eq "Baz"){
328          Test::More::skip '_isa_metadata no longer exists', 1;
329
330          Test::More::is($attrs{name}->_isa_metadata, "Reaction::Types::Core::NonEmptySimpleStr",  "Correct name isa metadata");
331        }
332      }
333    }
334  }
335}
336
3371;
338