projects / catagits/Reaction.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
added meta_info for VP::SiteLayout
[catagits/Reaction.git] / lib / Reaction / InterfaceModel / Reflector / DBIC.pm
CommitLineData
7adfd53f 1package Reaction::InterfaceModel::Reflector::DBIC;
2
3use aliased 'Reaction::InterfaceModel::Action::DBIC::ResultSet::Create';
b8faba69 4use aliased 'Reaction::InterfaceModel::Action::DBIC::ResultSet::DeleteAll';
7adfd53f 5use aliased 'Reaction::InterfaceModel::Action::DBIC::Result::Update';
6use aliased 'Reaction::InterfaceModel::Action::DBIC::Result::Delete';
7
8use aliased 'Reaction::InterfaceModel::Collection::Virtual::ResultSet';
9use aliased 'Reaction::InterfaceModel::Object';
10use aliased 'Reaction::InterfaceModel::Action';
11use Reaction::Class;
12use Class::MOP;
13
f670cfd0 14use Catalyst::Utils;
15
7adfd53f 16class DBIC, which {
17
de48f4e6 18 has make_classes_immutable => (isa => "Bool", is => "rw", required => 1, default => sub{ 1 });
19
f670cfd0 20 #user defined actions and prototypes
21 has object_actions => (isa => "HashRef", is => "rw", lazy_build => 1);
22 has collection_actions => (isa => "HashRef", is => "rw", lazy_build => 1);
23
24 #which actions to create by default
25 has default_object_actions => (isa => "ArrayRef", is => "rw", lazy_build => 1);
26 has default_collection_actions => (isa => "ArrayRef", is => "rw", lazy_build => 1);
27
28 #builtin actions and prototypes
29 has builtin_object_actions => (isa => "HashRef", is => "rw", lazy_build => 1);
30 has builtin_collection_actions => (isa => "HashRef", is => "rw", lazy_build => 1);
31
89939ff9 32 implements _build_object_actions => as { {} };
33 implements _build_collection_actions => as { {} };
f670cfd0 34
89939ff9 35 implements _build_default_object_actions => as { [ qw/Update Delete/ ] };
36 implements _build_default_collection_actions => as { [ qw/Create DeleteAll/ ] };
f670cfd0 37
89939ff9 38 implements _build_builtin_object_actions => as {
f670cfd0 39 {
7b78a39d 40 Update => { name => 'Update', base => Update },
41 Delete => { name => 'Delete', base => Delete, attributes => [] },
f670cfd0 42 };
43 };
44
89939ff9 45 implements _build_builtin_collection_actions => as {
a4f82080 46 {
47 Create => {name => 'Create', base => Create },
c689b58e 48 DeleteAll => {name => 'DeleteAll', base => DeleteAll, attributes => [] }
a4f82080 49 };
f670cfd0 50 };
51
52 implements _all_object_actions => as {
89939ff9 53 my $self = shift;
f670cfd0 54 return $self->merge_hashes
55 ($self->builtin_object_actions, $self->object_actions);
56 };
7adfd53f 57
f670cfd0 58 implements _all_collection_actions => as {
59 my $self = shift;
60 return $self->merge_hashes
61 ($self->builtin_collection_actions, $self->collection_actions);
62 };
63
64 implements dm_name_from_class_name => as {
65 my($self, $class) = @_;
66 confess("wrong arguments") unless $class;
67 $class =~ s/::/_/g;
68 $class = "_" . lc($class) . "_store";
69 return $class;
7adfd53f 70 };
71
f670cfd0 72 implements dm_name_from_source_name => as {
73 my($self, $source) = @_;
74 confess("wrong arguments") unless $source;
75 $source =~ s/([a-z0-9])([A-Z])/${1}_${2}/g ;
76 $source = "_" . lc($source) . "_store";
77 return $source;
7adfd53f 78 };
79
f670cfd0 80 implements class_name_from_source_name => as {
81 my ($self, $model_class, $source_name) = @_;
82 confess("wrong arguments") unless $model_class && $source_name;
83 return join "::", $model_class, $source_name;
84 };
85
86 implements class_name_for_collection_of => as {
7adfd53f 87 my ($self, $object_class) = @_;
f670cfd0 88 confess("wrong arguments") unless $object_class;
7adfd53f 89 return "${object_class}::Collection";
90 };
91
f670cfd0 92 implements merge_hashes => as {
93 my($self, $left, $right) = @_;
94 return Catalyst::Utils::merge_hashes($left, $right);
95 };
96
97 implements parse_reflect_rules => as {
98 my ($self, $rules, $haystack) = @_;
99 confess('$rules must be an array reference') unless ref $rules eq 'ARRAY';
100 confess('$haystack must be an array reference') unless ref $haystack eq 'ARRAY';
101
102 my $needles = {};
103 my (@exclude, @include, $global_opts);
104 if(@$rules == 2 && $rules->[0] eq '-exclude'){
105 push(@exclude, (ref $rules->[1] eq 'ARRAY' ? @{$rules->[1]} : $rules->[1]));
106 } else {
107 for my $rule ( @$rules ){
108 if (ref $rule eq 'ARRAY' && $rule->[0] eq '-exclude'){
109 push(@exclude, (ref $rule->[1] eq 'ARRAY' ? @{$rule->[1]} : $rule->[1]));
110 } elsif( ref $rule eq 'HASH' ){
111 $global_opts = ref $global_opts eq 'HASH' ?
112 $self->merge_hashes($global_opts, $rule) : $rule;
113 } else {
114 push(@include, $rule);
115 }
116 }
117 }
118 my $check_exclude = sub{
119 for my $rule (@exclude){
120 return 1 if(ref $rule eq 'Regexp' ? $_[0] =~ /$rule/ : $_[0] eq $rule);
121 }
122 return;
123 };
124
125 @$haystack = grep { !$check_exclude->($_) } @$haystack;
126 $self->merge_reflect_rules(\@include, $needles, $haystack, $global_opts);
127 return $needles;
128 };
129
130 implements merge_reflect_rules => as {
131 my ($self, $rules, $needles, $haystack, $local_opts) = @_;
132 for my $rule ( @$rules ){
133 if(!ref $rule && ( grep {$rule eq $_} @$haystack ) ){
134 $needles->{$rule} = defined $needles->{$rule} ?
135 $self->merge_hashes($needles->{$rule}, $local_opts) : $local_opts;
136 } elsif( ref $rule eq 'Regexp' ){
137 for my $match ( grep { /$rule/ } @$haystack ){
138 $needles->{$match} = defined $needles->{$match} ?
139 $self->merge_hashes($needles->{$match}, $local_opts) : $local_opts;
140 }
141 } elsif( ref $rule eq 'ARRAY' ){
142 my $opts;
143 $opts = pop(@$rule) if @$rule > 1 and ref $rule->[$#$rule] eq 'HASH';
144 $opts = $self->merge_hashes($local_opts, $opts) if defined $local_opts;
145 $self->merge_reflect_rules($rule, $needles, $haystack, $opts);
146 }
147 }
148 };
149
150 implements reflect_schema => as {
7adfd53f 151 my ($self, %opts) = @_;
f670cfd0 152 my $base = delete $opts{base} || Object;
153 my $model = delete $opts{model_class};
154 my $schema = delete $opts{schema_class};
7adfd53f 155 my $dm_name = delete $opts{domain_model_name};
156 my $dm_args = delete $opts{domain_model_args} || {};
f670cfd0 157 $dm_name ||= $self->dm_name_from_class_name($schema);
158
159 #load all necessary classes
160 confess("model_class and schema_class are required parameters")
161 unless($model && $schema);
162 Class::MOP::load_class( $base );
163 Class::MOP::load_class( $schema );
89939ff9 164 my $meta = eval { Class::MOP::load_class($model); } ?
f670cfd0 165 $model->meta : $base->meta->create($model, superclasses => [ $base ]);
166
167 # sources => undef, #default to qr/./
168 # sources => [], #default to nothing
169 # sources => qr//, #DWIM, treated as [qr//]
170 # sources => [{...}] #DWIM, treat as [qr/./, {...} ]
171 # sources => [[-exclude => ...]] #DWIM, treat as [qr/./, [-exclude => ...]]
172 my $haystack = [ $schema->sources ];
173
174 my $rules = delete $opts{sources};
175 if(!defined $rules){
176 $rules = [qr/./];
177 } elsif( ref $rules eq 'Regexp'){
178 $rules = [ $rules ];
179 } elsif( ref $rules eq 'ARRAY' && @$rules){
180 #don't add a qr/./ rule if we have at least one match rule
181 push(@$rules, qr/./) unless grep {(ref $_ eq 'ARRAY' && $_->[0] ne '-exclude')
182 || !ref $_ || ref $_ eq 'Regexp'} @$rules;
183 }
7adfd53f 184
f670cfd0 185 my $sources = $self->parse_reflect_rules($rules, $haystack);
7adfd53f 186
de48f4e6 187 my $make_immutable = $meta->is_immutable || $self->make_classes_immutable;
7adfd53f 188 $meta->make_mutable if $meta->is_immutable;
189
f670cfd0 190 $meta->add_domain_model
191 ($dm_name, is => 'rw', isa => $schema, required => 1, %$dm_args);
192
193 for my $source_name (keys %$sources){
194 my $source_opts = $sources->{$source_name} || {};
195 $self->reflect_source(
196 source_name => $source_name,
197 parent_class => $model,
198 schema_class => $schema,
199 source_class => $schema->class($source_name),
200 parent_domain_model_name => $dm_name,
201 %$source_opts
202 );
7adfd53f 203 }
204
205 $meta->make_immutable if $make_immutable;
206 return $meta;
207 };
208
f670cfd0 209 implements _compute_source_options => as {
210 my ($self, %opts) = @_;
211 my $schema = delete $opts{schema_class};
212 my $source_name = delete $opts{source_name};
213 my $source_class = delete $opts{source_class};
214 my $parent = delete $opts{parent_class};
215 my $parent_dm = delete $opts{parent_domain_model_name};
216
217 #this is the part where I hate my life for promissing all sorts of DWIMery
218 confess("parent_class and source_name or source_class are required parameters")
219 unless($parent && ($source_name || $source_class));
220
221 OUTER: until( $schema && $source_name && $source_class && $parent_dm ){
222 if( $schema && !$source_name){
223 next OUTER if $source_name = $source_class->result_source_instance->source_name;
224 } elsif( $schema && !$source_class){
225 next OUTER if $source_class = eval { $schema->class($source_name) };
226 }
7adfd53f 227
f670cfd0 228 if($source_class && (!$schema || !$source_name)){
229 if(!$schema){
230 $schema = $source_class->result_source_instance->schema;
231 next OUTER if $schema && Class::MOP::load_class($schema);
232 }
233 if(!$source_name){
234 $source_name = $source_class->result_source_instance->source_name;
235 next OUTER if $source_name;
236 }
237 }
238 my @haystack = $parent_dm ?
239 $parent->meta->find_attribute_by_name($parent_dm) : $parent->domain_models;
240
241 #there's a lot of guessing going on, but it should work fine on most cases
242 INNER: for my $needle (@haystack){
243 my $isa = $needle->_isa_metadata;
244 next INNER unless Class::MOP::load_class( $isa->_isa_metadata );
245 next INNER unless $isa->isa('DBIx::Class::Schema');
246 if(!$parent_dm && $schema && $isa eq $schema){
247 $parent_dm = $needle->name;
248 next OUTER;
249 }
250
251 if( $source_name ){
252 my $src_class = eval{ $isa->class($source_name) };
253 next INNER unless $src_class;
254 next INNER if($source_class && $source_class ne $src_class);
255 $schema = $isa;
256 $parent_dm = $needle->name;
257 $source_class = $src_class;
258 next OUTER;
259 }
260 }
261
262 #do we even need to go this far?
263 if( !$parent_dm && $schema ){
264 my $tentative = $self->dm_name_from_class_name($schema);
265 $parent_dm = $tentative if grep{$_->name eq $tentative} @haystack;
266 }
267
268 confess("Could not determine options automatically from: schema " .
269 "'${schema}', source_name '${source_name}', source_class " .
270 "'${source_class}', parent_domain_model_name '${parent_dm}'");
271 }
272
273 return {
274 source_name => $source_name,
275 schema_class => $schema,
276 source_class => $source_class,
277 parent_class => $parent,
278 parent_domain_model_name => $parent_dm,
279 };
280 };
7adfd53f 281
46937531 282 implements _class_to_attribute_name => as {
283 my ( $self, $str ) = @_;
284 confess("wrong arguments passed for _class_to_attribute_name") unless $str;
285 return join('_', map lc, split(/::|(?<=[a-z0-9])(?=[A-Z])/, $str))
286 };
7adfd53f 287
f670cfd0 288 implements add_source => as {
289 my ($self, %opts) = @_;
290
291 my $model = delete $opts{model_class};
292 my $reader = delete $opts{reader};
293 my $source = delete $opts{source_name};
294 my $dm_name = delete $opts{domain_model_name};
295 my $collection = delete $opts{collection_class};
296 my $name = delete $opts{attribute_name} || $source;
297
298 confess("model_class and source_name are required parameters")
299 unless $model && $source;
300 my $meta = $model->meta;
301
302 unless( $collection ){
303 my $object = $self->class_name_from_source_name($model, $source);
304 $collection = $self->class_name_for_collection_of($object);
305 }
306 unless( $reader ){
307 $reader = $source;
7adfd53f 308 $reader =~ s/([a-z0-9])([A-Z])/${1}_${2}/g ;
46937531 309 $reader = $self->_class_to_attribute_name($reader) . "_collection";
7adfd53f 310 }
f670cfd0 311 unless( $dm_name ){
312 my @haystack = $meta->domain_models;
313 if( @haystack > 1 ){
314 @haystack = grep { $_->_isa_metadata->isa('DBIx::Class::Schema') } @haystack;
315 }
316 if(@haystack == 1){
317 $dm_name = $haystack[0]->name;
318 } elsif(@haystack > 1){
319 confess("Failed to automatically determine domain_model_name. More than one " .
320 "possible match (".(join ", ", map{"'".$_->name."'"} @haystack).")");
321 } else {
322 confess("Failed to automatically determine domain_model_name. No matches.");
323 }
324 }
7adfd53f 325
326 my %attr_opts =
327 (
328 lazy => 1,
7adfd53f 329 required => 1,
f670cfd0 330 isa => $collection,
7adfd53f 331 reader => $reader,
46937531 332 predicate => "has_" . $self->_class_to_attribute_name($name) ,
7adfd53f 333 domain_model => $dm_name,
f670cfd0 334 orig_attr_name => $source,
7adfd53f 335 default => sub {
a945c8a0 336 my $self = $_[0];
337 return $collection->new(
338 _source_resultset => $self->$dm_name->resultset($source),
339 _parent => $self,
340 );
7adfd53f 341 },
342 );
7adfd53f 343
f670cfd0 344 my $make_immutable = $meta->is_immutable;
345 $meta->make_mutable if $make_immutable;
346 my $attr = $meta->add_attribute($name, %attr_opts);
7adfd53f 347 $meta->make_immutable if $make_immutable;
f670cfd0 348
7adfd53f 349 return $attr;
350 };
351
f670cfd0 352 implements reflect_source => as {
353 my ($self, %opts) = @_;
354 my $collection = delete $opts{collection} || {};
355 %opts = %{ $self->merge_hashes(\%opts, $self->_compute_source_options(%opts)) };
356
357 my $obj_meta = $self->reflect_source_object(%opts);
358 my $col_meta = $self->reflect_source_collection
359 (
360 object_class => $obj_meta->name,
361 source_class => $opts{source_class},
362 %$collection
363 );
364
365 $self->add_source(
366 model_class => $opts{parent_class},
367 source_name => $opts{source_name},
368 domain_model_name => $opts{parent_domain_model_name},
369 collection_class => $col_meta->name,
370 );
371 };
372
373 implements reflect_source_collection => as {
7adfd53f 374 my ($self, %opts) = @_;
7adfd53f 375 my $base = delete $opts{base} || ResultSet;
f670cfd0 376 my $class = delete $opts{class};
377 my $object = delete $opts{object_class};
378 my $source = delete $opts{source_class};
379 my $action_rules = delete $opts{actions};
380
381 confess('object_class and source_class are required parameters')
382 unless $object && $source;
383 $class ||= $self->class_name_for_collection_of($object);
7adfd53f 384
f670cfd0 385 Class::MOP::load_class( $base );
386 Class::MOP::load_class( $object );
7adfd53f 387 my $meta = eval { Class::MOP::load_class($class) } ?
f670cfd0 388 $class->meta : $base->meta->create( $class, superclasses => [ $base ]);
7adfd53f 389
de48f4e6 390 my $make_immutable = $meta->is_immutable || $self->make_classes_immutable;;
f670cfd0 391 $meta->make_mutable if $meta->is_immutable;
c8fbb8ad 392 $meta->add_method(_build_member_type => sub{ $object } );
f670cfd0 393 #XXX as a default pass the domain model as a target_model until i come up with something
394 #better through the coercion method
395 my $def_act_args = sub {
396 my $super = shift;
397 return { (target_model => $_[0]->_source_resultset), %{ $super->(@_) } };
398 };
399 $meta->add_around_method_modifier('_default_action_args_for', $def_act_args);
400
401
402 {
403 my $all_actions = $self->_all_collection_actions;
404 my $action_haystack = [keys %$all_actions];
405 if(!defined $action_rules){
406 $action_rules = $self->default_collection_actions;
407 } elsif( (!ref $action_rules && $action_rules) || (ref $action_rules eq 'Regexp') ){
408 $action_rules = [ $action_rules ];
409 } elsif( ref $action_rules eq 'ARRAY' && @$action_rules){
410 #don't add a qr/./ rule if we have at least one match rule
411 push(@$action_rules, qr/./)
412 unless grep {(ref $_ eq 'ARRAY' && $_->[0] ne '-exclude')
413 || !ref $_ || ref $_ eq 'Regexp'} @$action_rules;
7adfd53f 414 }
7adfd53f 415
f670cfd0 416 # XXX this is kind of a dirty hack to support custom actions that are not
417 # previously defined and still be able to use the parse_reflect_rules mechanism
418 my @custom_actions = grep {!exists $all_actions->{$_}}
419 map{ $_->[0] } grep {ref $_ eq 'ARRAY' && $_->[0] ne '-exclude'} @$action_rules;
420 push(@$action_haystack, @custom_actions);
421 my $actions = $self->parse_reflect_rules($action_rules, $action_haystack);
422 for my $action (keys %$actions){
423 my $action_opts = $self->merge_hashes
424 ($all_actions->{$action} || {}, $actions->{$action} || {});
7b78a39d 425
426 #NOTE: If the name of the action is not specified in the prototype then use it's
427 #hash key as the name. I think this is sane beahvior, but I've actually been thinking
428 #of making Action prototypes their own separate objects
f670cfd0 429 $self->reflect_source_action(
430 name => $action,
431 object_class => $object,
432 source_class => $source,
433 %$action_opts,
434 );
435
436 # XXX i will move this to use the coercion method soon. this will be
437 # GoodEnough until then. I still need to think a little about the type coercion
438 # thing so i don't make a mess of it
439 my $act_args = sub { #override target model for this action
440 my $super = shift;
441 return { %{ $super->(@_) },
442 ($_[1] eq $action ? (target_model => $_[0]->_source_resultset) : () ) };
443 };
444 $meta->add_around_method_modifier('_default_action_args_for', $act_args);
445 }
446 }
7adfd53f 447 $meta->make_immutable if $make_immutable;
448 return $meta;
449 };
450
f670cfd0 451 implements reflect_source_object => as {
452 my($self, %opts) = @_;
453 %opts = %{ $self->merge_hashes(\%opts, $self->_compute_source_options(%opts)) };
454
455 my $base = delete $opts{base} || Object;
456 my $class = delete $opts{class};
457 my $dm_name = delete $opts{domain_model_name};
458 my $dm_opts = delete $opts{domain_model_args} || {};
459
460 my $source_name = delete $opts{source_name};
461 my $schema = delete $opts{schema_class};
462 my $source_class = delete $opts{source_class};
463 my $parent = delete $opts{parent_class};
464 my $parent_dm = delete $opts{parent_domain_model_name};
465
466 my $action_rules = delete $opts{actions};
467 my $attr_rules = delete $opts{attributes};
468
469 $class ||= $self->class_name_from_source_name($parent, $source_name);
470
471 Class::MOP::load_class($parent);
472 Class::MOP::load_class($schema) if $schema;
473 Class::MOP::load_class($source_class);
474
7adfd53f 475 my $meta = eval { Class::MOP::load_class($class) } ?
f670cfd0 476 $class->meta : $base->meta->create($class, superclasses => [ $base ]);
7adfd53f 477
478 #create the domain model
f670cfd0 479 $dm_name ||= $self->dm_name_from_source_name($source_name);
7adfd53f 480
f670cfd0 481 $dm_opts->{isa} = $source_class;
7adfd53f 482 $dm_opts->{is} ||= 'rw';
483 $dm_opts->{required} ||= 1;
7adfd53f 484
de48f4e6 485 my $make_immutable = $meta->is_immutable || $self->make_classes_immutable;;
f670cfd0 486 $meta->make_mutable if $meta->is_immutable;
487
488 my $dm_attr = $meta->add_domain_model($dm_name, %$dm_opts);
489 my $dm_reader = $dm_attr->get_read_method;
490
491 unless( $class->can('inflate_result') ){
7adfd53f 492 my $inflate_method = sub {
493 my $class = shift; my ($src) = @_;
494 $src = $src->resolve if $src->isa('DBIx::Class::ResultSourceHandle');
495 $class->new($dm_name, $src->result_class->inflate_result(@_));
496 };
497 $meta->add_method('inflate_result', $inflate_method);
498 }
499
f670cfd0 500 #XXX this is here to allow action prototypes to work with ListView
501 # maybe Collections hsould have this kind of thing too to allow you to reconstruct them?
502 #i like the possibility to be honest... as aset of key/value pairs they could be URId
503 #XXX move to using 'handles' for this?
504 $meta->add_method('__id', sub {shift->$dm_reader->id} )
505 unless $class->can('__id');
5ee24b95 506 #XXX this one is for Action, ChooseOne and ChooseMany need this shit
f670cfd0 507 $meta->add_method('__ident_condition', sub {shift->$dm_reader->ident_condition} )
508 unless $class->can('__ident_condition');
509
510 #XXX this is just a disaster
511 $meta->add_method('display_name', sub {shift->$dm_reader->display_name} )
512 if( $source_class->can('display_name') && !$class->can('display_name'));
513
514 #XXX as a default pass the domain model as a target_model until i come up with something
515 #better through the coercion method
516 my $def_act_args = sub {
517 my $super = shift;
518 confess "no dm reader: $dm_reader on $_[0]" unless $_[0]->can($dm_reader);
519 return { (target_model => $_[0]->$dm_reader), %{ $super->(@_) } };
520 };
521 $meta->add_around_method_modifier('_default_action_args_for', $def_act_args);
522
523 {
524 # attributes => undef, #default to qr/./
525 # attributes => [], #default to nothing
526 # attributes => qr//, #DWIM, treated as [qr//]
527 # attributes => [{...}] #DWIM, treat as [qr/./, {...} ]
528 # attributes => [[-exclude => ...]] #DWIM, treat as [qr/./, [-exclude => ...]]
529 my $attr_haystack =
530 [ map { $_->name } $source_class->meta->compute_all_applicable_attributes ];
531
532 if(!defined $attr_rules){
533 $attr_rules = [qr/./];
534 } elsif( (!ref $attr_rules && $attr_rules) || (ref $attr_rules eq 'Regexp') ){
535 $attr_rules = [ $attr_rules ];
536 } elsif( ref $attr_rules eq 'ARRAY' && @$attr_rules){
537 #don't add a qr/./ rule if we have at least one match rule
538 push(@$attr_rules, qr/./) unless
539 grep {(ref $_ eq 'ARRAY' && $_->[0] ne '-exclude')
540 || !ref $_ || ref $_ eq 'Regexp'} @$attr_rules;
541 }
542
543 my $attributes = $self->parse_reflect_rules($attr_rules, $attr_haystack);
544 for my $attr_name (keys %$attributes){
545 $self->reflect_source_object_attribute(
546 class => $class,
547 source_class => $source_class,
548 parent_class => $parent,
549 attribute_name => $attr_name,
550 domain_model_name => $dm_name,
551 %{ $attributes->{$attr_name} || {}},
552 );
553 }
7adfd53f 554 }
555
f670cfd0 556 {
557 my $all_actions = $self->_all_object_actions;
558 my $action_haystack = [keys %$all_actions];
559 if(!defined $action_rules){
560 $action_rules = $self->default_object_actions;
561 } elsif( (!ref $action_rules && $action_rules) || (ref $action_rules eq 'Regexp') ){
562 $action_rules = [ $action_rules ];
563 } elsif( ref $action_rules eq 'ARRAY' && @$action_rules){
564 #don't add a qr/./ rule if we have at least one match rule
565 push(@$action_rules, qr/./)
566 unless grep {(ref $_ eq 'ARRAY' && $_->[0] ne '-exclude')
567 || !ref $_ || ref $_ eq 'Regexp'} @$action_rules;
568 }
569
570 # XXX this is kind of a dirty hack to support custom actions that are not
571 # previously defined and still be able to use the parse_reflect_rules mechanism
572 my @custom_actions = grep {!exists $all_actions->{$_}} map{ $_->[0] }
573 grep {ref $_ eq 'ARRAY' && $_->[0] ne '-exclude'} @$action_rules;
574 push(@$action_haystack, @custom_actions);
575 my $actions = $self->parse_reflect_rules($action_rules, $action_haystack);
576 for my $action (keys %$actions){
577 my $action_opts = $self->merge_hashes
578 ($all_actions->{$action} || {}, $actions->{$action} || {});
7b78a39d 579
580 #NOTE: If the name of the action is not specified in the prototype then use it's
581 #hash key as the name. I think this is sane beahvior, but I've actually been thinking
582 #of making Action prototypes their own separate objects
f670cfd0 583 $self->reflect_source_action(
584 name => $action,
585 object_class => $class,
586 source_class => $source_class,
587 %$action_opts,
588 );
589
590 # XXX i will move this to use the coercion method soon. this will be
591 # GoodEnough until then. I still need to think a little about the type coercion
592 # thing so i don't make a mess of it
593 my $act_args = sub { #override target model for this action
594 my $super = shift;
595 confess "no dm reader: $dm_reader on $_[0]" unless $_[0]->can($dm_reader);
596 return { %{ $super->(@_) },
597 ($_[1] eq $action ? (target_model => $_[0]->$dm_reader) : () ) };
598 };
599 $meta->add_around_method_modifier('_default_action_args_for', $act_args);
7adfd53f 600 }
7adfd53f 601 }
602
603 $meta->make_immutable if $make_immutable;
604 return $meta;
605 };
606
607 # needs class, attribute_name domain_model_name
f670cfd0 608 implements reflect_source_object_attribute => as {
7adfd53f 609 my ($self, %opts) = @_;
f670cfd0 610 unless( $opts{attribute_name} && $opts{class} && $opts{parent_class}
611 && ( $opts{source_class} || $opts{domain_model_name} ) ){
612 confess( "Error: class, parent_class, attribute_name, and either " .
613 "domain_model_name or source_class are required parameters" );
614 }
615
7adfd53f 616 my $meta = $opts{class}->meta;
f670cfd0 617 my $attr_opts = $self->parameters_for_source_object_attribute(%opts);
7adfd53f 618
619 my $make_immutable = $meta->is_immutable;
620 $meta->make_mutable if $meta->is_immutable;
f670cfd0 621
7adfd53f 622 my $attr = $meta->add_attribute($opts{attribute_name}, %$attr_opts);
7adfd53f 623
f670cfd0 624 $meta->make_immutable if $make_immutable;
7adfd53f 625 return $attr;
626 };
627
628 # needs class, attribute_name domain_model_name
f670cfd0 629 implements parameters_for_source_object_attribute => as {
7adfd53f 630 my ($self, %opts) = @_;
631
f670cfd0 632 my $class = delete $opts{class};
633 my $attr_name = delete $opts{attribute_name};
634 my $dm_name = delete $opts{domain_model_name};
635 my $source_class = delete $opts{source_class};
636 my $parent_class = delete $opts{parent_class};
637 confess("parent_class is a required argument") unless $parent_class;
638 confess("You must supply at least one of domain_model_name and source_class")
639 unless $dm_name || $source_class;
640
641 my $source;
642 $source = $source_class->result_source_instance if $source_class;
643 #puke! dwimery
644 if( !$source_class ){
645 my $dm = $class->meta->find_attribute_by_name($dm_name);
646 $source_class = $dm->_isa_metadata;
647 $source = $source_class->result_source_instance;
648 } elsif( !$dm_name ){
649 ($dm_name) = map{$_->name} grep{$_->_isa_metadata eq $source_class}
650 $class->meta->domain_models;
651 if( !$dm_name ){ #last resort guess
652 my $tentative = $self->dm_name_from_source_name($source->source_name);
653 ($dm_name) = $tentative if grep{$_->name eq $tentative} $class->domain_models;
654 }
655 }
656
657 my $from_attr = $source_class->meta->find_attribute_by_name($attr_name);
7adfd53f 658
659 #default options. lazy build but no outsider method
660 my %attr_opts = ( is => 'ro', lazy => 1, required => 1,
661 clearer => "_clear_${attr_name}",
662 predicate => "has_${attr_name}",
663 domain_model => $dm_name,
664 orig_attr_name => $attr_name,
665 );
666
667 #m2m / has_many
668 my $constraint_is_ArrayRef =
669 $from_attr->type_constraint->name eq 'ArrayRef' ||
670 $from_attr->type_constraint->is_subtype_of('ArrayRef');
671
672 if( my $rel_info = $source->relationship_info($attr_name) ){
673 my $rel_accessor = $rel_info->{attrs}->{accessor};
f670cfd0 674 my $rel_moniker = $rel_info->{class}->result_source_instance->source_name;
7adfd53f 675
676 if($rel_accessor eq 'multi' && $constraint_is_ArrayRef) {
677 #has_many
f670cfd0 678 my $sm = $self->class_name_from_source_name($parent_class, $rel_moniker);
7adfd53f 679 #type constraint is a collection, and default builds it
f670cfd0 680 $attr_opts{isa} = $self->class_name_for_collection_of($sm);
7adfd53f 681 $attr_opts{default} = sub {
682 my $rs = shift->$dm_name->related_resultset($attr_name);
683 return $attr_opts{isa}->new(_source_resultset => $rs);
684 };
685 } elsif( $rel_accessor eq 'single') {
686 #belongs_to
687 #type constraint is the foreign IM object, default inflates it
f670cfd0 688 $attr_opts{isa} = $self->class_name_from_source_name($parent_class, $rel_moniker);
7adfd53f 689 $attr_opts{default} = sub {
690 shift->$dm_name
691 ->find_related($attr_name, {},{result_class => $attr_opts{isa}});
692 };
693 }
f670cfd0 694 } elsif( $constraint_is_ArrayRef && $attr_name =~ m/^(.*)_list$/ ) {
7adfd53f 695 #m2m magic
696 my $mm_name = $1;
697 my $link_table = "links_to_${mm_name}_list";
698 my ($hm_source, $far_side);
699 eval { $hm_source = $source->related_source($link_table); }
700 || confess "Can't find ${link_table} has_many for ${mm_name}_list";
701 eval { $far_side = $hm_source->related_source($mm_name); }
702 || confess "Can't find ${mm_name} belongs_to on ".$hm_source->result_class
703 ." traversing many-many for ${mm_name}_list";
704
f670cfd0 705 my $sm = $self->class_name_from_source_name($parent_class,$far_side->source_name);
706 $attr_opts{isa} = $self->class_name_for_collection_of($sm);
7adfd53f 707
708 #proper collections will remove the result_class uglyness.
709 $attr_opts{default} = sub {
2e2afc48 710 my $rs = shift->$dm_name->related_resultset($link_table)->related_resultset($mm_name);
7adfd53f 711 return $attr_opts{isa}->new(_source_resultset => $rs);
712 };
713 } else {
714 #no rel
715 my $reader = $from_attr->get_read_method;
716 $attr_opts{isa} = $from_attr->_isa_metadata;
717 $attr_opts{default} = sub{ shift->$dm_name->$reader };
718 }
719 return \%attr_opts;
720 };
721
722
f670cfd0 723 implements reflect_source_action => as{
7adfd53f 724 my($self, %opts) = @_;
f670cfd0 725 my $name = delete $opts{name};
726 my $class = delete $opts{class};
727 my $base = delete $opts{base} || Action;
728 my $object = delete $opts{object_class};
729 my $source = delete $opts{source_class};
730
731 confess("name, object_class and source_class are required arguments")
732 unless $source && $name && $object;
733
734 my $attr_rules = delete $opts{attributes};
735 $class ||= $object->_default_action_class_for($name);
736
737 Class::MOP::load_class( $base );
738 Class::MOP::load_class( $object );
739 Class::MOP::load_class( $source );
740
741 #print STDERR "\n\t", ref $attr_rules eq 'ARRAY' ? @$attr_rules : $attr_rules,"\n";
742 # attributes => undef, #default to qr/./
743 # attributes => [], #default to nothing
744 # attributes => qr//, #DWIM, treated as [qr//]
745 # attributes => [{...}] #DWIM, treat as [qr/./, {...} ]
746 # attributes => [[-exclude => ...]] #DWIM, treat as [qr/./, [-exclude => ...]]
32afff5d 747 my $attr_haystack = [ map { $_->name } $object->meta->parameter_attributes ];
f670cfd0 748 if(!defined $attr_rules){
749 $attr_rules = [qr/./];
750 } elsif( (!ref $attr_rules && $attr_rules) || (ref $attr_rules eq 'Regexp') ){
751 $attr_rules = [ $attr_rules ];
752 } elsif( ref $attr_rules eq 'ARRAY' && @$attr_rules){
753 #don't add a qr/./ rule if we have at least one match rule
754 push(@$attr_rules, qr/./) unless
755 grep {(ref $_ eq 'ARRAY' && $_->[0] ne '-exclude')
756 || !ref $_ || ref $_ eq 'Regexp'} @$attr_rules;
757 }
7adfd53f 758
f670cfd0 759 #print STDERR "${name}\t${class}\t${base}\n";
760 #print STDERR "\t${object}\t${source}\n";
761 #print STDERR "\t",@$attr_rules,"\n";
7adfd53f 762
f670cfd0 763 my $o_meta = $object->meta;
764 my $s_meta = $source->meta;
765 my $attributes = $self->parse_reflect_rules($attr_rules, $attr_haystack);
7adfd53f 766
767 #create the class
768 my $meta = eval { Class::MOP::load_class($class) } ?
769 $class->meta : $base->meta->create($class, superclasses => [$base]);
de48f4e6 770 my $make_immutable = $meta->is_immutable || $self->make_classes_immutable;
7adfd53f 771 $meta->make_mutable if $meta->is_immutable;
772
f670cfd0 773 for my $attr_name (keys %$attributes){
774 my $attr_opts = $attributes->{$attr_name} || {};
775 my $o_attr = $o_meta->find_attribute_by_name($attr_name);
776 my $s_attr_name = $o_attr->orig_attr_name || $attr_name;
777 my $s_attr = $s_meta->find_attribute_by_name($s_attr_name);
32afff5d 778 confess("Unable to find attribute for '${s_attr_name}' via '${source}'")
779 unless defined $s_attr;
f670cfd0 780 next unless $s_attr->get_write_method; #only rw attributes!
781
782 my $attr_params = $self->parameters_for_source_object_action_attribute
783 (
784 object_class => $object,
785 source_class => $source,
786 attribute_name => $attr_name
787 );
7adfd53f 788 $meta->add_attribute( $attr_name => %$attr_params);
789 }
790
791 $meta->make_immutable if $make_immutable;
792 return $meta;
793 };
794
f670cfd0 795 implements parameters_for_source_object_action_attribute => as {
7adfd53f 796 my ($self, %opts) = @_;
797
f670cfd0 798 my $object = delete $opts{object_class};
799 my $attr_name = delete $opts{attribute_name};
800 my $source_class = delete $opts{source_class};
801 confess("object_class and attribute_name are required parameters")
802 unless $attr_name && $object;
803
804 my $o_meta = $object->meta;
805 my $dm_name = $o_meta->find_attribute_by_name($attr_name)->domain_model;
806 $source_class ||= $o_meta->find_attribute_by_name($dm_name)->_isa_metadata;
807 my $from_attr = $source_class->meta->find_attribute_by_name($attr_name);
7adfd53f 808
809 confess("${attr_name} is not writeable and can not be reflected")
810 unless $from_attr->get_write_method;
811
812 my %attr_opts = (
813 is => 'rw',
814 isa => $from_attr->_isa_metadata,
815 required => $from_attr->is_required,
e44959e8 816 ($from_attr->is_required
817 ? () : (clearer => "clear_$attr_name}")),
7adfd53f 818 predicate => "has_${attr_name}",
819 );
820
821 if ($attr_opts{required}) {
3fad510b 822 if($from_attr->has_default) {
823 $attr_opts{lazy} = 1;
824 $attr_opts{default} = $from_attr->default;
825 } else {
826 $attr_opts{lazy_fail} = 1;
827 }
7adfd53f 828 }
829
830 #test for relationships
831 my $constraint_is_ArrayRef =
832 $from_attr->type_constraint->name eq 'ArrayRef' ||
833 $from_attr->type_constraint->is_subtype_of('ArrayRef');
834
f670cfd0 835 my $source = $source_class->result_source_instance;
7adfd53f 836 if (my $rel_info = $source->relationship_info($attr_name)) {
837 my $rel_accessor = $rel_info->{attrs}->{accessor};
838
839 if($rel_accessor eq 'multi' && $constraint_is_ArrayRef) {
840 confess "${attr_name} is a rw has_many, this won't work.";
841 } elsif( $rel_accessor eq 'single') {
842 $attr_opts{valid_values} = sub {
843 shift->target_model->result_source->related_source($attr_name)->resultset;
844 };
845 }
846 } elsif ( $constraint_is_ArrayRef && $attr_name =~ m/^(.*)_list$/) {
847 my $mm_name = $1;
848 my $link_table = "links_to_${mm_name}_list";
849 my ($hm_source, $far_side);
850 eval { $hm_source = $source->related_source($link_table); }
851 || confess "Can't find ${link_table} has_many for ${mm_name}_list";
852 eval { $far_side = $hm_source->related_source($mm_name); }
853 || confess "Can't find ${mm_name} belongs_to on ".$hm_source->result_class
854 ." traversing many-many for ${mm_name}_list";
855
856 $attr_opts{default} = sub { [] };
857 $attr_opts{valid_values} = sub {
f670cfd0 858 shift->target_model->result_source->related_source($link_table)
7adfd53f 859 ->related_source($mm_name)->resultset;
860 };
861 }
f670cfd0 862 #use Data::Dumper;
89939ff9 863 #print STDERR "\n" .$attr_name ." - ". $object . "\n";
f670cfd0 864 #print STDERR Dumper(\%attr_opts);
7adfd53f 865 return \%attr_opts;
866 };
867
868};
869
8701;
0402136b 871
872#--------#---------#---------#---------#---------#---------#---------#---------#
873__END__;
874
875=head1 NAME
876
877Reaction::InterfaceModel::Reflector::DBIC -
878Automatically Generate InterfaceModels from DBIx::Class models
879
880=head1 DESCRIPTION
881
882The InterfaceModel reflectors are classes that are meant to aid you in easily
883generating Reaction::InterfaceModel classes that represent their underlying
884DBIx::Class domain models by introspecting your L<DBIx::Class::ResultSource>s
885and creating a collection of L<Reaction::InterfaceModel::Object> and
886L<Reaction::InterfaceModel::Collection> classes for you to use.
887
888The default base class of all Object classes will be
889 L<Reaction::InterfaceModel::Object> and the default Collection type will be
890L<Reaction::InterfaceModel::Collection::Virtual::ResultSet>.
891
892Additionally, the reflector can create InterfaceModel actions that interact
893with the supplied L<Reaction::UI::Controller::Collection::CRUD>, allowing you
894to easily set up a highly customizable CRUD interface in minimal time.
895
896At this time, supported collection actions consist of:
897
898=over 4
899
900=item B<> L<Reaction::INterfaceModel::Action::DBIC::ResultSet::Create>
901
902Creates a new item in the collection and underlying ResultSet.
903
904=item B<> L<Reaction::INterfaceModel::Action::DBIC::ResultSet::DeleteAll>
905
906Deletes all the items in a collection and it's underlying resultset using
907C<delete_all>
908
909=back
910
911And supported object actions are :
912
913=over 4
914
915=item B<Update> - via L<Reaction::INterfaceModel::Action::DBIC::Result::Update>
916
917Updates an existing object.
918
919=item B<Delete> - via L<Reaction::INterfaceModel::Action::DBIC::Result::Delete>
920
921Deletes an existing object.
922
923=back
924
925=head1 SYNOPSIS
926
927 package MyApp::IM::TestModel;
928 use base 'Reaction::InterfaceModel::Object';
929 use Reaction::Class;
930 use Reaction::InterfaceModel::Reflector::DBIC;
931 my $reflector = Reaction::InterfaceModel::Reflector::DBIC->new;
932
933 #Reflect everything
934 $reflector->reflect_schema
935 (
936 model_class => __PACKAGE__,
937 schema_class => 'MyApp::Schema',
938 );
939
940=head2 Selectively including and excluding sources
941
942 #reflect everything except for the FooBar and FooBaz classes
943 $reflector->reflect_schema
944 (
945 model_class => __PACKAGE__,
946 schema_class => 'MyApp::Schema',
947 sources => [-exclude => [qw/FooBar FooBaz/] ],
948 # you could also do:
949 sources => [-exclude => qr/(?:FooBar|FooBaz)/,
950 # or even
951 sources => [-exclude => [qr/FooBar/, qr/FooBaz/],
952 );
953
954 #reflect only the Foo family of sources
955 $reflector->reflect_schema
956 (
957 model_class => __PACKAGE__,
958 schema_class => 'MyApp::Schema',
959 sources => qr/^Foo/,
960 );
961
962=head2 Selectively including and excluding fields in sources
963
964 #Reflect Foo and Baz in their entirety and exclude the field 'avatar' in the Bar ResultSource
965 $reflector->reflect_schema
966 (
967 model_class => __PACKAGE__,
968 schema_class => 'MyApp::Schema',
969 sources => [qw/Foo Baz/,
970 [ Bar => {attributes => [[-exclude => 'avatar']] } ],
971 # or exclude by regex
972 [ Bar => {attributes => [-exclude => qr/avatar/] } ],
973 # or simply do not include it...
974 [ Bar => {attributes => [qw/id name description/] } ],
975 ],
976 );
977
978=head1 ATTRIBUTES
979
980=head2 make_classes_immutable
981
982=head2 object_actions
983
984=head2 collection_actions
985
986=head2 default_object_actions
987
988=head2 default_collection_actions
989
990=head2 builtin_object_actions
991
992=head2 builtin_collection_actions
993
994=head1 METHODS
995
996=head2 new
997
998=head2 _all_object_actions
999
1000=head2 _all_collection_actions
1001
1002=head2 dm_name_from_class_name
1003
1004=head2 dm_name_from_source_name
1005
1006=head2 class_name_from_source_name
1007
1008=head2 class_name_for_collection_of
1009
1010=head2 merge_hashes
1011
1012=head2 parse_reflect_rules
1013
1014=head2 merge_reflect_rules
1015
1016=head2 reflect_schema
1017
1018=head2 _compute_source_options
1019
1020=head2 add_source
1021
1022=head2 reflect_source
1023
1024=head2 reflect_source_collection
1025
1026=head2 reflect_source_object
1027
1028=head2 reflect_source_object_attribute
1029
1030=head2 parameters_for_source_object_attribute
1031
1032=head2 reflect_source_action
1033
1034=head2 parameters_for_source_object_action_attribute
1035
1036=head1 TODO
1037
1038Allow the reflector to dump the generated code out as files, eliminating the need to
1039reflect on startup every time. This will likely take quite a bit of work though. The
1040main work is already in place, but the grunt work is still left. At the moment there
1041is no closures that can't be dumped out as code with a little bit of work.
1042
1043=head1 AUTHORS
1044
1045See L<Reaction::Class> for authors.
1046
1047=head1 LICENSE
1048
1049See L<Reaction::Class> for the license.
1050
1051=cut
'Reaction' or the likes