trAvis - MANAGER
Edit File: 002_schwartz_tutorial.t
#!/usr/bin/perl # This adapted from the tutorial here: # http://www.stonehenge.com/merlyn/LinuxMag/col94.html # The Moose is Flying (part 1)' # Using Mouse, instead # use feature ':5.10'; use strict; use warnings; use Test::More; # functions to capture the output of the tutorial our $DUMMY_STDOUT = ""; sub dprint { $DUMMY_STDOUT .= join "", @_ }; sub stdout { my $stdout = $DUMMY_STDOUT; $DUMMY_STDOUT = ""; return $stdout } sub say { ::dprint $_, "\n" for @_ } ###################################################################### # This is the tutorial, as posted by Heikki Lehvaslaiho in Mouse's RT # ticket #42992, except with print and say modified to use the above. package Animal; use Mouse::Role; has 'name' => (is => 'rw'); sub speak { my $self = shift; ::dprint $self->name, " goes ", $self->sound, "\n"; } requires 'sound'; has 'color' => (is => 'rw', default => sub { shift->default_color }); requires 'default_color'; no Mouse::Role; 1; ## Cow.pm: package Cow; use Mouse; with 'Animal'; sub default_color { 'spotted' } sub sound { 'moooooo' } no Mouse; 1; ## Horse.pm: package Horse; use Mouse; with 'Animal'; sub default_color { 'brown' } sub sound { 'neigh' } no Mouse; 1; ## Sheep.pm: package Sheep; use Mouse; with 'Animal'; sub default_color { 'black' } sub sound { 'baaaah' } no Mouse; 1; package MouseA; use Mouse; with 'Animal'; sub default_color { 'white' } sub sound { 'squeak' } after 'speak' => sub { ::dprint "[but you can barely hear it!]\n"; }; before 'speak' => sub { ::dprint "[Ahem]\n"; }; no Mouse; 1; package Racer; use Mouse::Role; has $_ => (is => 'rw', default => 0) foreach qw(wins places shows losses); sub won { my $self = shift; $self->wins($self->wins + 1) } sub placed { my $self = shift; $self->places($self->places + 1) } sub showed { my $self = shift; $self->shows($self->shows + 1) } sub lost { my $self = shift; $self->losses($self->losses + 1) } sub standings { my $self = shift; join ", ", map { $self->$_ . " $_" } qw(wins places shows losses); } no Mouse::Role; 1; # To create the race horse, we just mix a horse with a racer: package RaceHorse; use Mouse; extends 'Horse'; with 'Racer'; no Mouse; 1; ###################################################################### # Now the tests package main; plan tests => 5; #use Horse; my $talking = Horse->new(name => 'Mr. Ed'); say $talking->name; # prints Mr. Ed is stdout, "Mr. Ed\n"; $talking->color("grey"); # sets the color $talking->speak; # says "Mr. Ed goes neigh" is stdout, <<EXPECTED; Mr. Ed goes neigh EXPECTED #use Sheep; my $baab = Sheep->new(color => 'white', name => 'Baab'); $baab->speak; # prints "Baab goes baaaah" is stdout, <<EXPECTED; Baab goes baaaah EXPECTED #use MouseA my $mickey = MouseA->new(name => 'Mickey'); $mickey->speak; is stdout, <<EXPECTED; [Ahem] Mickey goes squeak [but you can barely hear it!] EXPECTED #use RaceHorse; my $s = RaceHorse->new(name => 'Seattle Slew'); $s->won; $s->won; $s->won; $s->placed; $s->lost; # run some races ::dprint $s->standings, "\n"; # 3 wins, 1 places, 0 shows, 1 losses is stdout, <<EXPECTED; 3 wins, 1 places, 0 shows, 1 losses EXPECTED