added exercises for part 5

diff --git a/moose-class/exercises/answers/05-types/Employee.pm b/moose-class/exercises/answers/05-types/Employee.pm
new file mode 100644 (file)
index 0000000..3df9133
--- /dev/null
+++ b/moose-class/exercises/answers/05-types/Employee.pm
@@ -0,0 +1,54 @@
+package Employee;
+
+use Moose;
+use Moose::Util::TypeConstraints;
+
+extends 'Person';
+
+has '+title' => (
+    default => 'Worker',
+);
+
+subtype 'Int1To10',
+    as    'Int',
+    where { $_ >= 1 && $_ <= 10 };
+
+has salary_level => (
+    is      => 'rw',
+    isa     => 'Int1To10',
+    default => 1,
+);
+
+subtype 'PosInt',
+    as    'Int',
+    where { $_ > 0 };
+
+has salary => (
+    is       => 'ro',
+    isa      => 'PosInt',
+    lazy     => 1,
+    builder  => '_build_salary',
+    init_arg => undef,
+);
+
+subtype 'ValidSSN',
+    as    'Str',
+    where { /^\d\d\d-\d\d\-\d\d\d\d$/};
+
+has ssn => (
+    is  => 'ro',
+    isa => 'ValidSSN',
+);
+
+sub _build_salary {
+    my $self = shift;
+
+    return $self->salary_level * 10000;
+}
+
+no Moose;
+no Moose::Util::TypeConstraints;
+
+__PACKAGE__->meta->make_immutable;
+
+1;

diff --git a/moose-class/exercises/answers/05-types/HasAccount.pm b/moose-class/exercises/answers/05-types/HasAccount.pm
new file mode 100644 (file)
index 0000000..76ea15e
--- /dev/null
+++ b/moose-class/exercises/answers/05-types/HasAccount.pm
@@ -0,0 +1,29 @@
+package HasAccount;
+
+use Moose::Role;
+
+has balance => (
+    is      => 'rw',
+    default => 100,
+);
+
+sub deposit {
+    my $self   = shift;
+    my $amount = shift;
+
+    $self->balance( $self->balance + $amount );
+}
+
+sub withdraw {
+    my $self   = shift;
+    my $amount = shift;
+
+    die "Balance cannot be negative"
+        if $self->balance < $amount;
+
+    $self->balance( $self->balance - $amount );
+}
+
+no Moose::Role;
+
+1;

diff --git a/moose-class/exercises/answers/05-types/Person.pm b/moose-class/exercises/answers/05-types/Person.pm
new file mode 100644 (file)
index 0000000..c402db3
--- /dev/null
+++ b/moose-class/exercises/answers/05-types/Person.pm
@@ -0,0 +1,40 @@
+package Person;
+
+use Moose;
+
+with 'Printable', 'HasAccount';
+
+has title => (
+    is        => 'rw',
+    isa       => 'Str',
+    predicate => 'has_title',
+    clearer   => 'clear_title',
+);
+
+has first_name => (
+    is  => 'rw',
+    isa => 'Str',
+);
+
+has last_name => (
+    is  => 'rw',
+    isa => 'Str',
+);
+
+sub full_name {
+    my $self = shift;
+
+    my $title = join q{ }, $self->first_name, $self->last_name;
+    $title .= q[ (] . $self->title . q[)]
+        if $self->has_title;
+
+    return $title;
+}
+
+sub as_string { $_[0]->full_name }
+
+no Moose;
+
+__PACKAGE__->meta->make_immutable;
+
+1;

diff --git a/moose-class/exercises/answers/05-types/Printable.pm b/moose-class/exercises/answers/05-types/Printable.pm
new file mode 100644 (file)
index 0000000..cb9b58c
--- /dev/null
+++ b/moose-class/exercises/answers/05-types/Printable.pm
@@ -0,0 +1,9 @@
+package Printable;
+
+use Moose::Role;
+
+requires 'as_string';
+
+no Moose::Role;
+
+1;

diff --git a/moose-class/exercises/t/05-types.t b/moose-class/exercises/t/05-types.t
new file mode 100644 (file)
index 0000000..efe7ab0
--- /dev/null
+++ b/moose-class/exercises/t/05-types.t
@@ -0,0 +1,30 @@
+# Your tasks ...
+#
+# In this set of exercises, you will return to your Person and
+# Employee classes, and add appropriate types for every one of their
+# attributes.
+#
+# In Person, the title, first_name, and last_name attributes should
+# all be strings.
+#
+# In Employee, you will create several custom subtypes.
+#
+# The salary_level attribute should be an integer subtype that only
+# allows for values from 1-10.
+#
+# The salary attribute should be a positive integer.
+#
+# Finally, the ssn attribute should be a string subtype that validates
+# against a regular expression of /^\d\d\d-\d\d-\d\d\d\d$/
+
+use strict;
+use warnings;
+
+use lib 't/lib';
+
+use MooseClass::Tests;
+
+use Person;
+use Employee;
+
+MooseClass::Tests::tests05();

diff --git a/moose-class/exercises/t/lib/MooseClass/Tests.pm b/moose-class/exercises/t/lib/MooseClass/Tests.pm
index 11b98d4..a8865e0 100644 (file)
--- a/moose-class/exercises/t/lib/MooseClass/Tests.pm
+++ b/moose-class/exercises/t/lib/MooseClass/Tests.pm
@@ -148,6 +148,84 @@ Written by Peter Gibbons (for Bill Lumberg)
 EOF
 }
 
+sub tests05 {
+    {
+        local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+        has_meta('Person');
+        has_meta('Employee');
+        no_droppings('Employee');
+    }
+
+    for my $attr_name ( qw( first_name last_name title ) ) {
+        my $attr = Person->meta->get_attribute($attr_name);
+
+        ok( $attr->has_type_constraint,
+            "Person $attr_name has a type constraint" );
+        is( $attr->type_constraint->name, 'Str',
+            "Person $attr_name type is Str" );
+    }
+
+    {
+        my $salary_level_attr = Employee->meta->get_attribute('salary_level');
+        ok( $salary_level_attr->has_type_constraint,
+            'Employee salary_level has a type constraint' );
+
+        my $tc = $salary_level_attr->type_constraint;
+
+        for my $invalid ( 0, 11, -14, 'foo', undef ) {
+            my $str = defined $invalid ? $invalid : 'undef';
+            ok( ! $tc->check($invalid),
+                "salary_level type rejects invalid value - $str" );
+        }
+
+        for my $valid ( 1..10 ) {
+            ok( $tc->check($valid),
+                "salary_level type accepts valid value - $valid" );
+        }
+    }
+
+    {
+        my $salary_attr = Employee->meta->get_attribute('salary');
+
+        ok( $salary_attr->has_type_constraint,
+            'Employee salary has a type constraint' );
+
+        my $tc = $salary_attr->type_constraint;
+
+        for my $invalid ( 0, -14, 'foo', undef ) {
+            my $str = defined $invalid ? $invalid : 'undef';
+            ok( ! $tc->check($invalid),
+                "salary type rejects invalid value - $str" );
+        }
+
+        for my $valid ( 1, 100_000, 10**10 ) {
+            ok( $tc->check($valid),
+                "salary type accepts valid value - $valid" );
+        }
+    }
+
+    {
+        my $ssn_attr = Employee->meta->get_attribute('ssn');
+
+        ok( $ssn_attr->has_type_constraint,
+            'Employee ssn has a type constraint' );
+
+        my $tc = $ssn_attr->type_constraint;
+
+        for my $invalid ( 0, -14, 'foo', undef, '123-ab-1241', '123456789' ) {
+            my $str = defined $invalid ? $invalid : 'undef';
+            ok( ! $tc->check($invalid),
+                "ssn type rejects invalid value - $str" );
+        }
+
+        for my $valid ( '041-12-1251', '123-45-6789', '926-41-5820' ) {
+            ok( $tc->check($valid),
+                "ssn type accepts valid value - $valid" );
+        }
+    }
+}
+
 sub tests06 {
     {
         local $Test::Builder::Level = $Test::Builder::Level + 1;
@@ -277,6 +355,7 @@ sub no_droppings {
     my $class = shift;
 
     ok( !$class->can('has'), "no Moose droppings in $class" );
+    ok( !$class->can('subtype'), "no Moose::Util::TypeConstraints droppings in $class" );
 }
 
 sub is_immutable {