epic-ts

[kivitendo-erp.git] / SL / DB / Object.pm

diff --git a/SL/DB/Object.pm b/SL/DB/Object.pm
index fc13652..81ef978 100755 (executable)
--- 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')
@@ -125,12 +141,12 @@ 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;
   };
@@ -147,12 +163,12 @@ 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;
   };
@@ -164,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
@@ -242,6 +298,31 @@ 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<load_cached @ids>
+
+Loads objects from the database which haven't been cached before and
+caches them for the duration of the current request (see
+L<SL::Request/cache>).
+
+This method can be called both as an instance method and a class
+method. It loads objects for the corresponding class (e.g. both
+C<SL::DB::Part-E<gt>load_cached(…)> and
+C<$some_part-E<gt>load_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<invalidate_cached @ids>
+
+Deletes all cached instances of this class (see L</load_cached>) 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