Projekte: alte Suchmaske entfernt

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

diff --git a/SL/DB/Object.pm b/SL/DB/Object.pm
index c072e90..f2f12c0 100755 (executable)
--- a/SL/DB/Object.pm
+++ b/SL/DB/Object.pm
@@ -2,18 +2,32 @@ package SL::DB::Object;
 
 use strict;
 
 
 use strict;
 

+use Carp;

 use English qw(-no_match_vars);
 use Rose::DB::Object;
 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;
 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);
 
 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',
+);
+

 sub new {
   my $class = shift;
   my $self  = $class->SUPER::new();
 sub new {
   my $class = shift;
   my $self  = $class->SUPER::new();


@@ -50,6 +64,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);
 }


@@ -132,21 +147,15 @@ sub load {
 sub save {
   my ($self, @args) = @_;
 
 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;
 }
 
   return $result;
 }


@@ -154,31 +163,119 @@ sub save {
 sub delete {
   my ($self, @args) = @_;
 
 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;
 }
 
 
   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
 
 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


@@ -251,6 +348,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.
 
 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>).
+
+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<cache_all> function. For example, if you expect to need all unit
+objects, you can use C<SL::DB::Manager::Unit-E<gt>cache_all> before
+you start the actual work. Later you can use
+C<SL::DB::Unit-E<gt>load_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
+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.
+
+=item C<clone_and_reset>
+
+This works similar to L<Rose::DB::Object::Helpers/clone_and_reset>: 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<itime>, C<mtime>.
+
+=item C<presenter>
+
+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<SL::DB::Helper::Presenter>
+
+=item C<as_debug_info>
+
+Returns a hash containing solely the essentials for dumping it with
+L<LXDebug/dump>. The returned hash consists of the column names with
+associated column values in stringified form.
+

 =back
 
 =head1 AUTHOR
 =back
 
 =head1 AUTHOR