t/017_add_method_modifier.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests => 20;
   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
  84 my $savings_account = BankAccount->new( balance => 250 );
  85 isa_ok( $savings_account, 'BankAccount' );
  86
  87 is( $savings_account->balance, 250, '... got the right savings balance' );
  88 lives_ok {
  89     $savings_account->withdraw(50);
  90 }
  91 '... withdrew from savings successfully';
  92 is( $savings_account->balance, 200,
  93     '... got the right savings balance after withdrawl' );
  94 dies_ok {
  95     $savings_account->withdraw(250);
  96 }
  97 '... could not withdraw from savings successfully';
  98
  99 $savings_account->deposit(150);
 100 is( $savings_account->balance, 350,
 101     '... got the right savings balance after deposit' );
 102
 103 my $checking_account = CheckingAccount->new(
 104     balance   => 100,
 105     overdraft => $savings_account
 106 );
 107 isa_ok( $checking_account, 'CheckingAccount' );
 108 isa_ok( $checking_account, 'BankAccount' );
 109
 110 is( $checking_account->overdraft_account, $savings_account,
 111     '... got the right overdraft account' );
 112
 113 is( $checking_account->balance, 100, '... got the right checkings balance' );
 114
 115 lives_ok {
 116     $checking_account->withdraw(50);
 117 }
 118 '... withdrew from checking successfully';
 119 is( $checking_account->balance, 50,
 120     '... got the right checkings balance after withdrawl' );
 121 is( $savings_account->balance, 350,
 122     '... got the right savings balance after checking withdrawl (no overdraft)'
 123 );
 124
 125 lives_ok {
 126     $checking_account->withdraw(200);
 127 }
 128 '... withdrew from checking successfully';
 129 is( $checking_account->balance, 0,
 130     '... got the right checkings balance after withdrawl' );
 131 is( $savings_account->balance, 200,
 132     '... got the right savings balance after overdraft withdrawl' );
 133