Swiss QR-Bill: Controller für BankAccount Datenfelder
[kivitendo-erp.git] / SL / DB / Object / Hooks.pm
1 package SL::DB::Object::Hooks;
2
3 use strict;
4
5 use SL::X;
6
7 use parent qw(Exporter);
8 our @EXPORT = qw(before_load   after_load
9                  before_save   after_save
10                  before_delete after_delete);
11
12 my %hooks;
13
14 # Adding hooks
15
16 sub before_save {
17   _add_hook('before_save', @_);
18 }
19
20 sub after_save {
21   _add_hook('after_save', @_);
22 }
23
24 sub before_load {
25   _add_hook('before_load', @_);
26 }
27
28 sub after_load {
29   _add_hook('after_load', @_);
30 }
31
32 sub before_delete {
33   _add_hook('before_delete', @_);
34 }
35
36 sub after_delete {
37   _add_hook('after_delete', @_);
38 }
39
40 # Running hooks
41
42 sub run_hooks {
43   my ($object, $when, @args) = @_;
44
45   foreach my $sub (@{ ( $hooks{$when} || { })->{ ref($object) } || [ ] }) {
46     my $result = ref($sub) eq 'CODE' ? $sub->($object, @args) : $object->call_sub($sub, @args);
47     SL::X::DBHookError->throw(when        => $when,
48                               hook        => (ref($sub) eq 'CODE' ? '<anonymous sub>' : $sub),
49                               object      => $object,
50                               object_type => ref($object))
51       if !$result;
52   }
53 }
54
55 # Internals
56
57 sub _add_hook {
58   my ($when, $class, $sub_name, $code) = @_;
59   $hooks{$when}           ||= { };
60   $hooks{$when}->{$class} ||= [ ];
61   push @{ $hooks{$when}->{$class} }, $sub_name;
62 }
63
64 1;
65 __END__
66
67 =pod
68
69 =encoding utf8
70
71 =head1 NAME
72
73 SL::DB::Object::Hooks - Hooks that are run before/after a
74 load/save/delete
75
76 =head1 SYNOPSIS
77
78 Hooks are functions that are called before or after an object is
79 loaded, saved or deleted. The package defines the hooks, and those
80 hooks themselves are run as instance methods.
81
82 Hooks are run in the order they're added.
83
84 Hooks must return a trueish value in order to continue processing. If
85 any hook returns a falsish value then an exception (instance of
86 C<SL::X::DBHookError>) is thrown. However, C<SL::DB::Object> usually
87 runs the hooks from within a transaction, catches the exception and
88 only returns falsish in error cases.
89
90 =head1 FUNCTIONS
91
92 =over 4
93
94 =item C<before_load $sub>
95
96 =item C<before_save $sub>
97
98 =item C<before_delete $sub>
99
100 =item C<after_load $sub>
101
102 =item C<after_save $sub>
103
104 =item C<after_delete $sub>
105
106 Adds a new hook that is called at the appropriate time. C<$sub> can be
107 either a name of an existing sub or a code reference. If it is a code
108 reference then the then-current C<$self> will be passed as the first
109 argument.
110
111 C<before> hooks are called without arguments.
112
113 C<after> hooks are called with a single argument: the result of the
114 C<save> or C<delete> operation.
115
116 =item C<run_hooks $object, $when, @args>
117
118 Runs all hooks for the object C<$object> that are defined for
119 C<$when>. C<$when> is the same as one of the C<before_xyz> or
120 C<after_xyz> function names above.
121
122 An exception of C<SL::X::DBHookError> is thrown if any of the hooks
123 returns a falsish value.
124
125 This function is supposed to be called by L<SL::DB::Object/"load">,
126 L<SL::DB::Object/"save"> or L<SL::DB::Object/"delete">.
127
128 =back
129
130 =head1 EXPORTS
131
132 This mixin exports the functions L</before_load>, L</after_load>,
133 L</before_save>, L</after_save>, L</before_delete>, L</after_delete>.
134
135 =head1 BUGS
136
137 Nothing here yet.
138
139 =head1 AUTHOR
140
141 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
142
143 =cut