From: Dave Rolsky Date: Mon, 6 Jul 2009 19:44:00 +0000 (-0500) Subject: added exercises for part 5 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ad648c438974307918aab91a194270f22e7530d6;p=gitmo%2Fmoose-presentations.git 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 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 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 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 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 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 --- 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 {