1 package SL::DB::Object;
6 use List::MoreUtils qw(any);
9 use SL::DB::Helper::Attr;
10 use SL::DB::Helper::Metadata;
11 use SL::DB::Helper::Manager;
12 use SL::DB::Object::Hooks;
14 use base qw(Rose::DB::Object);
18 my $self = $class->SUPER::new();
20 $self->_assign_attributes(@_) if $self;
26 my $class_or_self = shift;
27 my $class = ref($class_or_self) || $class_or_self;
28 my $type = $class =~ m/::Auth/ ? 'LXOFFICE_AUTH' : 'LXOFFICE';
30 return SL::DB::create(undef, $type);
34 return 'SL::DB::Helper::Metadata';
37 sub _get_manager_class {
38 my $class_or_self = shift;
39 my $class = ref($class_or_self) || $class_or_self;
41 return $class->meta->convention_manager->auto_manager_class_name($class);
44 my %text_column_types = (text => 1, char => 1, varchar => 1);
46 sub assign_attributes {
50 my $pk = ref($self)->meta->primary_key;
51 delete @attributes{$pk->column_names} if $pk;
53 return $self->_assign_attributes(%attributes);
56 sub _assign_attributes {
60 my %types = map { $_->name => $_->type } ref($self)->meta->columns;
62 while (my ($attribute, $value) = each %attributes) {
63 my $type = lc($types{$attribute} || 'text');
64 $value = $type eq 'boolean' ? ($value ? 't' : 'f')
65 : $text_column_types{$type} ? $value
66 : defined($value) && ($value eq '') ? undef
68 $self->$attribute($value);
74 sub update_attributes {
77 $self->assign_attributes(@_)->save;
85 return $self->$sub(@_);
93 $check = $check->($self) if ref($check) eq 'CODE';
95 return $check ? $self->$sub(@_) : $self;
98 # These three functions cannot sit in SL::DB::Object::Hooks because
99 # mixins don't deal well with super classes (SUPER is the current
100 # package's super class, not $self's).
102 my ($self, @args) = @_;
104 SL::DB::Object::Hooks::run_hooks($self, 'before_load');
105 my $result = $self->SUPER::load(@args);
106 SL::DB::Object::Hooks::run_hooks($self, 'after_load', $result);
112 my ($self, @args) = @_;
116 SL::DB::Object::Hooks::run_hooks($self, 'before_save');
117 $result = $self->SUPER::save(@args);
118 SL::DB::Object::Hooks::run_hooks($self, 'after_save', $result);
121 $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker);
126 my ($self, @args) = @_;
130 SL::DB::Object::Hooks::run_hooks($self, 'before_delete');
131 $result = $self->SUPER::delete(@args);
132 SL::DB::Object::Hooks::run_hooks($self, 'after_delete', $result);
135 $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker);
147 SL::DB::Object: Base class for all of our model classes
151 This is the base class from which all other model classes are
152 derived. It contains functionality and settings required for all model
155 Several functions (e.g. C<make_manager_class>, C<init_db>) in this
156 class are used for setting up the classes / base classes used for all
157 model instances. They overwrite the functions from
164 =item assign_attributes %attributes
166 =item _assign_attributes %attributes
168 Assigns all elements from C<%attributes> to the columns by calling
169 their setter functions. The difference between the two functions is
170 that C<assign_attributes> protects primary key columns while
171 C<_assign_attributes> doesn't.
173 Both functions handle values that are empty strings by replacing them
174 with C<undef> for non-text columns. This allows the calling functions
175 to use data from HTML forms as the input for C<assign_attributes>
176 without having to remove empty strings themselves (think of
177 e.g. select boxes with an empty option which should be turned into
178 C<NULL> in the database).
180 =item update_attributes %attributes
182 Assigns the attributes from C<%attributes> by calling the
183 C<assign_attributes> function and saves the object afterwards. Returns
186 =item _get_manager_class
188 Returns the manager package for the object or class that it is called
189 on. Can be used from methods in this package for getting the actual
192 =item C<call_sub $name, @args>
194 Calls the sub C<$name> on C<$self> with the arguments C<@args> and
195 returns its result. This is meant for situations in which the sub's
196 name is a composite, e.g.
198 my $chart_id = $buchungsgruppe->call_sub(($is_sales ? "income" : "expense") . "_accno_id_${taxzone_id}");
200 =item C<call_sub_if $name, $check, @args>
202 Calls the sub C<$name> on C<$self> with the arguments C<@args> if
203 C<$check> is trueish. If C<$check> is a code reference then it will be
204 called with C<$self> as the only argument and its result determines
205 whether or not C<$name> is called.
207 Returns the sub's result if the check is positive and C<$self>
214 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>