From: Matt S Trout <mst@shadowcat.co.uk>
Date: Wed, 10 Nov 2010 00:21:45 +0000 (+0000)
Subject: factor out and rename
X-Git-Tag: 0.009001~48
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b1eebd55fe3d34b6afa73a4880737dc91379b71e;p=gitmo%2FMoo.git

factor out and rename
---

diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index 0711402..3a5ccd6 100644
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -1,8 +1,8 @@
 package Method::Generate::Accessor;
 
 use strictures 1;
-use Class::Tiny::_Utils;
-use base qw(Class::Tiny::Object);
+use Moo::_Utils;
+use base qw(Moo::Object);
 use Sub::Quote;
 use B 'perlstring';
 BEGIN {
diff --git a/lib/Method/Generate/BuildAll.pm b/lib/Method/Generate/BuildAll.pm
index 3b4b363..b8c8a19 100644
--- a/lib/Method/Generate/BuildAll.pm
+++ b/lib/Method/Generate/BuildAll.pm
@@ -1,10 +1,10 @@
 package Method::Generate::BuildAll;
 
 use strictures 1;
-use base qw(Class::Tiny::Object);
+use base qw(Moo::Object);
 use Sub::Quote;
-use Class::Tiny::_mro;
-use Class::Tiny::_Utils;
+use Moo::_mro;
+use Moo::_Utils;
 
 sub generate_method {
   my ($self, $into) = @_;
diff --git a/lib/Method/Generate/Constructor.pm b/lib/Method/Generate/Constructor.pm
index 08ec982..2360006 100644
--- a/lib/Method/Generate/Constructor.pm
+++ b/lib/Method/Generate/Constructor.pm
@@ -2,7 +2,7 @@ package Method::Generate::Constructor;
 
 use strictures 1;
 use Sub::Quote;
-use base qw(Class::Tiny::Object);
+use base qw(Moo::Object);
 use Sub::Defer;
 use B 'perlstring';
 
diff --git a/lib/Class/Tiny.pm b/lib/Moo.pm
similarity index 90%
rename from lib/Class/Tiny.pm
rename to lib/Moo.pm
index 906f25e..31727fe 100644
--- a/lib/Class/Tiny.pm
+++ b/lib/Moo.pm
@@ -1,7 +1,7 @@
-package Class::Tiny;
+package Moo;
 
 use strictures 1;
-use Class::Tiny::_Utils;
+use Moo::_Utils;
 
 our %MAKERS;
 
@@ -13,9 +13,9 @@ sub import {
     *{_getglob("${target}::ISA")} = \@_;
   };
   *{_getglob("${target}::with")} = sub {
-    require Role::Tiny;
+    require Moo::Role;
     die "Only one role supported at a time by with" if @_ > 1;
-    Role::Tiny->apply_role_to_package($_[0], $target);
+    Moo::Role->apply_role_to_package($_[0], $target);
   };
   $MAKERS{$target} = {};
   *{_getglob("${target}::has")} = sub {
@@ -35,7 +35,7 @@ sub import {
   {
     no strict 'refs';
     @{"${target}::ISA"} = do {
-      require Class::Tiny::Object; ('Class::Tiny::Object');
+      require Moo::Object; ('Moo::Object');
     } unless @{"${target}::ISA"};
   }
 }
diff --git a/lib/Class/Tiny/Object.pm b/lib/Moo/Object.pm
similarity index 96%
rename from lib/Class/Tiny/Object.pm
rename to lib/Moo/Object.pm
index 4ff2cba..f62bc35 100644
--- a/lib/Class/Tiny/Object.pm
+++ b/lib/Moo/Object.pm
@@ -1,4 +1,4 @@
-package Class::Tiny::Object;
+package Moo::Object;
 
 use strictures 1;
 
diff --git a/lib/Class/Tiny/_Utils.pm b/lib/Moo/_Utils.pm
similarity index 97%
rename from lib/Class/Tiny/_Utils.pm
rename to lib/Moo/_Utils.pm
index b166515..0e5d787 100644
--- a/lib/Class/Tiny/_Utils.pm
+++ b/lib/Moo/_Utils.pm
@@ -1,4 +1,4 @@
-package Class::Tiny::_Utils;
+package Moo::_Utils;
 
 use strictures 1;
 use base qw(Exporter);
diff --git a/lib/Class/Tiny/_mro.pm b/lib/Moo/_mro.pm
similarity index 72%
rename from lib/Class/Tiny/_mro.pm
rename to lib/Moo/_mro.pm
index f957d71..7c932a4 100644
--- a/lib/Class/Tiny/_mro.pm
+++ b/lib/Moo/_mro.pm
@@ -1,4 +1,4 @@
-package Class::Tiny::_mro;
+package Moo::_mro;
 
 if ($] > 5.010) {
   require mro;
diff --git a/lib/Role/Tiny.pm b/lib/Role/Tiny.pm
index d06775f..74f83f6 100644
--- a/lib/Role/Tiny.pm
+++ b/lib/Role/Tiny.pm
@@ -1,20 +1,24 @@
 package Role::Tiny;
 
-use strictures 1;
-use Class::Tiny::_Utils;
+use strict;
+use warnings FATAL => 'all';
 
 our %INFO;
 our %APPLIED_TO;
 our %COMPOSED;
 
+sub _getglob { no strict 'refs'; \*{$_[0]} }
+
 sub import {
   my $target = caller;
+  my $me = $_[0];
   strictures->import;
   # get symbol table reference
   my $stash = do { no strict 'refs'; \%{"${target}::"} };
   # install before/after/around subs
   foreach my $type (qw(before after around)) {
     *{_getglob "${target}::${type}"} = sub {
+      require Class::Method::Modifiers;
       push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ];
     };
   }
@@ -23,15 +27,7 @@ sub import {
   };
   *{_getglob "${target}::with"} = sub {
     die "Only one role supported at a time by with" if @_ > 1;
-    Role::Tiny->apply_role_to_package($_[0], $target);
-  };
-  *{_getglob "${target}::has"} = sub {
-    my ($name, %spec) = @_;
-    ($INFO{$target}{accessor_maker} ||= do {
-      require Method::Generate::Accessor;
-      Method::Generate::Accessor->new
-    })->generate_method($target, $name, \%spec);
-    $INFO{$target}{attributes}{$name} = \%spec;
+    $me->apply_role_to_package($_[0], $target);
   };
   # grab all *non-constant* (ref eq 'SCALAR') subs present
   # in the symbol table and store their refaddrs (no need to forcibly
@@ -61,8 +57,6 @@ sub apply_role_to_package {
     *{_getglob "${to}::does"} = \&does_role;
   }
 
-  $me->_handle_constructor($to, $info->{attributes});
-
   # copy our role list into the target's
   @{$APPLIED_TO{$to}||={}}{keys %{$APPLIED_TO{$role}}} = ();
 }
@@ -85,8 +79,11 @@ sub create_class_with_roles {
     die "${role} is not a Role::Tiny" unless my $info = $INFO{$role};
   }
 
-  require Class::Tiny::_mro;
-  require Sub::Quote;
+  if ($] > 5.010) {
+    require mro;
+  } else {
+    require MRO::Compat;
+  }
 
   my @composable = map $me->_composable_package_for($_), reverse @roles;
 
@@ -98,9 +95,6 @@ sub create_class_with_roles {
     $new_name, $compose_name,
     do { my %h; @h{map @{$_->{requires}||[]}, @info} = (); keys %h }
   );
-  $me->_handle_constructor(
-    $new_name, { map %{$_->{attr_info}||{}}, @info }
-  );
 
   *{_getglob "${new_name}::does"} = \&does_role unless $new_name->can('does');
 
@@ -120,13 +114,14 @@ sub _composable_package_for {
   my $base_name = $composed_name.'::_BASE';
   *{_getglob("${composed_name}::ISA")} = [ $base_name ];
   my $modifiers = $INFO{$role}{modifiers}||[];
+  my @mod_base;
   foreach my $modified (
     do { my %h; @h{map $_->[1], @$modifiers} = (); keys %h }
   ) {
-    Sub::Quote::quote_sub(
-      "${base_name}::${modified}" => q{ shift->next::method(@_) }
-    );
+    push @mod_base, "sub ${modified} { shift->next::method(\@_) }";
   }
+  eval(my $code = join "\n", "package ${base_name};", @mod_base);
+  die "Evaling failed: $@\nTrying to eval:\n${code}" if $@;
   $me->_install_modifiers($composed_name, $modifiers);
   $COMPOSED{role}{$composed_name} = 1;
   return $composed_name;
@@ -182,21 +177,7 @@ sub _install_methods {
 sub _install_modifiers {
   my ($me, $to, $modifiers) = @_;
   foreach my $modifier (@{$modifiers||[]}) {
-    _install_modifier($to, @{$modifier});
-  }
-}
-
-sub _handle_constructor {
-  my ($me, $to, $attr_info) = @_;
-  return unless $attr_info && keys %$attr_info;
-  if ($INFO{$to}) {
-    @{$INFO{$to}{attributes}||={}}{keys %$attr_info} = values %$attr_info;
-  } else {
-    # only fiddle with the constructor if the target is a Class::Tiny class
-    if ($INC{"Class/Tiny.pm"}
-        and my $con = Class::Tiny->_constructor_maker_for($to)) {
-      $con->register_attribute_specs(%$attr_info);
-    }
+    Class::Method::Modifiers::install_modifier($to, @{$modifier});
   }
 }
 
diff --git a/lib/Sub/Defer.pm b/lib/Sub/Defer.pm
index acbf42c..50688c5 100644
--- a/lib/Sub/Defer.pm
+++ b/lib/Sub/Defer.pm
@@ -2,7 +2,7 @@ package Sub::Defer;
 
 use strictures 1;
 use base qw(Exporter);
-use Class::Tiny::_Utils;
+use Moo::_Utils;
 
 our @EXPORT = qw(defer_sub undefer_sub);
 
diff --git a/t/accessor-default.t b/t/accessor-default.t
index 80786d0..2cec9c0 100644
--- a/t/accessor-default.t
+++ b/t/accessor-default.t
@@ -5,7 +5,7 @@ use Test::More;
   package Foo;
 
   use Sub::Quote;
-  use Class::Tiny;
+  use Moo;
 
   has one => (is => 'ro', lazy => 1, default => quote_sub q{ {} });
   has two => (is => 'ro', lazy => 1, builder => '_build_two');
diff --git a/t/accessor-isa.t b/t/accessor-isa.t
index 2e3e9fd..1529bc1 100644
--- a/t/accessor-isa.t
+++ b/t/accessor-isa.t
@@ -36,7 +36,7 @@ sub run_for {
 {
   package Foo;
 
-  use Class::Tiny;
+  use Moo;
 
   has less_than_three => (
     is => 'rw',
@@ -50,7 +50,7 @@ run_for 'Foo';
   package Bar;
 
   use Sub::Quote;
-  use Class::Tiny;
+  use Moo;
 
   has less_than_three => (
     is => 'rw',
@@ -64,7 +64,7 @@ run_for 'Bar';
   package Baz;
 
   use Sub::Quote;
-  use Class::Tiny;
+  use Moo;
 
   has less_than_three => (
     is => 'rw',
diff --git a/t/accessor-mixed.t b/t/accessor-mixed.t
index 8b934f8..ecf91ca 100644
--- a/t/accessor-mixed.t
+++ b/t/accessor-mixed.t
@@ -6,7 +6,7 @@ my @result;
 {
   package Foo;
 
-  use Class::Tiny;
+  use Moo;
 
   my @isa = (isa => sub { push @result, 'isa', $_[0] });
   my @trigger = (trigger => sub { push @result, 'trigger', $_[1] });
diff --git a/t/accessor-pred-clear.t b/t/accessor-pred-clear.t
index 7d505c2..4f73321 100644
--- a/t/accessor-pred-clear.t
+++ b/t/accessor-pred-clear.t
@@ -4,7 +4,7 @@ use Test::More;
 {
   package Foo;
 
-  use Class::Tiny;
+  use Moo;
 
   has one => (
     is => 'ro', lazy => 1, default => sub { 3 },
diff --git a/t/accessor-trigger.t b/t/accessor-trigger.t
index dcda49f..632819e 100644
--- a/t/accessor-trigger.t
+++ b/t/accessor-trigger.t
@@ -30,7 +30,7 @@ sub run_for {
 {
   package Foo;
 
-  use Class::Tiny;
+  use Moo;
 
   has one => (is => 'rw', trigger => sub { push @::tr, $_[1] });
 }
@@ -41,7 +41,7 @@ run_for 'Foo';
   package Bar;
 
   use Sub::Quote;
-  use Class::Tiny;
+  use Moo;
 
   has one => (is => 'rw', trigger => quote_sub q{ push @::tr, $_[1] });
 }
@@ -52,7 +52,7 @@ run_for 'Bar';
   package Baz;
 
   use Sub::Quote;
-  use Class::Tiny;
+  use Moo;
 
   has one => (
     is => 'rw',
diff --git a/t/buildall.t b/t/buildall.t
index 7e4b953..9129cc6 100644
--- a/t/buildall.t
+++ b/t/buildall.t
@@ -4,15 +4,15 @@ use Test::More;
 my @ran;
 
 {
-  package Foo; use Class::Tiny; sub BUILD { push @ran, 'Foo' }
-  package Bar; use Class::Tiny; extends 'Foo'; sub BUILD { push @ran, 'Bar' }
-  package Baz; use Class::Tiny; extends 'Bar';
-  package Quux; use Class::Tiny; extends 'Baz'; sub BUILD { push @ran, 'Quux' }
+  package Foo; use Moo; sub BUILD { push @ran, 'Foo' }
+  package Bar; use Moo; extends 'Foo'; sub BUILD { push @ran, 'Bar' }
+  package Baz; use Moo; extends 'Bar';
+  package Quux; use Moo; extends 'Baz'; sub BUILD { push @ran, 'Quux' }
 }
 
 {
   package Fleem;
-  use Class::Tiny;
+  use Moo;
   extends 'Quux';
   has 'foo' => (is => 'ro');
   sub BUILD { push @ran, $_[0]->foo, $_[1]->{bar} }
diff --git a/t/method-generate-accessor.t b/t/method-generate-accessor.t
index 93164c8..6bd74e4 100644
--- a/t/method-generate-accessor.t
+++ b/t/method-generate-accessor.t
@@ -8,7 +8,7 @@ my $gen = Method::Generate::Accessor->new;
 
 {
   package Foo;
-  use Class::Tiny;
+  use Moo;
 }
 
 $gen->generate_method('Foo' => 'one' => { is => 'ro' });
diff --git a/t/class-tiny-accessors.t b/t/moo-accessors.t
similarity index 91%
rename from t/class-tiny-accessors.t
rename to t/moo-accessors.t
index 3edae8a..a5d28c7 100644
--- a/t/class-tiny-accessors.t
+++ b/t/moo-accessors.t
@@ -4,7 +4,7 @@ use Test::More;
 {
   package Foo;
 
-  use Class::Tiny;
+  use Moo;
 
   has one => (is => 'ro');
   has two => (is => 'rw', init_arg => undef);
@@ -12,13 +12,13 @@ use Test::More;
 
   package Bar;
 
-  use Role::Tiny;
+  use Moo::Role;
 
   has four => (is => 'ro');
 
   package Baz;
 
-  use Class::Tiny;
+  use Moo;
 
   extends 'Foo';
 
diff --git a/t/class-tiny.t b/t/moo.t
similarity index 82%
rename from t/class-tiny.t
rename to t/moo.t
index 85070c3..4656944 100644
--- a/t/class-tiny.t
+++ b/t/moo.t
@@ -6,7 +6,7 @@ use Test::More;
 
   BEGIN { our @ISA = 'ZeroZero' }
 
-  use Class::Tiny;
+  use Moo;
 }
 
 BEGIN {
@@ -19,18 +19,18 @@ BEGIN {
 {
   package MyClass1;
 
-  use Class::Tiny;
+  use Moo;
 }
 
 is_deeply(
-  [ @MyClass1::ISA ], [ 'Class::Tiny::Object' ], 'superclass defaulted'
+  [ @MyClass1::ISA ], [ 'Moo::Object' ], 'superclass defaulted'
 );
 
 {
   package MyClass2;
 
   use base qw(MyClass1);
-  use Class::Tiny;
+  use Moo;
 }
 
 is_deeply(
@@ -40,7 +40,7 @@ is_deeply(
 {
   package MyClass3;
 
-  use Class::Tiny;
+  use Moo;
 
   extends 'MyClass2';
 }
@@ -52,7 +52,7 @@ is_deeply(
 {
   package MyClass4;
 
-  use Class::Tiny;
+  use Moo;
 
   extends 'WhatTheFlyingFornication';
 
@@ -66,7 +66,7 @@ is_deeply(
 {
   package MyClass5;
 
-  use Class::Tiny;
+  use Moo;
 
   sub foo { 'foo' }