Merge branch 'master' of vc.linet-services.de:public/lx-office-erp
[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     die SL::X::DBHookError->new(when   => $when,
48                                 hook   => (ref($sub) eq 'CODE' ? '<anonymous sub>' : $sub),
49                                 object => $object)
50       if !$result;
51   }
52 }
53
54 # Internals
55
56 sub _add_hook {
57   my ($when, $class, $sub_name, $code) = @_;
58   $hooks{$when}           ||= { };
59   $hooks{$when}->{$class} ||= [ ];
60   push @{ $hooks{$when}->{$class} }, $sub_name;
61 }
62
63 1;
64 __END__
65
66 =pod
67
68 =encoding utf8
69
70 =head1 NAME
71
72 SL::DB::Object::Hooks - Hooks that are run before/after a
73 load/save/delete
74
75 =head1 SYNOPSIS
76
77 Hooks are functions that are called before or after an object is
78 loaded, saved or deleted. The package defines the hooks, and those
79 hooks themselves are run as instance methods.
80
81 Hooks are run in the order they're added.
82
83 Hooks must return a trueish value in order to continue processing. If
84 any hook returns a falsish value then an exception (instance of
85 C<SL::X::DBHookError>) is thrown. However, C<SL::DB::Object> usually
86 runs the hooks from within a transaction, catches the exception and
87 only returns falsish in error cases.
88
89 =head1 FUNCTIONS
90
91 =over 4
92
93 =item C<before_load $sub>
94
95 =item C<before_save $sub>
96
97 =item C<before_delete $sub>
98
99 =item C<after_load $sub>
100
101 =item C<after_save $sub>
102
103 =item C<after_delete $sub>
104
105 Adds a new hook that is called at the appropriate time. C<$sub> can be
106 either a name of an existing sub or a code reference. If it is a code
107 reference then the then-current C<$self> will be passed as the first
108 argument.
109
110 C<before> hooks are called without arguments.
111
112 C<after> hooks are called with a single argument: the result of the
113 C<save> or C<delete> operation.
114
115 =item C<run_hooks $object, $when, @args>
116
117 Runs all hooks for the object C<$object> that are defined for
118 C<$when>. C<$when> is the same as one of the C<before_xyz> or
119 C<after_xyz> function names above.
120
121 An exception of C<SL::X::DBHookError> is thrown if any of the hooks
122 returns a falsish value.
123
124 This function is supposed to be called by L<SL::DB::Object/"load">,
125 L<SL::DB::Object/"save"> or L<SL::DB::Object/"delete">.
126
127 =back
128
129 =head1 EXPORTS
130
131 This mixin exports the functions L</before_load>, L</after_load>,
132 L</before_save>, L</after_save>, L</before_delete>, L</after_delete>.
133
134 =head1 BUGS
135
136 Nothing here yet.
137
138 =head1 AUTHOR
139
140 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
141
142 =cut