From: Dave Rolsky Date: Wed, 17 Jun 2009 21:57:24 +0000 (-0500) Subject: Finished slides & exercises for section 4 (method modifiers) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=26164c8d9acd6c4d8bad6fe3494db86102bac515;p=gitmo%2Fmoose-presentations.git Finished slides & exercises for section 4 (method modifiers) --- diff --git a/moose-class/exercises/answers/04-method-modifiers/Employee.pm b/moose-class/exercises/answers/04-method-modifiers/Employee.pm new file mode 100644 index 0000000..1bb91fd --- /dev/null +++ b/moose-class/exercises/answers/04-method-modifiers/Employee.pm @@ -0,0 +1,43 @@ +package Employee; + +use Moose; + +extends 'Person'; + +has '+title' => ( + default => 'Worker', +); + +has salary_level => ( + is => 'rw', + default => 1, +); + +has salary => ( + is => 'ro', + lazy => 1, + builder => '_build_salary', + init_arg => undef, +); + +has ssn => ( is => 'ro' ); + +sub _build_salary { + my $self = shift; + + return $self->salary_level * 10000; +} + +augment as_xml => sub { + my $self = shift; + + return + ( map { "<$_>" . ( $self->$_ || q{} ) . "" } qw( salary salary_level ssn ) ), + inner(); +}; + +no Moose; + +__PACKAGE__->meta->make_immutable; + +1; diff --git a/moose-class/exercises/answers/04-method-modifiers/HasAccount.pm b/moose-class/exercises/answers/04-method-modifiers/HasAccount.pm new file mode 100644 index 0000000..76ea15e --- /dev/null +++ b/moose-class/exercises/answers/04-method-modifiers/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/04-method-modifiers/OutputsXML.pm b/moose-class/exercises/answers/04-method-modifiers/OutputsXML.pm new file mode 100644 index 0000000..db30970 --- /dev/null +++ b/moose-class/exercises/answers/04-method-modifiers/OutputsXML.pm @@ -0,0 +1,20 @@ +package OutputsXML; + +use Moose::Role; + +requires 'as_xml'; + +around as_xml => sub { + my $orig = shift; + my $self = shift; + + return + qq{\n} . q{<} + . ( ref $self ) . q{>} . "\n" + . ( join "\n", $self->$orig(@_) ) . "\n" . q{} . "\n"; +}; + +no Moose::Role; + +1; diff --git a/moose-class/exercises/answers/04-method-modifiers/Person.pm b/moose-class/exercises/answers/04-method-modifiers/Person.pm new file mode 100644 index 0000000..e1edc60 --- /dev/null +++ b/moose-class/exercises/answers/04-method-modifiers/Person.pm @@ -0,0 +1,41 @@ +package Person; + +use Moose; + +with 'Printable', 'HasAccount', 'OutputsXML'; + +has title => ( + is => 'rw', + predicate => 'has_title', + clearer => 'clear_title', +); + +has first_name => ( is => 'rw' ); + +has last_name => ( is => 'rw' ); + +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 } + +sub as_xml { + my $self = shift; + + return + ( map { "<$_>" . ( $self->$_ || q{} ) . "" } qw( first_name last_name title ) ), + inner(); +} + +no Moose; + +__PACKAGE__->meta->make_immutable; + +1; diff --git a/moose-class/exercises/answers/04-method-modifiers/Printable.pm b/moose-class/exercises/answers/04-method-modifiers/Printable.pm new file mode 100644 index 0000000..cb9b58c --- /dev/null +++ b/moose-class/exercises/answers/04-method-modifiers/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/04-method-modifiers.t b/moose-class/exercises/t/04-method-modifiers.t new file mode 100644 index 0000000..8f399bb --- /dev/null +++ b/moose-class/exercises/t/04-method-modifiers.t @@ -0,0 +1,50 @@ +# Your tasks ... +# +# You are going to make our Person and Employee classes capable of +# outputting an XML document describing the object. +# +# The document will contain a tag and value for each attribute. +# +# You will use method modifiers and roles to achieve this. +# +# Start by creating a new role, OutputsXML. +# +# This role should require an "as_xml" method in the classes which +# consume it. +# +# This role should also use an around modifier on the as_xml method in +# order to make sure the document is well-formed XML. +# +# This document will look something like this: +# +# +# +# Joe +# Smith +# +# +# Use the role to create the xml declaration (the first line) and the +# container tags ( or Joe', 'Smith' ) +# +# If an attribute is empty, just output an empty tag (). +# +# Use an augment modifier in the Person and Employee classes to allow +# Employee to return just its own attributes. + +use strict; +use warnings; + +use lib 't/lib'; + +use MooseClass::Tests; + +use Person; +use Employee; + +MooseClass::Tests::tests04(); diff --git a/moose-class/exercises/t/lib/MooseClass/Tests.pm b/moose-class/exercises/t/lib/MooseClass/Tests.pm index 5455a27..cd5a2ee 100644 --- a/moose-class/exercises/t/lib/MooseClass/Tests.pm +++ b/moose-class/exercises/t/lib/MooseClass/Tests.pm @@ -105,6 +105,25 @@ sub tests03 { employee03(); } +sub tests04 { + { + local $Test::Builder::Level = $Test::Builder::Level + 1; + + no_droppings('OutputsXML'); + + does_role( 'Person', 'OutputsXML' ); + } + + ok( scalar OutputsXML->meta->get_around_method_modifiers('as_xml'), + 'OutputsXML has an around modifier for as_xml' ); + + isa_ok( Employee->meta->get_method('as_xml'), + 'Moose::Meta::Method::Augmented', 'as_xml is augmented in Employee' ); + + person04(); + employee04(); +} + sub has_meta { my $class = shift; @@ -289,6 +308,48 @@ sub employee03 { 'salary is calculated from salary_level, and salary passed to constructor is ignored' ); } + +sub person04 { + my $person = Person->new( + first_name => 'Bilbo', + last_name => 'Baggins', + ); + + my $xml = <<'EOF'; + + +Bilbo +Baggins + + +EOF + + is( $person->as_xml, $xml, 'Person outputs expected XML' ); +} + +sub employee04 { + my $employee = Employee->new( + first_name => 'Jimmy', + last_name => 'Foo', + ssn => '123-99-4567', + salary_level => 3, + ); + + my $xml = <<'EOF'; + + +Jimmy +Foo +Worker +30000 +3 +123-99-4567 + +EOF + + is( $employee->as_xml, $xml, 'Employee outputs expected XML' ); +} + sub account_tests { local $Test::Builder::Level = $Test::Builder::Level + 1; diff --git a/moose-class/slides/index.html b/moose-class/slides/index.html index 2ff609a..2ddbdc1 100644 --- a/moose-class/slides/index.html +++ b/moose-class/slides/index.html @@ -214,7 +214,7 @@ use Moose;
-

Before & After

+

Before and After

before 'foo'
     => sub { warn 'About to call foo()' };
@@ -932,7 +932,7 @@ extends 'LWP';
package Employee;
 use Moose;
 
-extends 'Person';
+extends 'Person';
 
 overrides work => sub {
     my $self = shift;
@@ -1088,6 +1088,10 @@ use Moose;
+

Questions?

+
+ +

Exercises

# cd exercises
@@ -1119,7 +1123,7 @@ Iterate til this passes all its tests
package HasPermissions;
 use Moose::Role;
 
-# state
+# state
 has access_level => ( is => 'rw' );
 
 # behavior
@@ -1431,7 +1435,7 @@ with 'Killer';
package HasSize;
 use Moose::Role;
 
-requires 'size';
+requires 'size';
 
 package Shirt;
 use Moose;
@@ -1573,6 +1577,23 @@ requires 'compare';
+

Roles Summary

+ +
    +
  • Roles can define an interface with requires
    • +
  • Roles can have state (attributes) and behavior (methods)
    • +
  • Roles can mix interface, state, & behavior
    • +
  • Roles are composed (flattened) into classes
    • +
  • Roles can do other roles
    • +
  • Roles can be used as a type in APIs (must do Comparable)
    • +
+
+ +
+

Questions?

+
+ +

Exercises

# cd exercises
@@ -1626,7 +1647,7 @@ use Moose;
 
 has first_name => (
     is       => 'ro',
-    required => 1,
+    required => 1,
 );
 
 Person->new( first_name => undef ); # ok
@@ -2055,6 +2076,24 @@ has first_name => (
+

Basic Attributes Summary

+ +
    +
  • Attributes can be required
    • +
  • Attributes can have a default or builder
    • +
  • Attributes with a default or builder can be lazy
    • +
  • Attributes can have a clearer and/or predicate
    • +
  • An attribute's constructor name can be changed with init_arg
    • +
  • A subclass can alter its parents' attributes
    • +
  • Attribute accessor names can be changed
    • +
+
+ +
+

Questions?

+
+ +

Exercises

# cd exercises
@@ -2063,6 +2102,279 @@ has first_name => (
 Iterate til this passes all its tests
+
+

Part 4: Method Modifiers

+
+ +
+

What is a Method Modifier

+ +
    +
  • Apply to an existing method
    • +
  • ... from a parent class, the current class, or a role
    • +
  • Roles can provide modifiers that are applied at composition time
    • +
+
+ +
+

What is a Method Modifier

+ +
    +
  • "Iinject" behavior
    • +
  • Add behavior to generated methods (accessors, delegations)
    • +
  • Provide roles which modify existing behavior
    • +
+
+ +
+

Before and After

+ +
    +
  • Simplest modifiers - before and after
    • +
  • Guess when they run!
    • +
+
+ +
+

Uses for before

+ +
    +
  • As a pre-call check
    • +
+ + 
package Person;
+use Moose;
+
+before work => sub {
+    my $self = shift;
+    die 'I have no job!'
+        unless $self->has_title;
+};
+
+ +
+

Uses for before

+ +
    +
  • Logging/Debugging
    • +
+ + 
package Person;
+use Moose;
+
+before work => sub {
+    my $self = shift;
+    return unless $DEBUG;
+
+    warn "Called work on ", $self->full_name,
+         "with the arguments: [@_]\n";
+};
+
+ +
+

Uses for after

+ +
    +
  • Also works for logging/debugging
    • +
  • Post-X side-effects (recording audit info)
    • +
+ + 
package Person;
+use Moose;
+
+after work => sub {
+    my $self = shift;
+    $self->work_count(
+        $self->work_count + 1 );
+};
+
+ +
+

Other Uses

+ +
    +
  • Modifiers are useful for adding behavior to generated methods
    • +
+
+ +
+

Other Uses Example

+ + 
has password => (
+     is      => 'rw',
+     clearer => 'clear_password',
+);
+
+has hashed_password => (
+     is      => 'ro',
+     builder => '_build_hashed_password',
+     clearer => '_clear_hashed_password',
+);
+
+after clear_password => sub {
+    my $self = shift;
+    $self->_clear_hashed_password;
+};
+
+ +
+

before and after Limitations

+ +
    +
  • Cannot alter method parameters
    • +
  • Cannot alter return value
    • +
  • But can throw an exception
    • +
+
+ +
+

The around Modifier

+ +
    +
  • The big gun
    • +
  • Can alter parameters and/or return values
    • +
  • Can skip calling the wrapped method entirely
    • +
+
+ +
+

The power of around

+ + 
around insert => sub {
+    my $orig = shift;
+    my $self = shift;
+
+    $self->_validate_insert(@_);
+
+    my $new_user =
+        $self->$orig(
+            $self->_munge_insert(@_) );
+
+    $new_user->_assign_uri;
+
+    return $new_user;
+};
+
+ +
+

Modifier Order

+ +
    +
  • Before runs order from last to first
    • +
  • After runs in order from first to last
    • +
  • Around runs in order from last to first
    • +
+
+ +
+

Modifier Order Illustrated

+ +
+before 2
+ before 1
+  around 2
+   around 1
+    wrapped method
+   around 1
+  around 2
+ after 1
+after 2
+
+
+ +
+

Modifiers in Roles

+ +
    +
  • Roles can use these modifiers
    • +
  • Very powerful!
    • +
+
+ +
+

Modifiers in Roles

+ + 
package IsUnreliable;
+use Moose::Role;
+
+requires 'run';
+
+around run => sub {
+    my $orig = shift;
+    my $self = shift;
+
+    return if rand(1) < 0.5;
+
+    return $self->$orig(@_);
+};
+
+ +
+

Augment and Inner

+ +
    +
  • Inverted super
    • +
  • From least- to most-specific
    • +
  • Grandparent to parent to child
    • +
  • Not allowed in roles
    • +
+
+ +
+

Augment and Inner

+ + 
package Document;
+
+sub xml { '<doc>' . inner() . '</doc>' }
+
+package Report;
+extends 'Document';
+
+augment xml => { title() . inner() . summary() };
+
+package TPSReport;
+extends 'Report';
+
+augment xml => { tps_xml() . inner() };
+
+ +
+

Augment and Inner

+ +
    +
  • When we call $tps->xml ... +
      +
    • Document->xml
      • +
    • Report->xml
      • +
    • TPSReport->xml
      • +
    +
    • +
+
+ +
+

Augment and Inner Usage

+ +
    +
  • Call inner() to "fill in the blank"
    • +
  • Requires designing for subclassing
    • +
  • Call inner() in the terminal class, just in case
    • +
+
+ +
+

Questions?

+
+ +
+

Exercises

+ + 
# cd exercises
+# perl bin/prove -lv t/04-method-modifiers.t
+
+Iterate til this passes all its tests
+
+ @@ -2076,4 +2388,3 @@ This work is licensed under a Creative Commons Attribution-Share Alike http://creativecommons.org/licenses/by-sa/3.0/us/ for details. --> - diff --git a/moose-class/slides/outline b/moose-class/slides/outline index 338e312..789baa9 100644 --- a/moose-class/slides/outline +++ b/moose-class/slides/outline @@ -67,14 +67,9 @@ ** after for additional state changes * around ** modifying arguments & return values - -== Exercises - -= More roles - -* methods and attributes -* method modifiers (and requiring the wrapped method) -* attributes in roles +* method modifiers in roles +** requiring the wrapped method +* augment/inner == Exercises @@ -104,6 +99,8 @@ == Exercises -= MooseX += Tour of MooseX + += Writing a MooseX Module == Exercises diff --git a/moose-class/slides/ui/custom.css b/moose-class/slides/ui/custom.css index 29fd936..55b9af9 100644 --- a/moose-class/slides/ui/custom.css +++ b/moose-class/slides/ui/custom.css @@ -53,6 +53,10 @@ img.for-slide { line-height: 1.2em; } +.slide li { + margin-top: 0.5em; +} + .slide pre { font-size: 100%; line-height: 110%; @@ -63,6 +67,11 @@ img.for-slide { color: #03c; } +.delete { + text-decoration: line-through; + color: #eee; +} + .slide pre.small { font-size: 33%; }