package Fey::Meta::Method::Constructor; BEGIN { $Fey::Meta::Method::Constructor::VERSION = '0.43'; } use strict; use warnings; use namespace::autoclean; use Moose; extends 'Moose::Meta::Method::Constructor'; sub _expected_method_class { return 'Fey::Object::Table'; } if ( $Moose::VERSION < 1.9900 ) { eval <<'EOF'; # XXX - This is copied straight from Moose 0.36 because there's no # good way to override it (note the eval it does at the end). sub _initialize_body { my $self = shift; # TODO: # the %options should also include a both # a call 'initializer' and call 'SUPER::' # options, which should cover approx 90% # of the possible use cases (even if it # requires some adaption on the part of # the author, after all, nothing is free) my $source = 'sub {'; $source .= "\n" . 'my $class = shift;'; $source .= "\n" . 'return $class->Moose::Object::new(@_)'; $source .= "\n" . ' if $class ne \'' . $self->associated_metaclass->name . '\';'; $source .= "\n" . 'my $params = ' . $self->_generate_BUILDARGS( '$class', '@_' ); # XXX - override $source .= ";\n" . $self->_inline_search_cache(); # XXX - override $source .= "\n" . 'my $instance;'; $source .= "\n" . '$class->_ClearConstructorError();'; $source .= "\n" . 'my @args = @_;'; # XXX - override $source .= "\n" . 'Try::Tiny::try {'; $source .= "\n" . '@_ = @args;'; # XXX - override $source .= "\n" . '$instance = ' . $self->associated_metaclass()->inline_create_instance('$class'); $source .= ";\n"; $source .= $self->_generate_params( '$params', '$class' ); $source .= $self->_generate_slot_initializers(); $source .= $self->_generate_triggers(); $source .= ";\n" . $self->_generate_BUILDALL(); # XXX - override $source .= ";\n" . '}'; # XXX - override $source .= "\n" . 'Try::Tiny::catch {'; $source .= "\n" . ' die $_ unless Scalar::Util::blessed($_) && $_->isa(q{Fey::Exception::NoSuchRow});'; $source .= "\n" . ' $class->_SetConstructorError($_);'; $source .= "\n" . ' undef $instance;'; $source .= "\n" . '};'; # XXX - override $source .= "\n" . 'return unless $instance;'; $source .= "\n" . $self->_inline_write_to_cache(); $source .= "\n" . 'return $instance;'; $source .= "\n" . '}'; # XXX - override $source .= "\n"; warn $source if $self->options->{debug}; my $attrs = $self->_attributes; my @type_constraints = map { $_->can('type_constraint') ? $_->type_constraint : undef } @$attrs; my @type_constraint_bodies = map { defined $_ ? $_->_compiled_type_constraint : undef; } @type_constraints; my ( $code, $e ) = $self->_compile_code( code => $source, environment => { '$meta' => \$self, '$metaclass' => \( $self->associated_metaclass ), '$attrs' => \$attrs, '@type_constraints' => \@type_constraints, '@type_constraint_bodies' => \@type_constraint_bodies, }, ); $self->throw_error( "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$e", error => $e, data => $source ) if $e; $self->{'body'} = $code; } sub _inline_search_cache { my $self = shift; my $source = "\n" . 'if ( $metaclass->_object_cache_is_enabled() ) {'; $source .= "\n" . ' my $cached = $metaclass->_search_cache($params);'; $source .= "\n" . ' return $cached if $cached;'; $source .= "\n" . '}'; } sub _inline_write_to_cache { my $self = shift; return "\n" . '$metaclass->_write_to_cache($instance) if $metaclass->_object_cache_is_enabled();'; } EOF } else { override _eval_environment => sub { my $self = shift; my $env = super(); $env->{'$metaclass'} = \( $self->associated_metaclass() ); return $env; }; } 1;