X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FReaction%2FInterfaceModel%2FReflector%2FDBIC.pm;h=2c34cdf0c9602bfbf102a6c9b3eb07ff4f7b590a;hb=4949e0ee7a1162bca838822095e6cd2da527e2d2;hp=b52d485b678f819058a90f87b41e6a51ed1627c2;hpb=46937531eb2d28950b21c8b0982539e28b277b60;p=catagits%2FReaction.git diff --git a/lib/Reaction/InterfaceModel/Reflector/DBIC.pm b/lib/Reaction/InterfaceModel/Reflector/DBIC.pm index b52d485..2c34cdf 100644 --- a/lib/Reaction/InterfaceModel/Reflector/DBIC.pm +++ b/lib/Reaction/InterfaceModel/Reflector/DBIC.pm @@ -161,8 +161,7 @@ class DBIC, which { unless($model && $schema); Class::MOP::load_class( $base ); Class::MOP::load_class( $schema ); - my $meta = eval { Class::MOP::load_class($model); } ? - $model->meta : $base->meta->create($model, superclasses => [ $base ]); + my $meta = $self->_load_or_create($model, $base); # sources => undef, #default to qr/./ # sources => [], #default to nothing @@ -333,10 +332,34 @@ class DBIC, which { domain_model => $dm_name, orig_attr_name => $source, default => sub { - $collection->new(_source_resultset => shift->$dm_name->resultset($source)); + $collection->new + ( + _source_resultset => $_[0]->$dm_name->resultset($source), + _parent => $_[0], + ); }, ); +# my %debug_attr_opts = +# ( +# lazy => 1, +# required => 1, +# isa => $collection, +# reader => $reader, +# predicate => "has_" . $self->_class_to_attribute_name($name) , +# domain_model => $dm_name, +# orig_attr_name => $source, +# default => qq^sub { +# my \$self = \$_[0]; +# return $collection->new( +# _source_resultset => \$self->$dm_name->resultset("$source"), +# _parent => \$self, +# ); +# }, ^, +# ); + + + my $make_immutable = $meta->is_immutable; $meta->make_mutable if $make_immutable; my $attr = $meta->add_attribute($name, %attr_opts); @@ -359,9 +382,9 @@ class DBIC, which { ); $self->add_source( - model_class => $opts{parent_class}, - source_name => $opts{source_name}, - domain_model_name => $opts{parent_domain_model_name}, + %opts, + model_class => delete $opts{parent_class}, + domain_model_name => delete $opts{parent_domain_model_name}, collection_class => $col_meta->name, ); }; @@ -380,8 +403,7 @@ class DBIC, which { Class::MOP::load_class( $base ); Class::MOP::load_class( $object ); - my $meta = eval { Class::MOP::load_class($class) } ? - $class->meta : $base->meta->create( $class, superclasses => [ $base ]); + my $meta = $self->_load_or_create($class, $base); my $make_immutable = $meta->is_immutable || $self->make_classes_immutable;; $meta->make_mutable if $meta->is_immutable; @@ -468,8 +490,7 @@ class DBIC, which { Class::MOP::load_class($schema) if $schema; Class::MOP::load_class($source_class); - my $meta = eval { Class::MOP::load_class($class) } ? - $class->meta : $base->meta->create($class, superclasses => [ $base ]); + my $meta = $self->_load_or_create($class, $base); #create the domain model $dm_name ||= $self->dm_name_from_source_name($source_name); @@ -655,7 +676,10 @@ class DBIC, which { #default options. lazy build but no outsider method my %attr_opts = ( is => 'ro', lazy => 1, required => 1, clearer => "_clear_${attr_name}", - predicate => "has_${attr_name}", + predicate => { + "has_${attr_name}" => + sub { defined(shift->$dm_name->$attr_name) } + }, domain_model => $dm_name, orig_attr_name => $attr_name, ); @@ -665,6 +689,8 @@ class DBIC, which { $from_attr->type_constraint->name eq 'ArrayRef' || $from_attr->type_constraint->is_subtype_of('ArrayRef'); + + if( my $rel_info = $source->relationship_info($attr_name) ){ my $rel_accessor = $rel_info->{attrs}->{accessor}; my $rel_moniker = $rel_info->{class}->result_source_instance->source_name; @@ -683,8 +709,11 @@ class DBIC, which { #type constraint is the foreign IM object, default inflates it $attr_opts{isa} = $self->class_name_from_source_name($parent_class, $rel_moniker); $attr_opts{default} = sub { - shift->$dm_name - ->find_related($attr_name, {},{result_class => $attr_opts{isa}}); + if (defined(my $o = shift->$dm_name->$attr_name)) { + return $attr_opts{isa}->inflate_result($o->result_source, { $o->get_columns }); + } + return undef; + #->find_related($attr_name, {},{result_class => $attr_opts{isa}}); }; } } elsif( $constraint_is_ArrayRef && $attr_name =~ m/^(.*)_list$/ ) { @@ -706,6 +735,14 @@ class DBIC, which { my $rs = shift->$dm_name->related_resultset($link_table)->related_resultset($mm_name); return $attr_opts{isa}->new(_source_resultset => $rs); }; + #} elsif( $constraint_is_ArrayRef ){ + #test these to see if rel is m2m + #my $meth = $attr_name; + #if( $source->can("set_${meth}") && $source->can("add_to_${meth}") && + # $source->can("${meth}_rs") && $source->can("remove_from_${meth}") ){ + + + #} } else { #no rel my $reader = $from_attr->get_read_method; @@ -761,8 +798,7 @@ class DBIC, which { my $attributes = $self->parse_reflect_rules($attr_rules, $attr_haystack); #create the class - my $meta = eval { Class::MOP::load_class($class) } ? - $class->meta : $base->meta->create($class, superclasses => [$base]); + my $meta = $self->_load_or_create($class, $base); my $make_immutable = $meta->is_immutable || $self->make_classes_immutable; $meta->make_mutable if $meta->is_immutable; @@ -773,7 +809,8 @@ class DBIC, which { my $s_attr = $s_meta->find_attribute_by_name($s_attr_name); confess("Unable to find attribute for '${s_attr_name}' via '${source}'") unless defined $s_attr; - next unless $s_attr->get_write_method; #only rw attributes! + next unless $s_attr->get_write_method + && $s_attr->get_write_method !~ /^_/; #only rw attributes! my $attr_params = $self->parameters_for_source_object_action_attribute ( @@ -802,6 +839,8 @@ class DBIC, which { $source_class ||= $o_meta->find_attribute_by_name($dm_name)->_isa_metadata; my $from_attr = $source_class->meta->find_attribute_by_name($attr_name); + #print STDERR "$attr_name is type: " . $from_attr->meta->name . "\n"; + confess("${attr_name} is not writeable and can not be reflected") unless $from_attr->get_write_method; @@ -809,13 +848,18 @@ class DBIC, which { is => 'rw', isa => $from_attr->_isa_metadata, required => $from_attr->is_required, + ($from_attr->is_required + ? () : (clearer => "clear_${attr_name}")), predicate => "has_${attr_name}", ); if ($attr_opts{required}) { - $attr_opts{lazy} = 1; - $attr_opts{default} = $from_attr->has_default ? - $from_attr->default : sub{}; + if($from_attr->has_default) { + $attr_opts{lazy} = 1; + $attr_opts{default} = $from_attr->default; + } else { + $attr_opts{lazy_fail} = 1; + } } #test for relationships @@ -856,6 +900,24 @@ class DBIC, which { return \%attr_opts; }; + implements _load_or_create => as { + my ($self, $class, $base) = @_; + my $meta = $self->_maybe_load_class($class) ? + $class->meta : $base->meta->create($class, superclasses => [ $base ]); + return $meta; + }; + + implements _maybe_load_class => as { + my ($self, $class) = @_; + my $file = $class . '.pm'; + $file =~ s{::}{/}g; + my $ret = eval { Class::MOP::load_class($class) }; + if ($INC{$file} && $@) { + confess "Error loading ${class}: $@"; + } + return $ret; + }; + }; 1;