From: Stevan Little <stevan.little@iinteractive.com>
Date: Fri, 25 Aug 2006 02:32:37 +0000 (+0000)
Subject: adding method keyword
X-Git-Tag: 0_12~4
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3279ab4afa0c9be0568f48142b96d34548a5840e;p=gitmo%2FMoose.git

adding method keyword
---

diff --git a/Changes b/Changes
index 286fae2..f826452 100644
--- a/Changes
+++ b/Changes
@@ -5,9 +5,9 @@ Revision history for Perl extension Moose
       - Recipe5 (subtypes & coercion) has been written
       
     * Moose
-      - added ROADMAP section to detail the near term 
-        plans for Moose
-      - fixed "bad meta" error message to be more descriptive        
+      - fixed "bad meta" error message to be more descriptive      
+      - fixed &unimport to not remove the &inner and &super  
+        keywords because we need to localize them.
         
     * Moose::Object
       - added &dump method, cause it makes all out lives 
diff --git a/lib/Moose.pm b/lib/Moose.pm
index a0253d2..0412fd9 100644
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -139,6 +139,24 @@ use Moose::Util::TypeConstraints;
                 $class->meta->add_augment_method_modifier($name => $method);
             };
         },
+        
+        self => sub {
+            return subname 'Moose::self' => sub {};
+        },        
+        method => sub {
+            my $class = $CALLER;
+            return subname 'Moose::method' => sub {
+                my ($name, $method) = @_;
+                $class->meta->add_method($name, sub {
+                    my $self = shift;
+                    no strict   'refs';
+                    no warnings 'redefine';
+                    local *{$class->meta->name . '::self'} = sub { $self };
+                    $method->(@_);
+                });
+            };
+        },                
+        
         confess => sub {
             return \&Carp::confess;
         },
@@ -173,6 +191,7 @@ use Moose::Util::TypeConstraints;
         my $class = caller();
         # loop through the exports ...
         foreach my $name (keys %exports) {
+            next if $name =~ /inner|super|self/;
             
             # if we find one ...
             if (defined &{$class . '::' . $name}) {
@@ -485,53 +504,6 @@ to work. Here is an example:
     
     no Moose; # keywords are removed from the Person package    
 
-=head1 ROAD MAP
-
-We have developed a roadmap for the next several releases of Moose.
-Development is currently moving at a rapid pace, so this roughly 
-represents the next few weeks of Moose.
-
-=over 4
-
-=item 0.12
-
-This is the current release, it addresses some inconsistencies with 
-Role composition and method modifiers. As an intermediate step, it 
-removed method modifiers from Roles entirely, and roles can only 
-compose methods and attributes.
-
-=item 0.13
-
-With this release will be adding a new keyword which will allow a 
-finer grained form of reuse than roles. This keyword will form the 
-basis of the features of the next few releases.
-
-=item 0.14
-
-With this release we will introduce a deferred version of method 
-modifiers and a package/class-like container to hold them. In 
-conjunction with the new keyword from 0.13, this will bring back 
-the ability to compose groups of method modifiers which was 
-removed in 0.12. 
-
-=item 0.15
-
-With this release we will attempt to return the ability for Roles
-to compose method modifiers, by using the features introduced in 
-0.13 and 0.14. 
-
-It is our intention that this release will bring Roles to a 
-fully stable level. 
-
-=item 0.16 - 0.20
-
-The focus of these releases will be to bring the optimization 
-capabilities of class immutability which we introduced in 
-Class::MOP 0.30. I will get into the details of this as we 
-get closer to it.
-
-=back
-
 =head1 MISC.
 
 =head2 What does Moose stand for??
diff --git a/t/018_import_unimport.t b/t/018_import_unimport.t
index 6618398..914604b 100644
--- a/t/018_import_unimport.t
+++ b/t/018_import_unimport.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 23;
+use Test::More tests => 27;
 
 BEGIN {
     use_ok('Moose');           
@@ -13,8 +13,13 @@ my @moose_exports = qw(
     extends with 
     has 
     before after around
-    override super
-    augment inner
+    override
+    augment
+    method
+);
+
+my @moose_not_unimported = qw(
+    super inner self
 );
 
 {
@@ -28,6 +33,7 @@ eval q{
 ok(!$@, '... Moose succesfully exported into Foo');
 
 can_ok('Foo', $_) for @moose_exports;
+can_ok('Foo', $_) for @moose_not_unimported;
 
 eval q{
     package Foo;
@@ -35,4 +41,6 @@ eval q{
 };
 ok(!$@, '... Moose succesfully un-exported from Foo');
 
-ok(!Foo->can($_), '... Foo can no longer do ' . $_) for @moose_exports;
\ No newline at end of file
+ok(!Foo->can($_), '... Foo can no longer do ' . $_) for @moose_exports;
+can_ok('Foo', $_) for @moose_not_unimported;
+
diff --git a/t/019_method_keyword.t b/t/019_method_keyword.t
new file mode 100644
index 0000000..763006c
--- /dev/null
+++ b/t/019_method_keyword.t
@@ -0,0 +1,37 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More no_plan => 1;
+
+BEGIN {
+    use_ok('Moose');
+}
+
+{
+    package Foo;
+    use Moose;
+    
+    sub greetings {
+        "Hello, $_[1]";
+    }
+    
+    method 'greet_world_from' => sub {
+        my $from = shift;
+        self->greetings("World") . " from $from";
+    };    
+    
+    method 'greet_world_from_me' => sub {
+        self->greet_world_from("Stevan");
+    };  
+    
+    no Moose;  
+}
+
+my $foo = Foo->new;
+isa_ok($foo, 'Foo');
+
+is($foo->greetings('World'), 'Hello, World', '... got the right value from greetings');
+is($foo->greet_world_from('Stevan'), 'Hello, World from Stevan', '... got the right value from greet_world_from');
+is($foo->greet_world_from_me, 'Hello, World from Stevan', '... got the right value from greet_world');
\ No newline at end of file