0001-for-MouseX-Foreign.patch

From 06b773719f68119491f1c84c497ea98a872d230d Mon Sep 17 00:00:00 2001
From: Taiyoh Tanaka <[email protected]>
Date: Tue, 5 Oct 2010 14:09:48 +0900
Subject: [PATCH] =?UTF-8?q?MouseX::Foreign=E5=AF=BE=E5=BF=9C?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit


Signed-off-by: Taiyoh Tanaka <[email protected]>
---
 lib/Ark/Core.pm      |    4 ++-
 lib/Ark/Loader.pm    |   59 ++++++++++++++++++++++++++++++++++++++++++++++++++
 lib/Ark/Models.pm    |   12 ++++------
 lib/Ark/Request.pm   |   13 +++++------
 lib/Ark/Test.pm      |    4 ++-
 t/loader.t           |   29 ++++++++++++++++++++++++
 t/plugin_unicode.t   |    6 ++--
 7 files changed, 108 insertions(+), 19 deletions(-)
 mode change 100644 => 100755 lib/Ark/Component.pm
 mode change 100644 => 100755 lib/Ark/Core.pm
 create mode 100755 lib/Ark/Loader.pm
 mode change 100644 => 100755 lib/Ark/Models.pm
 mode change 100644 => 100755 lib/Ark/Request.pm
 mode change 100644 => 100755 lib/Ark/Test.pm
 mode change 100644 => 100755 t/action_chain.t
 create mode 100755 t/loader.t
 mode change 100644 => 100755 t/plugin_unicode.t

diff --git a/lib/Ark/Component.pm b/lib/Ark/Component.pm
old mode 100644
new mode 100755
diff --git a/lib/Ark/Core.pm b/lib/Ark/Core.pm
old mode 100644
new mode 100755
index 9b19bba..a5e0356
--- a/lib/Ark/Core.pm
+++ b/lib/Ark/Core.pm
@@ -1,6 +1,7 @@
 package Ark::Core;
 use Any::Moose;
 
+use Ark::Loader qw/superclass/;
 use Ark::Context;
 use Ark::Request;
 use Ark::Response;
@@ -11,7 +12,8 @@ use Exporter::AutoClean;
 use Path::Class qw/file dir/;
 use Path::AttrRouter;
 
-extends any_moose('::Object'), 'Class::Data::Inheritable';
+extends any_moose('::Object');
+superclass 'Class::Data::Inheritable';
 
 __PACKAGE__->mk_classdata($_)
     for qw/context configdata plugins _class_stash external_model_class/;
diff --git a/lib/Ark/Loader.pm b/lib/Ark/Loader.pm
new file mode 100755
index 0000000..515c592
--- /dev/null
+++ b/lib/Ark/Loader.pm
@@ -0,0 +1,59 @@
+package Ark::Loader;
+
+use strict;
+use warnings;
+use utf8;
+BEGIN { require 'Any/Moose.pm' };
+
+sub import {
+    shift if $_[0] =~ /Ark::Loader/;
+    my $caller = caller;
+    @_ = qw/ensure_class_loaded superclass/ unless @_;
+    my %opts = map { $_ => 1 } @_;
+    no strict 'refs';
+    no warnings 'once';
+    *{"$caller\::ensure_class_loaded"} = \&ensure_class_loaded
+        if !$caller->can('ensure_class_loaded') && $opts{ensure_class_loaded};
+    *{"$caller\::superclass"} = \&superclass
+        if !$caller->can('superclass') && $opts{superclass};
+}
+
+sub superclass {
+    my $caller = caller;
+    return unless @_;
+    if(!$caller->can('meta')) {
+        Carp::croak(
+            "$caller does not have the meta method"
+          . " (did you use Mo(o|u)se for $caller?)");
+    }
+    if (Any::Moose::_is_moose_loaded()) {
+        ensure_class_loaded('MooseX::NonMoose');
+        $caller->meta->extends(@_);
+    }
+    else {
+        # from MouseX::Foreign 0.003
+        if (ensure_class_loaded('MouseX::Foreign')) {
+            Mouse::Util::MetaRole::apply_metaroles(
+                for => $caller,
+                class_metaroles => {
+                    class => ['MouseX::Foreign::Meta::Role::Class'],
+                },
+            );
+        }
+        $caller->meta->superclasses(@_);
+    }
+}
+
+sub ensure_class_loaded {
+    shift if $_[0] =~ /Ark::Loader/;
+    my $ok = my $total = 0;
+    for (@_) {
+        unless (Any::Moose::is_class_loaded($_)) {
+            $total++;
+            $ok++ if Any::Moose::load_class($_);
+        }
+    }
+    $ok == $total;
+}
+
+1;
diff --git a/lib/Ark/Models.pm b/lib/Ark/Models.pm
old mode 100644
new mode 100755
index 4e21b39..36519d7
--- a/lib/Ark/Models.pm
+++ b/lib/Ark/Models.pm
@@ -1,7 +1,9 @@
 package Ark::Models;
 use Any::Moose;
+use Ark::Loader;
 
-extends any_moose('::Object'), 'Object::Container';
+extends any_moose('::Object');
+superclass 'Object::Container';
 
 use Exporter::AutoClean;
 use Path::Class qw/file dir/;
@@ -108,7 +110,7 @@ sub adaptor {
     my $class       = $info->{class} or die q{Required class parameter};
     my $constructor = $info->{constructor} || 'new';
 
-    $self->ensure_class_loaded($class);
+    ensure_class_loaded($class);
 
     my $instance;
     if ($info->{deref} and my $args = $info->{args}) {
@@ -161,7 +163,7 @@ sub get {
 
         my $class = $ns . '::' . join '::', @classes;
 
-        $self->ensure_class_loaded($class);
+        ensure_class_loaded($class);
         return $self->objects->{ $_[0] } = $class->new;
     }
     else {
@@ -169,8 +171,4 @@ sub get {
     }
 }
 
-sub ensure_class_loaded {
-    Any::Moose::load_class($_[1]);
-}
-
 __PACKAGE__->meta->make_immutable;
diff --git a/lib/Ark/Request.pm b/lib/Ark/Request.pm
old mode 100644
new mode 100755
index e361c4a..d1e7974
--- a/lib/Ark/Request.pm
+++ b/lib/Ark/Request.pm
@@ -1,6 +1,9 @@
 package Ark::Request;
 use Any::Moose;
 
+use Ark::Loader;
+superclass 'Plack::Request';
+
 use URI::WithBase;
 use Path::AttrRouter::Match;
 
@@ -20,13 +23,9 @@ no Any::Moose;
 sub wrap {
     my ($class, $req) = @_;
 
-    if ($req->isa('Plack::Request')) {
-        $class->meta->superclasses('Plack::Request');
-        return  $class->new( $req->env );
-    }
-    else {
-        die "Request class should be inheritance Plack::Request";
-    }
+    die "Request class should be inheritance Plack::Request"
+        unless $req->isa('Plack::Request');
+    return $class->new( $req->env );
 }
 
 sub uri_with {
diff --git a/lib/Ark/Test.pm b/lib/Ark/Test.pm
old mode 100644
new mode 100755
index f29ebb0..63e1c5e
--- a/lib/Ark/Test.pm
+++ b/lib/Ark/Test.pm
@@ -8,6 +8,7 @@ use Plack::Test;
 use FindBin;
 use Path::Class qw/dir/;
 
+use Ark::Loader;
 use Ark::Test::Context;
 
 sub import {
@@ -17,7 +18,8 @@ sub import {
 
     return unless $app_class;
 
-    Any::Moose::load_class($app_class) unless Any::Moose::is_class_loaded($app_class);
+    #Any::Moose::load_class($app_class) unless Any::Moose::is_class_loaded($app_class);
+    ensure_class_loaded($app_class);
 
     my $persist_app = undef;
     my $cookie;
diff --git a/t/action_chain.t b/t/action_chain.t
old mode 100644
new mode 100755
diff --git a/t/loader.t b/t/loader.t
new file mode 100755
index 0000000..f7d6914
--- /dev/null
+++ b/t/loader.t
@@ -0,0 +1,29 @@
+use Test::Base;
+use FindBin;
+
+plan 'no_plan';
+
+{
+    package MyTest;
+    use Any::Moose;
+    use Ark::Loader;
+
+    superclass 'DateTime';
+
+    __PACKAGE__->meta->make_immutable;
+}
+
+do {
+    my $test = MyTest->new(
+        year => 2010,
+        month => 10,
+        day => 5,
+        hour => 8,
+        minute => 51,
+        second => 32
+    );
+
+    ok $test->can('meta'), "meta method exists";
+    ok $test->can('year'), "DateTime's method exists";
+};
+
diff --git a/t/plugin_unicode.t b/t/plugin_unicode.t
old mode 100644
new mode 100755
index 8815c1d..32ae5fd
--- a/t/plugin_unicode.t
+++ b/t/plugin_unicode.t
@@ -17,10 +17,10 @@ use Test::Base;
         my $test = 'テスト';
         Test::More::ok( utf8::is_utf8($test), 'utf8 flag automatically on by Ark' );
 
-        Test::More::ok(utf8::is_utf8( $c->req->params->{foo} ), 'request is utf8');
-        Test::More::is($c->req->params->{foo}, $test, 'request ok');
+        Test::More::ok(utf8::is_utf8( $c->req->parameters->{foo} ), 'request is utf8');
+        Test::More::is($c->req->parameters->{foo}, $test, 'request ok');
 
-        $c->res->body( $c->req->params->{foo} );
+        $c->res->body( $c->req->parameters->{foo} );
     }
 }
 
-- 
1.7.0.4