From: Stevan Little <stevan.little@iinteractive.com>
Date: Mon, 13 Mar 2006 17:28:14 +0000 (+0000)
Subject: uploadin;
X-Git-Tag: 0_05~104
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cc65ead05112a79a9b607c8bcfb3e22830f0678b;p=gitmo%2FMoose.git

uploadin;
---

diff --git a/lib/Moose.pm b/lib/Moose.pm
index 40f4650..8172197 100644
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -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) 
 	});
diff --git a/t/001_basic.t b/t/001_basic.t
index f4fcd52..ba0fbb5 100644
--- a/t/001_basic.t
+++ b/t/001_basic.t
@@ -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;
diff --git a/t/002_basic.t b/t/002_basic.t
index ad2a59d..1b6cc30 100644
--- a/t/002_basic.t
+++ b/t/002_basic.t
@@ -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) = @_;
diff --git a/t/003_basic.t b/t/003_basic.t
index e22eede..e145a6e 100644
--- a/t/003_basic.t
+++ b/t/003_basic.t
@@ -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 {