t/017_add_method_modifier.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::Fatal;
   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     ::like(
  69         ::exception{ CheckingAccount->meta->add_before_method_modifier(
  70                 'does_not_exist' => sub { }
  71             );
  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 is( exception {
  94     $savings_account->withdraw(50);
  95 }, undef, '... withdrew from savings successfully' );
  96 is( $savings_account->balance, 200,
  97     '... got the right savings balance after withdrawal' );
  98 isnt( exception {
  99     $savings_account->withdraw(250);
 100 }, undef, '... could not withdraw from savings successfully' );
 101
 102 $savings_account->deposit(150);
 103 is( $savings_account->balance, 350,
 104     '... got the right savings balance after deposit' );
 105
 106 my $checking_account = CheckingAccount->new(
 107     balance   => 100,
 108     overdraft => $savings_account
 109 );
 110 isa_ok( $checking_account, 'CheckingAccount' );
 111 isa_ok( $checking_account, 'BankAccount' );
 112
 113 is( $checking_account->overdraft_account, $savings_account,
 114     '... got the right overdraft account' );
 115
 116 is( $checking_account->balance, 100, '... got the right checkings balance' );
 117
 118 is( exception {
 119     $checking_account->withdraw(50);
 120 }, undef, '... withdrew from checking successfully' );
 121 is( $checking_account->balance, 50,
 122     '... got the right checkings balance after withdrawal' );
 123 is( $savings_account->balance, 350,
 124     '... got the right savings balance after checking withdrawal (no overdraft)'
 125 );
 126
 127 is( exception {
 128     $checking_account->withdraw(200);
 129 }, undef, '... withdrew from checking successfully' );
 130 is( $checking_account->balance, 0,
 131     '... got the right checkings balance after withdrawal' );
 132 is( $savings_account->balance, 200,
 133     '... got the right savings balance after overdraft withdrawal' );
 134
 135 done_testing;