1DBIx::Class::Helper::RoUws:e:rOnCCoonlturminbCuhtDaeBndIgxeP:(e:3rC)llaDsosc:u:mHeenltpaetri:o:nRow::OnColumnChange(3)
2
6 DBIx::Class::Helper::Row::OnColumnChange - Do things when the values of
7 a column change
8
10 package MyApp::Schema::Result::Account;
11 use parent 'DBIx::Class::Core';
13 __PACKAGE__->load_components(qw(Helper::Row::OnColumnChange));
15 __PACKAGE__->table('Account');
17 __PACKAGE__->add_columns(
19 id => {
20 data_type => 'integer',
21 is_auto_increment => 1,
22 },
23 amount => {
24 data_type => 'float',
25 keep_storage_value => 1,
26 },
27 );
28 sub on_column_change_allow_override_args { 1 }
29 __PACKAGE__->before_column_change(
31 amount => {
32 method => 'bank_transfer',
33 txn_wrap => 1,
34 }
35 );
36 sub bank_transfer {
38 my ($self, $old_value, $new_value) = @_;
39 my $delta = abs($old_value - $new_value);
41 if ($old_value < $new_value) {
42 Bank->subtract($delta)
43 } else {
44 Bank->add($delta)
45 }
46 }
47 1;
49 or with DBIx::Class::Candy:
51 package MyApp::Schema::Result::Account;
53 use DBIx::Class::Candy -components => ['Helper::Row::OnColumnChange'];
55 table 'Account';
57 column id => {
59 data_type => 'integer',
60 is_auto_increment => 1,
61 };
62 column amount => {
64 data_type => 'float',
65 keep_storage_value => 1,
66 };
67 sub on_column_change_allow_override_args { 1 }
68 before_column_change amount => {
70 method => 'bank_transfer',
71 txn_wrap => 1,
72 };
73 sub bank_transfer {
75 my ($self, $old_value, $new_value) = @_;
76 my $delta = abs($old_value - $new_value);
78 if ($old_value < $new_value) {
79 Bank->subtract($delta)
80 } else {
81 Bank->add($delta)
82 }
83 }
84 1;
86
88 This module codifies a pattern that I've used in a number of projects,
89 namely that of doing something when a column changes it's value in the
90 database. It leverages DBIx::Class::Helper::Row::StorageValues for
91 passing in the $old_value, which do not have to use. If you leave the
92 "keep_storage_value" out of the column definition it will just pass
93 "undef" in as the $old_value. Also note the "txn_wrap" option. This
94 allows you to specify that you want the call to "update" and the call
95 to the method you requested to be wrapped in a transaction. If you end
96 up calling more than one method due to multiple column change methods
97 and more than one specify "txn_wrap" it will still only wrap once.
98 I've gone to great lengths to ensure that order is preserved, so
100 "before" and "around" changes are called in order of definition and
101 "after" changes are called in reverse order.
102 To be clear, the change methods only get called if the value will be
104 changed after "update" runs. It correctly looks at the current value
105 of the column as well as the arguments passed to "update".
106
108 If used in conjunction with DBIx::Class::Candy this component will
109 export:
110 before_column_change
112 around_column_change
113 after_column_change
114
116 One thing that should be made totally clear is that the column change
117 callbacks are in effect only once in a given update. If you expect to
118 be able to do something weird like calling one of the callbacks which
119 changes a value with an accessor which calls a callback etc etc, you
120 probably just need to write some code to do that yourself. This helper
121 is specifically made with the aim of reacting to changes immediately
122 before they hit the database.
123
125 before_column_change
126 __PACKAGE__->before_column_change(
127 col_name => {
128 method => 'method', # <-- anything that can be called as a method
129 txn_wrap => 1, # <-- true if you want it to be wrapped in a txn
130 }
131 );
132 Note: the arguments passed to "method" will be "$self, $old_value,
134 $new_value".
135 after_column_change
137 __PACKAGE__->after_column_change(
138 col_name => {
139 method => 'method', # <-- anything that can be called as a method
140 txn_wrap => 1, # <-- true if you want it to be wrapped in a txn
141 }
142 );
143 Note: the arguments passed to "method" will be "$self, $new_value,
145 $new_value". (Because the old value has been changed.)
146 around_column_change
148 __PACKAGE__->around_column_change(
149 col_name => {
150 method => 'method', # <-- anything that can be called as a method
151 txn_wrap => 1, # <-- true if you want it to be wrapped in a txn
152 }
153 );
154 Note: the arguments passed to "method" will be "$self, $next,
156 $old_value, $new_value".
157 Around is subtly different than the other two callbacks. You must call
159 $next in your method or it will not work at all. A silly example of
160 how this is done could be:
161 sub around_change_name {
163 my ($self, $next, $old, $new) = @_;
164 my $govt_records = $self->govt_records;
166 $next->();
168 $govt_records->update({ name => $new });
170 }
171 Note: the above code implies a weird database schema. I haven't
173 actually seen a time when I've needed around yet, but it seems like
174 there is a use-case.
175 Also Note: you don't get to change the args to $next. If you think you
177 should be able to, you probably don't understand what this component is
178 for. That or you know something I don't (equally likely.)
179 on_column_change_allow_override_args
181 This is a method that allows a user to circumvent a strange bug in the
182 initial implementation. Basically, if the user wanted, she could use
183 "before_column_change" to override the value of a given column before
184 "update" gets called, thus replacing the value. Unfortunately this
185 worked in the case of accessors setting the value, but not if the user
186 had used an argument to "update". To be clear, if you want the
187 following to actually replace the value:
188 __PACKAGE__->before_column_change(
190 name => {
191 method => sub {
192 my ($self, $old, $new) = @_;
193 $self->name(uc $new);
195 },
196 },
197 );
198 you will need to define this in your result class:
200 sub on_column_change_allow_override_args { 1 }
202 If for some reason you need the old style, a default of false is
204 already set. If you are painted in the corner and need both, you can
205 create an accessor and set it yourself to change the behavior:
206 __PACKAGE__->mk_group_accessors(inherited => 'on_column_change_allow_override_args');
208 ...
209 $obj->on_column_change_allow_override_args(1); # works the new way
210
212 Arthur Axel "fREW" Schmidt <frioux+cpan@gmail.com>
213
215 This software is copyright (c) 2020 by Arthur Axel "fREW" Schmidt.
216 This is free software; you can redistribute it and/or modify it under
218 the same terms as the Perl 5 programming language system itself.
219perl v5.34.0 20D2B1I-x0:7:-C2l2ass::Helper::Row::OnColumnChange(3)