uploadin;
Stevan Little [Mon, 13 Mar 2006 17:28:14 +0000 (17:28 +0000)]
lib/Moose.pm
t/001_basic.t
t/002_basic.t
t/003_basic.t

index 40f4650..8172197 100644 (file)
@@ -8,7 +8,7 @@ use warnings;
 
 our $VERSION = '0.01';
 
-use Scalar::Util 'blessed';
+use Scalar::Util 'blessed', 'reftype';
 use Carp         'confess';
 use Sub::Name    'subname';
 
@@ -48,12 +48,22 @@ sub import {
        $meta->alias_method('has' => subname 'Moose::has' => sub { 
                my ($name, %options) = @_;
                if (exists $options{is}) {
-                       $options{type_constraint} = $options{is};
+                       if ($options{is} eq 'ro') {
+                               $options{reader} = $name;
+                       }
+                       elsif ($options{is} eq 'rw') {
+                               $options{accessor} = $name;                             
+                       }                       
                }
-               elsif (exists $options{isa}) {
-                       $options{type_constraint} = Moose::Util::TypeConstraints::subtype(
-                               Object => Moose::Util::TypeConstraints::where { $_->isa($options{isa}) }
-                       );                      
+               if (exists $options{isa}) {
+                       if (reftype($options{isa}) && reftype($options{isa}) eq 'CODE') {
+                               $options{type_constraint} = $options{isa};
+                       }
+                       else {
+                               $options{type_constraint} = Moose::Util::TypeConstraints::subtype(
+                                       Object => Moose::Util::TypeConstraints::where { $_->isa($options{isa}) }
+                               );                      
+                       }
                }
                $meta->add_attribute($name, %options) 
        });
index f4fcd52..ba0fbb5 100644 (file)
@@ -16,15 +16,9 @@ BEGIN {
        use warnings;   
        use Moose;
                
-       has 'x' => (
-               is => Int(),            
-               reader => 'x',                          
-       );
-
-       has 'y' => (
-               is => Int(),                    
-               accessor => 'y',        
-       );
+       has 'x' => (isa => Int(), is => 'ro');
+
+       has 'y' => (isa => Int(), is => 'rw');
        
        sub clear {
            my $self = shift;
@@ -39,7 +33,7 @@ BEGIN {
        
        extends 'Point';
        
-       has 'z' => (is => Int());
+       has 'z' => (isa => Int());
        
        after 'clear' => sub {
            my $self = shift;
index ad2a59d..1b6cc30 100644 (file)
@@ -16,11 +16,7 @@ BEGIN {
        use warnings;
     use Moose;
     
-    has 'balance' => (
-               is       => Int(),                      
-               accessor => 'balance', 
-               default  => 0,
-       );
+    has 'balance' => (isa => Int(), is => 'rw', default => 0);
 
     sub deposit {
         my ($self, $amount) = @_;
@@ -42,10 +38,7 @@ BEGIN {
 
        extends 'BankAccount';
        
-    has 'overdraft_account' => (
-               isa      => 'BankAccount',      
-               accessor => 'overdraft_account',                
-       );      
+    has 'overdraft_account' => (isa => 'BankAccount', is => 'rw');     
 
        before 'withdraw' => sub {
                my ($self, $amount) = @_;
index e22eede..e145a6e 100644 (file)
@@ -19,22 +19,22 @@ BEGIN {
     use Moose;
 
     has 'parent' => (
+               is        => 'rw',
                isa       => 'BinaryTree',      
         predicate => 'has_parent',
-        accessor  => 'parent',
                weak_ref  => 1,
     );
 
     has 'left' => (
+               is        => 'rw',      
                isa       => 'BinaryTree',              
         predicate => 'has_left',         
-        accessor  => 'left',
     );
 
     has 'right' => (
+               is        => 'rw',      
                isa       => 'BinaryTree',              
         predicate => 'has_right',           
-        accessor  => 'right',
     );
 
     before 'right', 'left' => sub {