X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FDB%2FObject.pm;h=3e0fca68b19f564e76ca8bbd2e32c15f1146ba04;hb=0b36b2259c1300ee5360a9c8d5aee1f321abd364;hp=8b86e97111a9942d2b0e422a30026d9557f571ff;hpb=b3f351139a745a2d01dd35e5a70f72e61b2c2adb;p=kivitendo-erp.git diff --git a/SL/DB/Object.pm b/SL/DB/Object.pm index 8b86e9711..3e0fca68b 100755 --- a/SL/DB/Object.pm +++ b/SL/DB/Object.pm @@ -2,18 +2,33 @@ package SL::DB::Object; use strict; +use Carp; use English qw(-no_match_vars); use Rose::DB::Object; -use List::MoreUtils qw(any); +use Rose::DB::Object::Constants qw(); +use List::MoreUtils qw(any pairwise); use SL::DB; use SL::DB::Helper::Attr; use SL::DB::Helper::Metadata; use SL::DB::Helper::Manager; +use SL::DB::Helper::Presenter; 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 +); + +my %db_to_presenter_mapping = ( + Customer => 'CustomerVendor', + PurchaseInvoice => 'Invoice', + Vendor => 'CustomerVendor', + GLTransaction => 'GL', +); + sub new { my $class = shift; my $self = $class->SUPER::new(); @@ -26,7 +41,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 +65,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); } @@ -132,21 +148,15 @@ sub load { sub save { my ($self, @args) = @_; - my ($result, $exception); - my $worker = sub { - $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; - }; - - return $result; - }; + my $result; - $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker); + $self->db->with_transaction(sub { + SL::DB::Object::Hooks::run_hooks($self, 'before_save'); + $result = $self->SUPER::save(@args); + SL::DB::Object::Hooks::run_hooks($self, 'after_save', $result); - die $exception if $exception; + 1; + }) || die $self->db->error; return $result; } @@ -154,31 +164,119 @@ sub save { sub delete { my ($self, @args) = @_; - my ($result, $exception); - my $worker = sub { - $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; - }; + my $result; - return $result; - }; - - $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker); + $self->db->with_transaction(sub { + SL::DB::Object::Hooks::run_hooks($self, 'before_delete'); + $result = $self->SUPER::delete(@args); + SL::DB::Object::Hooks::run_hooks($self, 'after_delete', $result); - die $exception if $exception; + 1; + }) || die $self->db->error; 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; +} + +my %_skip_fields_when_cloning = map { ($_ => 1) } qw(itime mtime); + +sub clone_and_reset { + my($self) = shift; + my $class = ref $self; + my $cloning = Rose::DB::Object::Constants::STATE_CLONING(); + local $self->{$cloning} = 1; + + my $meta = $class->meta; + my @accessors = $meta->column_accessor_method_names; + my @mutators = $meta->column_mutator_method_names; + my @column_names = + grep { $_->[0] && $_->[1] && !$_skip_fields_when_cloning{ $_->[0] } } + pairwise { no warnings qw(once); [ $a, $b] } @accessors, @mutators; + + my $clone = $class->new(map { my $method = $_->[0]; ($_->[1] => $self->$method) } @column_names); + + # Blank all primary and unique key columns + my @keys = ( + $meta->primary_key_column_mutator_names, + map { my $uk = $_; map { $meta->column_mutator_method_name($_) } ($uk->columns) } ($meta->unique_keys) + ); + + $clone->$_(undef) for @keys; + + # Also copy db object, if any + $clone->db($self->{db}) if $self->{db}; + + return $clone; +} + +sub presenter { + my ($self) = @_; + + my $class = ref $self; + $class =~ s{^SL::DB::}{}; + $class = "SL::Presenter::" . ($db_to_presenter_mapping{$class} // $class); + + return SL::DB::Helper::Presenter->new($class, $self); +} + +sub as_debug_info { + my ($self) = @_; + + return { + map { + my $column_name = $_->name; + my $value = $self->$column_name; + $value = !defined($value) ? undef : "${value}"; + ($_ => $value) + } $self->meta->columns + }; +} + 1; __END__ =pod +=encoding utf8 + =head1 NAME SL::DB::Object: Base class for all of our model classes @@ -251,6 +349,63 @@ 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). + +If you know in advance that you will likely need all objects of a +particular type then you can pre-cache them by calling the manager's +C function. For example, if you expect to need all unit +objects, you can use Ccache_all> before +you start the actual work. Later you can use +Cload_cached> to retrieve individual objects and be +sure that they're already cached. + +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. + +=item C + +This works similar to L: it +returns a cloned instance of C<$self>. All primary and unique key +fields have been reset. + +The difference between Rose's and this function is that this function +will also skip setting the following fields if such columns exist for +C<$self>: C, C. + +=item C + +Returns a proxy wrapper that will dispatch all method calls to the presenter +with the same name as the class of the involking object. + +For the full documentation about its capabilites see +L + +=item C + +Returns a hash containing solely the essentials for dumping it with +L. The returned hash consists of the column names with +associated column values in stringified form. + =back =head1 AUTHOR