Kommentar zur Namensgebung der PDF-Dateien
[kivitendo-erp.git] / SL / DB / Object.pm
1 package SL::DB::Object;
2
3 use strict;
4
5 use English qw(-no_match_vars);
6 use Rose::DB::Object;
7 use List::MoreUtils qw(any);
8
9 use SL::DB;
10 use SL::DB::Helper::Attr;
11 use SL::DB::Helper::Metadata;
12 use SL::DB::Helper::Manager;
13 use SL::DB::Object::Hooks;
14
15 use base qw(Rose::DB::Object);
16
17 sub new {
18   my $class = shift;
19   my $self  = $class->SUPER::new();
20
21   $self->_assign_attributes(@_) if $self;
22
23   return $self;
24 }
25
26 sub init_db {
27   my $class_or_self = shift;
28   my $class         = ref($class_or_self) || $class_or_self;
29   my $type          = $class =~ m/::Auth/ ? 'LXOFFICE_AUTH' : 'LXOFFICE';
30
31   return SL::DB::create(undef, $type);
32 }
33
34 sub meta_class {
35   return 'SL::DB::Helper::Metadata';
36 }
37
38 sub _get_manager_class {
39   my $class_or_self = shift;
40   my $class         = ref($class_or_self) || $class_or_self;
41
42   return $class->meta->convention_manager->auto_manager_class_name($class);
43 }
44
45 my %text_column_types = (text => 1, char => 1, varchar => 1);
46
47 sub assign_attributes {
48   my $self       = shift;
49   my %attributes = @_;
50
51   my $pk         = ref($self)->meta->primary_key;
52   delete @attributes{$pk->column_names} if $pk;
53
54   return $self->_assign_attributes(%attributes);
55 }
56
57 sub _assign_attributes {
58   my $self       = shift;
59   my %attributes = @_;
60
61   my %types      = map { $_->name => $_->type } ref($self)->meta->columns;
62
63   while (my ($attribute, $value) = each %attributes) {
64     my $type = lc($types{$attribute} || 'text');
65     $value   = $type eq 'boolean'                ? ($value ? 't' : 'f')
66              : $text_column_types{$type}         ? $value
67              : defined($value) && ($value eq '') ? undef
68              :                                     $value;
69     $self->$attribute($value);
70   }
71
72   return $self;
73 }
74
75 sub update_attributes {
76   my $self = shift;
77
78   $self->assign_attributes(@_)->save;
79
80   return $self;
81 }
82
83 sub call_sub {
84   my $self = shift;
85   my $sub  = shift;
86   return $self->$sub(@_);
87 }
88
89 sub call_sub_if {
90   my $self  = shift;
91   my $sub   = shift;
92   my $check = shift;
93
94   $check    = $check->($self) if ref($check) eq 'CODE';
95
96   return $check ? $self->$sub(@_) : $self;
97 }
98
99 # These three functions cannot sit in SL::DB::Object::Hooks because
100 # mixins don't deal well with super classes (SUPER is the current
101 # package's super class, not $self's).
102 sub load {
103   my ($self, @args) = @_;
104
105   SL::DB::Object::Hooks::run_hooks($self, 'before_load');
106   my $result = $self->SUPER::load(@args);
107   SL::DB::Object::Hooks::run_hooks($self, 'after_load', $result);
108
109   return $result;
110 }
111
112 sub save {
113   my ($self, @args) = @_;
114
115   my ($result, $exception);
116   my $worker = sub {
117     SL::DB::Object::Hooks::run_hooks($self, 'before_save');
118     $exception = $EVAL_ERROR unless eval {
119       $result = $self->SUPER::save(@args);
120       1;
121     };
122     SL::DB::Object::Hooks::run_hooks($self, 'after_save', $result);
123   };
124
125   $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker);
126
127   die $exception if $exception;
128
129   return $result;
130 }
131
132 sub delete {
133   my ($self, @args) = @_;
134
135   my ($result, $exception);
136   my $worker = sub {
137     SL::DB::Object::Hooks::run_hooks($self, 'before_delete');
138     $exception = $EVAL_ERROR unless eval {
139       $result = $self->SUPER::delete(@args);
140       1;
141     };
142     SL::DB::Object::Hooks::run_hooks($self, 'after_delete', $result);
143   };
144
145   $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker);
146
147   die $exception if $exception;
148
149   return $result;
150 }
151
152 1;
153
154 __END__
155
156 =pod
157
158 =head1 NAME
159
160 SL::DB::Object: Base class for all of our model classes
161
162 =head1 DESCRIPTION
163
164 This is the base class from which all other model classes are
165 derived. It contains functionality and settings required for all model
166 classes.
167
168 Several functions (e.g. C<make_manager_class>, C<init_db>) in this
169 class are used for setting up the classes / base classes used for all
170 model instances. They overwrite the functions from
171 L<Rose::DB::Object>.
172
173 =head1 FUNCTIONS
174
175 =over 4
176
177 =item assign_attributes %attributes
178
179 =item _assign_attributes %attributes
180
181 Assigns all elements from C<%attributes> to the columns by calling
182 their setter functions. The difference between the two functions is
183 that C<assign_attributes> protects primary key columns while
184 C<_assign_attributes> doesn't.
185
186 Both functions handle values that are empty strings by replacing them
187 with C<undef> for non-text columns. This allows the calling functions
188 to use data from HTML forms as the input for C<assign_attributes>
189 without having to remove empty strings themselves (think of
190 e.g. select boxes with an empty option which should be turned into
191 C<NULL> in the database).
192
193 =item update_attributes %attributes
194
195 Assigns the attributes from C<%attributes> by calling the
196 C<assign_attributes> function and saves the object afterwards. Returns
197 the object itself.
198
199 =item _get_manager_class
200
201 Returns the manager package for the object or class that it is called
202 on. Can be used from methods in this package for getting the actual
203 object's manager.
204
205 =item C<call_sub $name, @args>
206
207 Calls the sub C<$name> on C<$self> with the arguments C<@args> and
208 returns its result. This is meant for situations in which the sub's
209 name is a composite, e.g.
210
211   my $chart_id = $buchungsgruppe->call_sub(($is_sales ? "income" : "expense") . "_accno_id_${taxzone_id}");
212
213 =item C<call_sub_if $name, $check, @args>
214
215 Calls the sub C<$name> on C<$self> with the arguments C<@args> if
216 C<$check> is trueish. If C<$check> is a code reference then it will be
217 called with C<$self> as the only argument and its result determines
218 whether or not C<$name> is called.
219
220 Returns the sub's result if the check is positive and C<$self>
221 otherwise.
222
223 =back
224
225 =head1 AUTHOR
226
227 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
228
229 =cut