From: Stevan Little <stevan.little@iinteractive.com>
Date: Tue, 28 Mar 2006 16:24:09 +0000 (+0000)
Subject: cleanup
X-Git-Tag: 0_05~55
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e9bb8a3193b0d0fbcd6e69b363540666cdeea5ea;p=gitmo%2FMoose.git

cleanup
---

diff --git a/Changes b/Changes
index 0ad2c39..afa1e0a 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,10 @@
 Revision history for Perl extension Moose
 
 0.03
+    * Moose::Cookbook
+      - added the Moose::Cookbook with 5 recipes, 
+        describing all the stuff Moose can do.
+
     * Moose
       - fixed an issue with &extends super class loading
         it now captures errors and deals with inline 
diff --git a/lib/Moose.pm b/lib/Moose.pm
index 68d44dc..2b5297f 100644
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -60,45 +60,14 @@ sub import {
 	
 	# handle superclasses
 	$meta->alias_method('extends' => subname 'Moose::extends' => sub { 
-	    foreach my $super (@_) {
-	        # see if this is already 
-	        # loaded in the symbol table
-            next if _is_class_already_loaded($super);
-            # otherwise require it ...
-            ($super->require)
-	            || confess "Could not load superclass '$super' because : " . $UNIVERSAL::require::ERROR;
-	    }
+        _load_all_superclasses(@_);
 	    $meta->superclasses(@_) 
 	});	
 	
 	# handle attributes
 	$meta->alias_method('has' => subname 'Moose::has' => sub { 
 		my ($name, %options) = @_;
-		if (exists $options{is}) {
-			if ($options{is} eq 'ro') {
-				$options{reader} = $name;
-			}
-			elsif ($options{is} eq 'rw') {
-				$options{accessor} = $name;				
-			}			
-		}
-		if (exists $options{isa}) {
-		    # allow for anon-subtypes here ...
-		    if (blessed($options{isa}) && $options{isa}->isa('Moose::Meta::TypeConstraint')) {
-				$options{type_constraint} = $options{isa};
-			}
-			else {
-			    # otherwise assume it is a constraint
-			    my $constraint = find_type_constraint($options{isa});
-			    # if the constraing it not found ....
-			    unless (defined $constraint) {
-			        # assume it is a foreign class, and make 
-			        # an anon constraint for it 
-			        $constraint = subtype Object => where { $_->isa($options{isa}) };
-			    }			    
-                $options{type_constraint} = $constraint;
-			}
-		}
+        _process_has_options($name, \%options);
 		$meta->add_attribute($name, %options) 
 	});
 
@@ -119,31 +88,13 @@ sub import {
 	$meta->alias_method('super' => subname 'Moose::super' => sub {});
 	$meta->alias_method('override' => subname 'Moose::override' => sub {
 	    my ($name, $method) = @_;
-	    my $super = $meta->find_next_method_by_name($name);
-	    (defined $super)
-	        || confess "You cannot override '$name' because it has no super method";
-	    $meta->add_method($name => sub {
-	        my @args = @_;
-            no strict   'refs';
-            no warnings 'redefine';
-            local *{$meta->name . '::super'} = sub { $super->(@args) };
-	        return $method->(@args);
-	    });
+	    $meta->add_method($name => _create_override_sub($meta, $name, $method));
 	});		
 	
 	$meta->alias_method('inner' => subname 'Moose::inner' => sub {});
 	$meta->alias_method('augment' => subname 'Moose::augment' => sub {
 	    my ($name, $method) = @_;
-	    my $super = $meta->find_next_method_by_name($name);
-	    (defined $super)
-	        || confess "You cannot augment '$name' because it has no super method";
-	    $meta->add_method($name => sub {
-	        my @args = @_;
-            no strict   'refs';
-            no warnings 'redefine';
-            local *{$super->package_name . '::inner'} = sub { $method->(@args) };
-	        return $super->(@args);
-	    });
+	    $meta->add_method($name => _create_augment_sub($meta, $name, $method));
 	});	
 
 	# make sure they inherit from Moose::Object
@@ -156,6 +107,48 @@ sub import {
 	$meta->alias_method('blessed' => \&Scalar::Util::blessed);				
 }
 
+## Utility functions
+
+sub _process_has_options {
+    my ($attr_name, $options) = @_;
+	if (exists $options->{is}) {
+		if ($options->{is} eq 'ro') {
+			$options->{reader} = $attr_name;
+		}
+		elsif ($options->{is} eq 'rw') {
+			$options->{accessor} = $attr_name;				
+		}			
+	}
+	if (exists $options->{isa}) {
+	    # allow for anon-subtypes here ...
+	    if (blessed($options->{isa}) && $options->{isa}->isa('Moose::Meta::TypeConstraint')) {
+			$options->{type_constraint} = $options->{isa};
+		}
+		else {
+		    # otherwise assume it is a constraint
+		    my $constraint = find_type_constraint($options->{isa});
+		    # if the constraing it not found ....
+		    unless (defined $constraint) {
+		        # assume it is a foreign class, and make 
+		        # an anon constraint for it 
+		        $constraint = subtype Object => where { $_->isa($options->{isa}) };
+		    }			    
+            $options->{type_constraint} = $constraint;
+		}
+	}    
+}
+
+sub _load_all_superclasses {
+    foreach my $super (@_) {
+        # see if this is already 
+        # loaded in the symbol table
+        next if _is_class_already_loaded($super);
+        # otherwise require it ...
+        ($super->require)
+            || confess "Could not load superclass '$super' because : " . $UNIVERSAL::require::ERROR;
+    }    
+}
+
 sub _is_class_already_loaded {
 	my $name = shift;
 	no strict 'refs';
@@ -167,6 +160,34 @@ sub _is_class_already_loaded {
     return 0;
 }
 
+sub _create_override_sub {
+    my ($meta, $name, $method) = @_;
+    my $super = $meta->find_next_method_by_name($name);
+    (defined $super)
+        || confess "You cannot override '$name' because it has no super method";    
+    return sub {
+        my @args = @_;
+        no strict   'refs';
+        no warnings 'redefine';
+        local *{$meta->name . '::super'} = sub { $super->(@args) };
+        return $method->(@args);
+    };
+}
+
+sub _create_augment_sub {
+    my ($meta, $name, $method) = @_;    
+    my $super = $meta->find_next_method_by_name($name);
+    (defined $super)
+        || confess "You cannot augment '$name' because it has no super method";
+    return sub {
+        my @args = @_;
+        no strict   'refs';
+        no warnings 'redefine';
+        local *{$super->package_name . '::inner'} = sub { $method->(@args) };
+        return $super->(@args);
+    };    
+}
+
 1;
 
 __END__
diff --git a/lib/Moose/Cookbook/Recipe2.pod b/lib/Moose/Cookbook/Recipe2.pod
index 04c5613..1272275 100644
--- a/lib/Moose/Cookbook/Recipe2.pod
+++ b/lib/Moose/Cookbook/Recipe2.pod
@@ -39,7 +39,7 @@ Moose::Cookbook::Recipe2 - A simple Bank Account example
   before 'withdraw' => sub {
       my ($self, $amount) = @_;
       my $overdraft_amount = $amount - $self->balance();
-      if (self->overdraft_account && $overdraft_amount > 0) {
+      if ($self->overdraft_account && $overdraft_amount > 0) {
           $self->overdraft_account->withdraw($overdraft_amount);
           $self->deposit($overdraft_amount);
       }
@@ -107,7 +107,7 @@ modifier.
   before 'withdraw' => sub {
       my ($self, $amount) = @_;
       my $overdraft_amount = $amount - $self->balance();
-      if (self->overdraft_account && $overdraft_amount > 0) {
+      if ($self->overdraft_account && $overdraft_amount > 0) {
           $self->overdraft_account->withdraw($overdraft_amount);
           $self->deposit($overdraft_amount);
       }
@@ -130,7 +130,7 @@ pseudo-package. So the above method is equivalent to the one here.
   sub withdraw {
       my ($self, $amount) = @_;
       my $overdraft_amount = $amount - $self->balance();
-      if ($overdraft_amount > 0 && $self->overdraft_account) {
+      if ($self->overdraft_account && $overdraft_amount > 0) {
           $self->overdraft_account->withdraw($overdraft_amount);
           $self->deposit($overdraft_amount);
       }
diff --git a/t/002_basic.t b/t/002_basic.t
index 73a6756..5f81bfb 100644
--- a/t/002_basic.t
+++ b/t/002_basic.t
@@ -43,7 +43,7 @@ BEGIN {
 	before 'withdraw' => sub {
 		my ($self, $amount) = @_;
 		my $overdraft_amount = $amount - $self->balance();
-		if (self->overdraft_account && $overdraft_amount > 0) {
+		if ($self->overdraft_account && $overdraft_amount > 0) {
 			$self->overdraft_account->withdraw($overdraft_amount);
 			$self->deposit($overdraft_amount);
 		}
diff --git a/t/006_basic.t b/t/006_basic.t
index d02f46c..3cb0515 100644
--- a/t/006_basic.t
+++ b/t/006_basic.t
@@ -9,3 +9,88 @@ use Test::Exception;
 BEGIN {
     use_ok('Moose');           
 }
+
+=pod
+
+==> AtLeast.pm <==
+package BAST::Web::Model::Constraint::AtLeast;
+
+use strict;
+use warnings;
+use Moose;
+use BAST::Web::Model::Constraint;
+
+extends 'BAST::Web::Model::Constraint';
+
+has 'value' => (isa => 'Num', is => 'ro');
+
+sub validate {
+  my ($self, $field) = @_;
+  if ($self->validation_value($field) >= $self->value) {
+    return undef;
+  } else {
+    return $self->error_message;
+  }
+}
+
+sub error_message { 'must be at least '.shift->value; }
+
+1;
+
+==> NoMoreThan.pm <==
+package BAST::Web::Model::Constraint::NoMoreThan;
+
+use strict;
+use warnings;
+use Moose;
+use BAST::Web::Model::Constraint;
+
+extends 'BAST::Web::Model::Constraint';
+
+has 'value' => (isa => 'Num', is => 'ro');
+
+sub validate {
+  my ($self, $field) = @_;
+  if ($self->validation_value($field) <= $self->value) {
+    return undef;
+  } else {
+    return $self->error_message;
+  }
+}
+
+sub error_message { 'must be no more than '.shift->value; }
+
+1;
+
+==> OnLength.pm <==
+package BAST::Web::Model::Constraint::OnLength;
+
+use strict;
+use warnings;
+use Moose;
+
+has 'units' => (isa => 'Str', is => 'ro');
+
+override 'value' => sub {
+  return length(super());
+};
+
+override 'error_message' => sub {
+  my $self = shift;
+  return super().' '.$self->units;
+};
+
+1;
+
+package BAST::Web::Model::Constraint::LengthNoMoreThan;
+
+use strict;
+use warnings;
+use Moose;
+use BAST::Web::Model::Constraint::NoMoreThan;
+use BAST::Web::Model::Constraint::OnLength;
+
+extends 'BAST::Web::Model::Constraint::NoMoreThan';
+   with 'BAST::Web::Model::Constraint::OnLength';
+
+=cut
\ No newline at end of file