t/000-recipes/002_schwartz_tutorial.t

   1 #!/usr/bin/perl
   2
   3 # This adapted from the tutorial here:
   4 # http://www.stonehenge.com/merlyn/LinuxMag/col94.html
   5 # The Moose is Flying (part 1)'
   6 # Using Mouse, instead
   7
   8 # use feature ':5.10';
   9
  10
  11 use strict;
  12 use warnings;
  13 use Test::More;
  14
  15 # functions to capture the output of the tutorial
  16 our $DUMMY_STDOUT = "";
  17 sub dprint { $DUMMY_STDOUT .= join "", @_ };
  18 sub stdout { my $stdout = $DUMMY_STDOUT; $DUMMY_STDOUT = ""; return $stdout }
  19 sub say    { ::dprint $_, "\n" for @_ }
  20
  21 ######################################################################
  22 # This is the tutorial, as posted by Heikki Lehvaslaiho in Mouse's RT
  23 # ticket #42992, except with print and say modified to use the above.
  24
  25 package Animal;
  26 use Mouse::Role;
  27 has 'name' => (is => 'rw');
  28 sub speak {
  29     my $self = shift;
  30     ::dprint $self->name, " goes ", $self->sound, "\n";
  31 }
  32 requires 'sound';
  33 has 'color' => (is => 'rw', default => sub { shift->default_color });
  34 requires 'default_color';
  35 no Mouse::Role;
  36 1;
  37
  38 ## Cow.pm:
  39 package Cow;
  40 use Mouse;
  41 with 'Animal';
  42 sub default_color { 'spotted' }
  43 sub sound { 'moooooo' }
  44 no Mouse;
  45 1;
  46 ## Horse.pm:
  47 package Horse;
  48 use Mouse;
  49 with 'Animal';
  50 sub default_color { 'brown' }
  51 sub sound { 'neigh' }
  52 no Mouse;
  53 1;
  54 ## Sheep.pm:
  55 package Sheep;
  56 use Mouse;
  57 with 'Animal';
  58 sub default_color { 'black' }
  59 sub sound { 'baaaah' }
  60 no Mouse;
  61 1;
  62
  63 package MouseA;
  64 use Mouse;
  65 with 'Animal';
  66 sub default_color { 'white' }
  67 sub sound { 'squeak' }
  68 after 'speak' => sub {
  69     ::dprint "[but you can barely hear it!]\n";
  70 };
  71 before 'speak' => sub {
  72     ::dprint "[Ahem]\n";
  73 };
  74 no Mouse;
  75 1;
  76
  77
  78
  79 package Racer;
  80 use Mouse::Role;
  81 has $_ => (is => 'rw', default => 0)
  82     foreach qw(wins places shows losses);
  83 sub won { my $self = shift; $self->wins($self->wins + 1) }
  84 sub placed { my $self = shift; $self->places($self->places + 1) }
  85 sub showed { my $self = shift; $self->shows($self->shows + 1) }
  86 sub lost { my $self = shift; $self->losses($self->losses + 1) }
  87 sub standings {
  88     my $self = shift;
  89     join ", ", map { $self->$_ . " $_" } qw(wins places shows losses);
  90 }
  91 no Mouse::Role;
  92 1;
  93
  94
  95
  96 # To create the race horse, we just mix a horse with a racer:
  97
  98 package RaceHorse;
  99 use Mouse;
 100 extends 'Horse';
 101 with 'Racer';
 102 no Mouse;
 103 1;
 104
 105
 106 ######################################################################
 107 # Now the tests
 108 package main;
 109 plan tests => 5;
 110
 111 #use Horse;
 112 my $talking = Horse->new(name => 'Mr. Ed');
 113 say $talking->name;             # prints Mr. Ed
 114 is stdout, "Mr. Ed\n";
 115 $talking->color("grey");        # sets the color
 116 $talking->speak;                # says "Mr. Ed goes neigh"
 117
 118 is stdout, <<EXPECTED;
 119 Mr. Ed goes neigh
 120 EXPECTED
 121
 122
 123 #use Sheep;
 124 my $baab = Sheep->new(color => 'white', name => 'Baab');
 125 $baab->speak;                   # prints "Baab goes baaaah"
 126 is stdout, <<EXPECTED;
 127 Baab goes baaaah
 128 EXPECTED
 129
 130 #use MouseA
 131 my $mickey = MouseA->new(name => 'Mickey');
 132 $mickey->speak;
 133 is stdout, <<EXPECTED;
 134 [Ahem]
 135 Mickey goes squeak
 136 [but you can barely hear it!]
 137 EXPECTED
 138
 139 #use RaceHorse;
 140 my $s = RaceHorse->new(name => 'Seattle Slew');
 141 $s->won; $s->won; $s->won; $s->placed; $s->lost; # run some races
 142 ::dprint $s->standings, "\n";      # 3 wins, 1 places, 0 shows, 1 losses
 143 is stdout, <<EXPECTED;
 144 3 wins, 1 places, 0 shows, 1 losses
 145 EXPECTED
 146