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