summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2011-02-09 20:54:14 -0600
committerJesse Luehrs <doy@tozt.net>2011-02-09 20:54:14 -0600
commit427c7802170813f206241e5d0289575cae82079b (patch)
tree32517bf59637fd18ce129f32ac3c807191da236d
parent1d65d3c9ff7a1645522ca9a37ee3eacf98c4a00f (diff)
downloadmoosex-nonmoose-427c7802170813f206241e5d0289575cae82079b.tar.gz
moosex-nonmoose-427c7802170813f206241e5d0289575cae82079b.zip
moose 2.0 compatibility
-rw-r--r--lib/MooseX/NonMoose/Meta/Role/Class.pm66
-rw-r--r--lib/MooseX/NonMoose/Meta/Role/Constructor.pm19
2 files changed, 70 insertions, 15 deletions
diff --git a/lib/MooseX/NonMoose/Meta/Role/Class.pm b/lib/MooseX/NonMoose/Meta/Role/Class.pm
index 1fac4a5..1d1796a 100644
--- a/lib/MooseX/NonMoose/Meta/Role/Class.pm
+++ b/lib/MooseX/NonMoose/Meta/Role/Class.pm
@@ -229,6 +229,72 @@ around superclasses => sub {
return @ret;
};
+sub _generate_fallback_constructor {
+ my $self = shift;
+ my ($class_var) = @_;
+
+ my $new = $self->constructor_name;
+ my $super_new_class = $self->_find_next_nonmoose_constructor_package;
+ my $arglist = $self->find_method_by_name('FOREIGNBUILDARGS')
+ ? "${class_var}->FOREIGNBUILDARGS(\@_)"
+ : '@_';
+ my $instance = "${class_var}->${super_new_class}::$new($arglist)";
+ # XXX: the "my $__DUMMY = " part is because "return do" triggers a weird
+ # bug in pre-5.12 perls (it ends up returning undef)
+ return '(my $__DUMMY = do { '
+ . 'if (ref($_[0]) eq \'HASH\') { '
+ . '$_[0]->{__INSTANCE__} = ' . $instance . ' '
+ . 'unless exists $_[0]->{__INSTANCE__}; '
+ . '} '
+ . 'else { '
+ . 'unshift @_, __INSTANCE__ => ' . $instance . '; '
+ . '} '
+ . $class_var . '->Moose::Object::new(@_); '
+ . '})';
+}
+
+sub _inline_generate_instance {
+ my $self = shift;
+ my ($var, $class_var) = @_;
+
+ my $new = $self->constructor_name;
+ my $super_new_class = $self->_find_next_nonmoose_constructor_package;
+ my $arglist = $self->find_method_by_name('FOREIGNBUILDARGS')
+ ? "${class_var}->FOREIGNBUILDARGS(\@_)"
+ : '@_';
+ my $instance = "${class_var}->${super_new_class}::$new($arglist)";
+ return (
+ 'my ' . $var . ' = ' . $instance . ';',
+ 'if (!Scalar::Util::blessed(' . $var . ')) {',
+ $self->_inline_throw_error(
+ '"The constructor for ' . $super_new_class . ' did not return a blessed instance"',
+ ) . ';',
+ '}',
+ 'elsif (!' . $var . '->isa(' . $class_var . ')) {',
+ 'if (!' . $class_var . '->isa(Scalar::Util::blessed(' . $var . '))) {',
+ $self->_inline_throw_error(
+ '"The constructor for ' . $super_new_class . ' returned an object whose class is not a parent of ' . $class_var . '"',
+ ) . ';',
+ '}',
+ 'else {',
+ $self->_inline_rebless_instance($var, $class_var) . ';',
+ '}',
+ '}',
+ );
+}
+
+sub _find_next_nonmoose_constructor_package {
+ my $self = shift;
+ my $new = $self->constructor_name;
+ for my $method (map { $_->{code} } $self->find_all_methods_by_name($new)) {
+ next if $method->associated_metaclass->meta->can('does_role')
+ && $method->associated_metaclass->meta->does_role('MooseX::NonMoose::Meta::Role::Class');
+ return $method->package_name;
+ }
+ # this should never happen (it should find Moose::Object at least)
+ $self->throw_error("Couldn't find a non-Moose constructor for " . $self->name);
+}
+
no Moose::Role;
1;
diff --git a/lib/MooseX/NonMoose/Meta/Role/Constructor.pm b/lib/MooseX/NonMoose/Meta/Role/Constructor.pm
index db13781..272bc95 100644
--- a/lib/MooseX/NonMoose/Meta/Role/Constructor.pm
+++ b/lib/MooseX/NonMoose/Meta/Role/Constructor.pm
@@ -46,25 +46,13 @@ around can_be_inlined => sub {
return $self->$orig(@_);
};
-sub _find_next_nonmoose_constructor_package {
- my $self = shift;
- my $new = $self->name;
- my $meta = $self->associated_metaclass;
- for my $method (map { $_->{code} } $meta->find_all_methods_by_name($new)) {
- next if $method->associated_metaclass->meta->can('does_role')
- && $method->associated_metaclass->meta->does_role('MooseX::NonMoose::Meta::Role::Class');
- return $method->package_name;
- }
- # this should never happen (it should find Moose::Object at least)
- $meta->throw_error("Couldn't find a non-Moose constructor for " . $meta->name);
-}
-
+# for Moose 1.21 compatibility
sub _generate_fallback_constructor {
my $self = shift;
my ($class_var) = @_;
my $new = $self->name;
my $meta = $self->associated_metaclass;
- my $super_new_class = $self->_find_next_nonmoose_constructor_package;
+ my $super_new_class = $meta->_find_next_nonmoose_constructor_package;
my $arglist = $meta->find_method_by_name('FOREIGNBUILDARGS')
? "${class_var}->FOREIGNBUILDARGS(\@_)"
: '@_';
@@ -83,12 +71,13 @@ sub _generate_fallback_constructor {
. "}";
}
+# for Moose 1.21 compatibility
sub _generate_instance {
my $self = shift;
my ($var, $class_var) = @_;
my $new = $self->name;
my $meta = $self->associated_metaclass;
- my $super_new_class = $self->_find_next_nonmoose_constructor_package;
+ my $super_new_class = $meta->_find_next_nonmoose_constructor_package;
my $arglist = $meta->find_method_by_name('FOREIGNBUILDARGS')
? "${class_var}->FOREIGNBUILDARGS(\@_)"
: '@_';