+++ /dev/null
-package Document;
-
-use Moose;
-
-has [ qw( title author ) ] => ( is => 'ro' );
-
-sub output {
- my $self = shift;
-
- my $t = $self->title;
- my $a = $self->author;
-
- my $content = inner();
-
- return <<"EOF";
-$t
-
-$content
-
-Written by $a
-EOF
-}
-
-no Moose;
-
-__PACKAGE__->meta->make_immutable;
-
-1;
--- /dev/null
+package Person;
+
+use Moose;
+
+has title => (
+ is => 'rw',
+ predicate => 'has_title',
+ clearer => 'clear_title',
+);
+
+has first_name => (
+ is => 'rw',
+ required => 1,
+);
+
+has last_name => (
+ is => 'rw',
+ required => 1,
+);
+
+sub BUILDARGS {
+ my $class = shift;
+
+ if ( @_ == 1 && 'ARRAY' eq ref $_[0] ) {
+ return {
+ first_name => $_[0]->[0],
+ last_name => $_[0]->[1],
+ };
+ }
+ else {
+ return $class->SUPER::BUILDARGS(@_);
+ }
+}
+
+our @CALL;
+
+before full_name => sub {
+ push @CALL, 'calling full_name';
+};
+
+after full_name => sub {
+ push @CALL, 'called full_name';
+};
+
+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;
+}
+
+around full_name => sub {
+ my $orig = shift;
+ my $self = shift;
+
+ return $self->$orig unless $self->last_name eq 'Wall';
+
+ return q{*} . $self->$orig . q{*};
+};
+
+sub as_string { $_[0]->full_name }
+
+no Moose;
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+++ /dev/null
-package Report;
-
-use Moose;
-
-extends 'Document';
-
-has 'summary' => ( is => 'ro' );
-
-augment output => sub {
- my $self = shift;
-
- my $content = inner();
-
- my $s = $self->summary;
-
- return <<"EOF";
-$s
-
-$content
-EOF
-};
-
-no Moose;
-
-__PACKAGE__->meta->make_immutable;
-
-1;
+++ /dev/null
-package TPSReport;
-
-use Moose;
-
-extends 'Report';
-
-has [ qw( t p s ) ] => ( is => 'ro' );
-
-augment output => sub {
- my $self = shift;
-
- return join q{}, map { "$_: " . $self->$_ . "\n" } qw( t p s );
-};
-
-no Moose;
-
-__PACKAGE__->meta->make_immutable;
-
-1;
# Your tasks ...
#
-# First, you will create a set of three new classes to make use of the augment
-# method modifier. The class hierarchy will look like this:
+# You will go back to the Person class and add several method modifiers.
#
-# Document
-# |
-# Report
-# |
-# TPSReport
+# First, add before and after modifiers to the full_name() method. The
+# modifiers will be using for debugging. These modifiers will record debugging
+# info by setting a package global, @Person::CALL;
#
-# The Document class should have two read-only attributes: "title" and
-# "author".
+# The before modifier should push the string "calling full_name" onto
+# @Person::CALL. The after modifier should push "called full_name" onto this
+# array.
#
-# The Report class should have one read-only attribute: "summary".
+# You do not need to declare this global, but you can if you like.
#
-# Finally, the TPSReport class should have three read-only attributes: "t",
-# "p", and "s".
+# Finally, create an around modifier for full_name. This modifier should call
+# the real full_name method.
#
-# The goal is to produce a report that looks this:
-#
-# $title
-#
-# $summary
-#
-# t: $t
-# p: $p
-# s: $s
-#
-# Written by $author
-#
-# This report should be returned as a string from the Document->output method.
-#
-# Don't worry too much about how many newlines separate each item (as long as
-# it's at least one). The test does a little massaging to make this more
-# forgiving.
-#
-# Use augment method modifiers in Report and TPSReport to "inject" the
-# relevant content, while Document will output the $title and $author.
-
+# However, if the person object's last name is "Wall" (as in Larry Wall), your
+# modifier should wrap the full name in asterisks (*), one before the name and
+# one after, and then return that new version of the name.
use strict;
use warnings;
}
sub tests04 {
- has_meta('Document');
- has_ro_attr( 'Document', $_ ) for qw( title author );
-
- has_meta('Report');
- has_ro_attr( 'Report', 'summary' );
-
- has_meta('TPSReport');
- has_ro_attr( 'TPSReport', $_ ) for qw( t p s );
-
- has_method( 'Document', 'output' );
- has_augmented_method( 'Report', 'output' );
- has_augmented_method( 'TPSReport', 'output' );
-
- my $tps = TPSReport->new(
- title => 'That TPS Report',
- author => 'Peter Gibbons (for Bill Lumberg)',
- summary => 'I celebrate his whole collection!',
- t => 'PC Load Letter',
- p => 'Swingline',
- s => 'flair!',
- );
-
- my $output = $tps->output;
- $output =~ s/\n\n+/\n/g;
-
- is( $output, <<'EOF', 'output returns expected report' );
-That TPS Report
-I celebrate his whole collection!
-t: PC Load Letter
-p: Swingline
-s: flair!
-Written by Peter Gibbons (for Bill Lumberg)
-EOF
-
- no_droppings('Document');
- no_droppings('Report');
- no_droppings('TPSReport');
+ has_meta('Person');
+
+ ok( Person->can('full_name'), 'Person has a full_name() method' )
+ or BAIL_OUT(
+ 'Person does not have a full_name() method. Cannot continue testing.'
+ );
+
+ my $meth = Person->meta()->get_method('full_name');
+ ok(
+ $meth && $meth->isa('Class::MOP::Method::Wrapped'),
+ 'method modifiers have been applied to the Person->full_name method'
+ );
+
+ is(
+ scalar $meth->before_modifiers,
+ 1,
+ 'Person->full_name has a single before modifier'
+ );
+
+ is(
+ scalar $meth->after_modifiers,
+ 1,
+ 'Person->full_name has a single after modifier'
+ );
+
+ my $person = Person->new(
+ first_name => 'Bilbo',
+ last_name => 'Baggins',
+ );
+
+ is_deeply(
+ \@Person::CALL,
+ [],
+ 'Person::CALL global is empty before calling full_name'
+ );
+
+ $person->full_name();
+
+ is_deeply(
+ \@Person::CALL,
+ [ 'calling full_name', 'called full_name' ],
+ 'Person::CALL global contains before and after strings'
+ );
+
+ is(
+ scalar $meth->around_modifiers,
+ 1,
+ 'Person->full_name has a single around modifier'
+ );
+
+ my $larry = Person->new(
+ first_name => 'Larry',
+ last_name => 'Wall',
+ );
+
+ is(
+ $larry->full_name,
+ '*Larry Wall*',
+ 'full_name is wrapped by asterisks when last name is Wall'
+ );
}
sub tests05 {
projects / gitmo/moose-presentations.git / commitdiff