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 strict;
 

+use Carp;

 use English qw(-no_match_vars);
 use Rose::DB::Object;
 use List::MoreUtils qw(any);
 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);
 
 
 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();
 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;
 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);
 }
 
   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;
 
   my $pk         = ref($self)->meta->primary_key;
   delete @attributes{$pk->column_names} if $pk;

+  delete @attributes{@rose_reserved_methods};

 
   return $self->_assign_attributes(%attributes);
 }
 
   return $self->_assign_attributes(%attributes);
 }


@@ -60,6 +67,15 @@ sub _assign_attributes {
 
   my %types      = map { $_->name => $_->type } ref($self)->meta->columns;
 
 
   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')
   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 {
 
   my ($result, $exception);
   my $worker = sub {

-    SL::DB::Object::Hooks::run_hooks($self, 'before_save');

     $exception = $EVAL_ERROR unless eval {
     $exception = $EVAL_ERROR unless eval {

+      SL::DB::Object::Hooks::run_hooks($self, 'before_save');

       $result = $self->SUPER::save(@args);
       $result = $self->SUPER::save(@args);

+      SL::DB::Object::Hooks::run_hooks($self, 'after_save', $result);

       1;
     };
       1;
     };

-    SL::DB::Object::Hooks::run_hooks($self, 'after_save', $result);

 
     return $result;
   };
 
     return $result;
   };


@@ -147,12 +163,12 @@ sub delete {
 
   my ($result, $exception);
   my $worker = sub {
 
   my ($result, $exception);
   my $worker = sub {

-    SL::DB::Object::Hooks::run_hooks($self, 'before_delete');

     $exception = $EVAL_ERROR unless eval {
     $exception = $EVAL_ERROR unless eval {

+      SL::DB::Object::Hooks::run_hooks($self, 'before_delete');

       $result = $self->SUPER::delete(@args);
       $result = $self->SUPER::delete(@args);

+      SL::DB::Object::Hooks::run_hooks($self, 'after_delete', $result);

       1;
     };
       1;
     };

-    SL::DB::Object::Hooks::run_hooks($self, 'after_delete', $result);

 
     return $result;
   };
 
     return $result;
   };


@@ -164,12 +180,52 @@ sub delete {
   return $result;
 }
 
   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
 
 1;
 
 __END__
 
 =pod
 

+=encoding utf8
+

 =head1 NAME
 
 SL::DB::Object: Base class for all of our model classes
 =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.
 
 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
 =back
 
 =head1 AUTHOR