X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FDB%2FObject.pm;h=81ef97890c7cdb047f1c3d024591c7247f8b75b5;hb=e852b156652474de1b5cb4b12b1a08d4954f69a6;hp=d1e6cb0aa37eb0a8e5411d8b38b73312900fafce;hpb=07ff3cb34abc98aa73a58849720c1e6b8b0695e8;p=kivitendo-erp.git diff --git a/SL/DB/Object.pm b/SL/DB/Object.pm index d1e6cb0aa..81ef97890 100755 --- a/SL/DB/Object.pm +++ b/SL/DB/Object.pm @@ -2,6 +2,7 @@ package SL::DB::Object; use strict; +use Carp; use English qw(-no_match_vars); use Rose::DB::Object; use List::MoreUtils qw(any); @@ -14,6 +15,11 @@ use SL::DB::Object::Hooks; use base qw(Rose::DB::Object); +my @rose_reserved_methods = qw( + db dbh delete DESTROY error init_db _init_db insert load meta meta_class + not_found save update import +); + sub new { my $class = shift; my $self = $class->SUPER::new(); @@ -26,7 +32,7 @@ sub new { sub init_db { my $class_or_self = shift; my $class = ref($class_or_self) || $class_or_self; - my $type = $class =~ m/::Auth/ ? 'LXOFFICE_AUTH' : 'LXOFFICE'; + my $type = $class =~ m/::Auth/ ? 'KIVITENDO_AUTH' : 'KIVITENDO'; return SL::DB::create(undef, $type); } @@ -50,6 +56,7 @@ sub assign_attributes { my $pk = ref($self)->meta->primary_key; delete @attributes{$pk->column_names} if $pk; + delete @attributes{@rose_reserved_methods}; return $self->_assign_attributes(%attributes); } @@ -60,6 +67,15 @@ sub _assign_attributes { my %types = map { $_->name => $_->type } ref($self)->meta->columns; + # Special case for *_as_man_days / *_as_man_days_string / + # *_as_man_days_unit: the _unit variation must always be called + # after the non-unit methods. + my @man_days_attributes = grep { m/_as_man_days(?:_string)?$/ } keys %attributes; + foreach my $attribute (@man_days_attributes) { + my $value = delete $attributes{$attribute}; + $self->$attribute(defined($value) && ($value eq '') ? undef : $value); + } + while (my ($attribute, $value) = each %attributes) { my $type = lc($types{$attribute} || 'text'); $value = $type eq 'boolean' ? ($value ? 't' : 'f') @@ -96,6 +112,17 @@ sub call_sub_if { return $check ? $self->$sub(@_) : $self; } +sub get_first_conflicting { + my ($self, @attributes) = @_; + + my $primary_key = ($self->meta->primary_key)[0]; + my @where = map { ($_ => $self->$_) } @attributes; + + push @where, ("!$primary_key" => $self->$primary_key) if $self->$primary_key; + + return $self->_get_manager_class->get_first(where => [ and => \@where ]); +} + # These three functions cannot sit in SL::DB::Object::Hooks because # mixins don't deal well with super classes (SUPER is the current # package's super class, not $self's). @@ -114,12 +141,14 @@ sub save { my ($result, $exception); my $worker = sub { - SL::DB::Object::Hooks::run_hooks($self, 'before_save'); $exception = $EVAL_ERROR unless eval { + SL::DB::Object::Hooks::run_hooks($self, 'before_save'); $result = $self->SUPER::save(@args); + SL::DB::Object::Hooks::run_hooks($self, 'after_save', $result); 1; }; - SL::DB::Object::Hooks::run_hooks($self, 'after_save', $result); + + return $result; }; $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker); @@ -134,12 +163,14 @@ sub delete { my ($result, $exception); my $worker = sub { - SL::DB::Object::Hooks::run_hooks($self, 'before_delete'); $exception = $EVAL_ERROR unless eval { + SL::DB::Object::Hooks::run_hooks($self, 'before_delete'); $result = $self->SUPER::delete(@args); + SL::DB::Object::Hooks::run_hooks($self, 'after_delete', $result); 1; }; - SL::DB::Object::Hooks::run_hooks($self, 'after_delete', $result); + + return $result; }; $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker); @@ -149,12 +180,52 @@ sub delete { return $result; } +sub load_cached { + my $class_or_self = shift; + my @ids = @_; + my $class = ref($class_or_self) || $class_or_self; + my $cache = $::request->cache("::SL::DB::Object::object_cache::${class}"); + + croak "Missing ID" unless @ids; + + my @missing_ids = grep { !exists $cache->{$_} } @ids; + + return $cache->{$ids[0]} if !@missing_ids; + + croak "Caching can only be used with classes with exactly one primary key column" if 1 != scalar(@{ $class->meta->primary_key_columns }); + + my $primary_key = $class->meta->primary_key_columns->[0]->name; + my $objects = $class->_get_manager_class->get_all(where => [ $primary_key => \@missing_ids ]); + + $cache->{$_->$primary_key} = $_ for @{ $objects}; + + return $cache->{$ids[0]}; +} + +sub invalidate_cached { + my ($class_or_self, @ids) = @_; + my $class = ref($class_or_self) || $class_or_self; + + if (ref($class_or_self) && !@ids) { + croak "Caching can only be used with classes with exactly one primary key column" if 1 != scalar(@{ $class->meta->primary_key_columns }); + + my $primary_key = $class->meta->primary_key_columns->[0]->name; + @ids = ($class_or_self->$primary_key); + } + + delete @{ $::request->cache("::SL::DB::Object::object_cache::${class}") }{ @ids }; + + return $class_or_self; +} + 1; __END__ =pod +=encoding utf8 + =head1 NAME SL::DB::Object: Base class for all of our model classes @@ -220,6 +291,38 @@ whether or not C<$name> is called. Returns the sub's result if the check is positive and C<$self> otherwise. +=item C + +Returns the first object for which all properties listed in +C<@attributes> equal those in C<$self> but which is not C<$self>. Can +be used to check whether or not an object's columns are unique before +saving or during validation. + +=item C + +Loads objects from the database which haven't been cached before and +caches them for the duration of the current request (see +L). + +This method can be called both as an instance method and a class +method. It loads objects for the corresponding class (e.g. both +Cload_cached(…)> and +C<$some_part-Eload_cached(…)> will load parts). + +Currently only classes with a single primary key column are supported. + +Returns the cached object for the first ID. + +=item C + +Deletes all cached instances of this class (see L) for +the given IDs. + +If called as an instance method without further arguments then the +object's ID is used. + +Returns the object/class it was called on. + =back =head1 AUTHOR