X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FReaction%2FInterfaceModel%2FReflector%2FDBIC.pm;h=3643bd1f37eee10c2c5d2744fba5313ae9c71618;hb=7517cfe59c66f16fa08ce171b997f6bd7ff32ba5;hp=1acc9676f5336037a00aed87c979542b475d2ddf;hpb=1734a92a996a20dd6d292fc4aea58e876c24249b;p=catagits%2FReaction.git diff --git a/lib/Reaction/InterfaceModel/Reflector/DBIC.pm b/lib/Reaction/InterfaceModel/Reflector/DBIC.pm index 1acc967..3643bd1 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 @@ -279,6 +278,11 @@ class DBIC, which { }; }; + implements _class_to_attribute_name => as { + my ( $self, $str ) = @_; + confess("wrong arguments passed for _class_to_attribute_name") unless $str; + return join('_', map lc, split(/::|(?<=[a-z0-9])(?=[A-Z])/, $str)) + }; implements add_source => as { my ($self, %opts) = @_; @@ -301,7 +305,7 @@ class DBIC, which { unless( $reader ){ $reader = $source; $reader =~ s/([a-z0-9])([A-Z])/${1}_${2}/g ; - $reader = join('_', map lc, split(/::/, $reader)) . "_collection"; #XXX change to not use _collection ? + $reader = $self->_class_to_attribute_name($reader) . "_collection"; } unless( $dm_name ){ my @haystack = $meta->domain_models; @@ -324,14 +328,38 @@ class DBIC, which { required => 1, isa => $collection, reader => $reader, - predicate => "has_" . join('_', map lc, split(/::|(?<=[a-z0-9])(?=[A-Z])/, $name)), + predicate => "has_" . $self->_class_to_attribute_name($name) , domain_model => $dm_name, orig_attr_name => $source, default => sub { - $collection->new(_source_resultset => shift->$dm_name->resultset($source)); + my $self = $_[0]; + return $collection->new( + _source_resultset => $self->$dm_name->resultset($source), + _parent => $self, + ); }, ); +# 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); @@ -375,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; @@ -463,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); @@ -660,6 +686,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; @@ -701,6 +729,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; @@ -756,8 +792,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; @@ -768,7 +803,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 ( @@ -797,6 +833,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; @@ -804,13 +842,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 @@ -851,6 +894,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;