t/017_add_method_modifier.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::Exception;
   6
   7 use Class::MOP;
   8
   9 {
  10
  11     package BankAccount;
  12
  13     use strict;
  14     use warnings;
  15     use metaclass;
  16
  17     use Carp 'confess';
  18
  19     BankAccount->meta->add_attribute(
  20         'balance' => (
  21             accessor => 'balance',
  22             init_arg => 'balance',
  23             default  => 0
  24         )
  25     );
  26
  27     sub new { (shift)->meta->new_object(@_) }
  28
  29     sub deposit {
  30         my ( $self, $amount ) = @_;
  31         $self->balance( $self->balance + $amount );
  32     }
  33
  34     sub withdraw {
  35         my ( $self, $amount ) = @_;
  36         my $current_balance = $self->balance();
  37         ( $current_balance >= $amount )
  38             || confess "Account overdrawn";
  39         $self->balance( $current_balance - $amount );
  40     }
  41
  42     package CheckingAccount;
  43
  44     use strict;
  45     use warnings;
  46     use metaclass;
  47
  48     use base 'BankAccount';
  49
  50     CheckingAccount->meta->add_attribute(
  51         'overdraft_account' => (
  52             accessor => 'overdraft_account',
  53             init_arg => 'overdraft',
  54         )
  55     );
  56
  57     CheckingAccount->meta->add_before_method_modifier(
  58         'withdraw' => sub {
  59             my ( $self, $amount ) = @_;
  60             my $overdraft_amount = $amount - $self->balance();
  61             if ( $overdraft_amount > 0 ) {
  62                 $self->overdraft_account->withdraw($overdraft_amount);
  63                 $self->deposit($overdraft_amount);
  64             }
  65         }
  66     );
  67
  68     ::throws_ok(
  69         sub {
  70             CheckingAccount->meta->add_before_method_modifier(
  71                 'does_not_exist' => sub { } );
  72         },
  73         qr/\QThe method 'does_not_exist' was not found in the inheritance hierarchy for CheckingAccount/
  74     );
  75
  76     ::ok( CheckingAccount->meta->has_method('withdraw'),
  77         '... checking account now has a withdraw method' );
  78     ::isa_ok( CheckingAccount->meta->get_method('withdraw'),
  79         'Class::MOP::Method::Wrapped' );
  80     ::isa_ok( BankAccount->meta->get_method('withdraw'),
  81         'Class::MOP::Method' );
  82
  83     CheckingAccount->meta->add_method( foo => sub { 'foo' } );
  84     CheckingAccount->meta->add_before_method_modifier( foo => sub { 'wrapped' } );
  85     ::isa_ok( CheckingAccount->meta->get_method('foo'),
  86         'Class::MOP::Method::Wrapped' );
  87 }
  88
  89 my $savings_account = BankAccount->new( balance => 250 );
  90 isa_ok( $savings_account, 'BankAccount' );
  91
  92 is( $savings_account->balance, 250, '... got the right savings balance' );
  93 lives_ok {
  94     $savings_account->withdraw(50);
  95 }
  96 '... withdrew from savings successfully';
  97 is( $savings_account->balance, 200,
  98     '... got the right savings balance after withdrawal' );
  99 dies_ok {
 100     $savings_account->withdraw(250);
 101 }
 102 '... could not withdraw from savings successfully';
 103
 104 $savings_account->deposit(150);
 105 is( $savings_account->balance, 350,
 106     '... got the right savings balance after deposit' );
 107
 108 my $checking_account = CheckingAccount->new(
 109     balance   => 100,
 110     overdraft => $savings_account
 111 );
 112 isa_ok( $checking_account, 'CheckingAccount' );
 113 isa_ok( $checking_account, 'BankAccount' );
 114
 115 is( $checking_account->overdraft_account, $savings_account,
 116     '... got the right overdraft account' );
 117
 118 is( $checking_account->balance, 100, '... got the right checkings balance' );
 119
 120 lives_ok {
 121     $checking_account->withdraw(50);
 122 }
 123 '... withdrew from checking successfully';
 124 is( $checking_account->balance, 50,
 125     '... got the right checkings balance after withdrawal' );
 126 is( $savings_account->balance, 350,
 127     '... got the right savings balance after checking withdrawal (no overdraft)'
 128 );
 129
 130 lives_ok {
 131     $checking_account->withdraw(200);
 132 }
 133 '... withdrew from checking successfully';
 134 is( $checking_account->balance, 0,
 135     '... got the right checkings balance after withdrawal' );
 136 is( $savings_account->balance, 200,
 137     '... got the right savings balance after overdraft withdrawal' );
 138
 139 done_testing;