From 94ca14721241ff804bab06c56867574887dcd907 Mon Sep 17 00:00:00 2001
From: Jesse Luehrs <doy@tozt.net>
Date: Mon, 4 May 2009 01:46:31 -0500
Subject: start trying to add the FOREIGNBUILDARGS stuff

---
 lib/MooseX/NonMoose/Meta/Role/Class.pm       | 5 ++++-
 lib/MooseX/NonMoose/Meta/Role/Constructor.pm | 8 ++++++--
 2 files changed, 10 insertions(+), 3 deletions(-)

(limited to 'lib')

diff --git a/lib/MooseX/NonMoose/Meta/Role/Class.pm b/lib/MooseX/NonMoose/Meta/Role/Class.pm
index 403b2c8..0ccc5b9 100644
--- a/lib/MooseX/NonMoose/Meta/Role/Class.pm
+++ b/lib/MooseX/NonMoose/Meta/Role/Class.pm
@@ -118,7 +118,10 @@ around superclasses => sub {
         my $class = shift;
 
         my $params = $class->BUILDARGS(@_);
-        my $instance = $super_new->execute($class, @_);
+        my @foreign_params = $class->can('FOREIGNBUILDARGS')
+                           ? $class->FOREIGNBUILDARGS(@_)
+                           : @_;
+        my $instance = $super_new->execute($class, @foreign_params);
         my $self = Class::MOP::Class->initialize($class)->new_object(
             __INSTANCE__ => $instance,
             %$params,
diff --git a/lib/MooseX/NonMoose/Meta/Role/Constructor.pm b/lib/MooseX/NonMoose/Meta/Role/Constructor.pm
index 24b6966..7b657e4 100644
--- a/lib/MooseX/NonMoose/Meta/Role/Constructor.pm
+++ b/lib/MooseX/NonMoose/Meta/Role/Constructor.pm
@@ -53,12 +53,16 @@ sub _generate_instance {
     my $self = shift;
     my ($var, $class_var) = @_;
     my $new = $self->name;
-    my $super_new_class = $self->associated_metaclass->find_next_method_by_name($new)->package_name;
+    my $meta = $self->associated_metaclass;
+    my $super_new_class = $meta->find_next_method_by_name($new)->package_name;
+    my $arglist = $meta->find_method_by_name('FOREIGNBUILDARGS')
+                ? "${class_var}->FOREIGNBUILDARGS(\@_)"
+                : '@_';
     # XXX: this should probably be taking something from the meta-instance api,
     # rather than calling bless directly, but this works fine for now, and i
     # want to wait for the whole immutablization stuff to settle down before
     # digging too deeply into it
-    "my $var = bless $super_new_class->$new(\@_), $class_var;\n";
+    "my $var = bless $super_new_class->$new($arglist), $class_var;\n";
 }
 
 no Moose::Role;
-- 
cgit v1.2.3