X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FDB%2FObject.pm;h=89d15c67101874c05c486005aedf0fc4691328fd;hb=0d3f708bfa179b6d0ea18d00398b98dd9557f389;hp=c072e90117c009c000ee4fec3ea01a31e93467cc;hpb=0674bc84625f8968ae558027c48af5815ce5f4be;p=kivitendo-erp.git diff --git a/SL/DB/Object.pm b/SL/DB/Object.pm index c072e9011..89d15c671 100755 --- a/SL/DB/Object.pm +++ b/SL/DB/Object.pm @@ -2,18 +2,34 @@ 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 List::Util qw(first); 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(); @@ -50,6 +66,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); } @@ -89,6 +106,50 @@ sub update_attributes { return $self; } +sub update_collection { + my ($self, $attribute, $entries) = @_; + + my $self_primary_key = "" . ($self->meta->primary_key_columns)[0]; + + croak "\$self hasn't been saved yet" if !$self->$self_primary_key; + + my $relationship = first { $_->name eq $attribute } @{ $self->meta->relationships }; + + croak "No relationship found for attribute '$attribute'" if !$relationship; + + my @primary_key_columns = $relationship->class->meta->primary_key_columns; + + croak "Classes with multiple primary key columns are not supported" if scalar(@primary_key_columns) > 1; + + my $class = $relationship->class; + my $manager_class = "SL::DB::Manager::" . substr($class, 8); + my $other_primary_key = "" . $primary_key_columns[0]; + my $column_map = $relationship->column_map; + my @new_entries = @{ $entries // [] }; + my @existing_entries = @{ $self->$attribute // [] }; + my @to_delete = grep { my $value = $_->$other_primary_key; !any { $_->{$other_primary_key} == $value } @new_entries } @existing_entries; + + $_->delete for @to_delete; + + foreach my $entry (@new_entries) { + if (!$entry->{$other_primary_key}) { + my $new_instance = $class->new(%{ $entry }); + + foreach my $self_attribute (keys %{ $column_map }) { + my $other_attribute = $column_map->{$self_attribute}; + $new_instance->$other_attribute($self->$self_attribute); + } + + $new_instance->save; + + next; + } + + my $existing = first { $_->$other_primary_key == $entry->{$other_primary_key} } @existing_entries; + $existing->update_attributes(%{ $entry }) if $existing; + } +} + sub call_sub { my $self = shift; my $sub = shift; @@ -132,21 +193,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; - }; + my $result; - return $result; - }; + $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); - $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker); - - die $exception if $exception; + 1; + }) || die $self->db->error; return $result; } @@ -154,31 +209,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->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); - $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker); - - 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 @@ -220,6 +363,28 @@ Assigns the attributes from C<%attributes> by calling the C function and saves the object afterwards. Returns the object itself. +=item C + +Updates a one-to-many relationship named C<$attribute> to match the +entries in C<$entries>. C<$entries> is supposed to be an array ref of +hash refs. + +For each hash ref in C<$entries> that does not contain a field for the +relationship's primary key column, this function creates a new entry +in the database with its attributes set to the data in the entry. + +For each hash ref in C<$entries> that contains a field for the +relationship's primary key column, this function looks up the +corresponding entry in C<$self->$attribute> & updates its +attributes with the data in the entry. + +All objects in C<$self->$attribute> for which no corresponding +entry exists in C<$entries> are deleted by calling the object's +C method. + +In all cases the relationship itself C<$self->$attribute> is not +changed. + =item _get_manager_class Returns the manager package for the object or class that it is called @@ -251,6 +416,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