Commit | Line | Data |
38bf2a25 |
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; |