transdate Sortierung bei OrderItem war nicht eindeutig

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

diff --git a/SL/DB/Object.pm b/SL/DB/Object.pm
old mode 100644 (file)
new mode 100755 (executable)
index f950850..fc13652
--- a/SL/DB/Object.pm
+++ b/SL/DB/Object.pm
@@ -2,16 +2,15 @@ package SL::DB::Object;
 
 use strict;
 
 
 use strict;
 

-use Readonly;
+use English qw(-no_match_vars);

 use Rose::DB::Object;
 use List::MoreUtils qw(any);
 
 use SL::DB;
 use Rose::DB::Object;
 use List::MoreUtils qw(any);
 
 use SL::DB;

-use SL::DB::Helpers::AttrNumber;
-use SL::DB::Helpers::AttrDate;
-use SL::DB::Helpers::AttrPercent;
-use SL::DB::Helpers::Metadata;
-use SL::DB::Helpers::Manager;
+use SL::DB::Helper::Attr;
+use SL::DB::Helper::Metadata;
+use SL::DB::Helper::Manager;
+use SL::DB::Object::Hooks;

 
 use base qw(Rose::DB::Object);
 
 
 use base qw(Rose::DB::Object);
 


@@ -27,13 +26,13 @@ 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          = 'LXOFFICE';
+  my $type          = $class =~ m/::Auth/ ? 'LXOFFICE_AUTH' : 'LXOFFICE';

 
   return SL::DB::create(undef, $type);
 }
 
 sub meta_class {
 
   return SL::DB::create(undef, $type);
 }
 
 sub meta_class {

-  return 'SL::DB::Helpers::Metadata';
+  return 'SL::DB::Helper::Metadata';

 }
 
 sub _get_manager_class {
 }
 
 sub _get_manager_class {


@@ -43,7 +42,7 @@ sub _get_manager_class {
   return $class->meta->convention_manager->auto_manager_class_name($class);
 }
 
   return $class->meta->convention_manager->auto_manager_class_name($class);
 }
 

-Readonly my %text_column_types => (text => 1, char => 1, varchar => 1);
+my %text_column_types = (text => 1, char => 1, varchar => 1);

 
 sub assign_attributes {
   my $self       = shift;
 
 sub assign_attributes {
   my $self       = shift;


@@ -63,9 +62,10 @@ sub _assign_attributes {
 
   while (my ($attribute, $value) = each %attributes) {
     my $type = lc($types{$attribute} || 'text');
 
   while (my ($attribute, $value) = each %attributes) {
     my $type = lc($types{$attribute} || 'text');

-    $value   = $type eq 'boolean'        ? ($value ? 't' : 'f')
-             : $text_column_types{$type} ? $value
-             :                             ($value || undef);
+    $value   = $type eq 'boolean'                ? ($value ? 't' : 'f')
+             : $text_column_types{$type}         ? $value
+             : defined($value) && ($value eq '') ? undef
+             :                                     $value;

     $self->$attribute($value);
   }
 
     $self->$attribute($value);
   }
 


@@ -80,32 +80,88 @@ sub update_attributes {
   return $self;
 }
 
   return $self;
 }
 

-sub make_attr_helper {
-  my ($self) = @_;
-  my $package = ref $self || $self;
+sub call_sub {
+  my $self = shift;
+  my $sub  = shift;
+  return $self->$sub(@_);
+}

 
 

-  for my $col ($package->meta->columns) {
-    next if $col->primary_key_position; # don't make attr helper for primary keys
+sub call_sub_if {
+  my $self  = shift;
+  my $sub   = shift;
+  my $check = shift;

 
 

-    attr_number ($package, $col->name, -2) if $col->type =~ /numeric | real | float/xi;
-    attr_percent($package, $col->name, -2) if $col->type =~ /numeric | real | float/xi;
-    attr_number ($package, $col->name,  0) if $col->type =~ /int/xi;
-    attr_date   ($package, $col->name)     if $col->type =~ /date | timestamp/xi;
-  }
+  $check    = $check->($self) if ref($check) eq 'CODE';

 
 

-  return $self;
+  return $check ? $self->$sub(@_) : $self;

 }
 
 }
 

-sub attr_number {
-  SL::DB::Helpers::AttrNumber::define(@_);
+sub get_first_conflicting {
+  my ($self, @attributes) = @_;
+
+  my $primary_key         = ($self->meta->primary_key)[0];
+  my @where               = map { ($_ => $self->$_) } @attributes;
+
+  push @where, ("!$primary_key" => $self->$primary_key) if $self->$primary_key;
+
+  return $self->_get_manager_class->get_first(where => [ and => \@where ]);

 }
 
 }
 

-sub attr_date {
-  SL::DB::Helpers::AttrDate::define(@_);
+# These three functions cannot sit in SL::DB::Object::Hooks because
+# mixins don't deal well with super classes (SUPER is the current
+# package's super class, not $self's).
+sub load {
+  my ($self, @args) = @_;
+
+  SL::DB::Object::Hooks::run_hooks($self, 'before_load');
+  my $result = $self->SUPER::load(@args);
+  SL::DB::Object::Hooks::run_hooks($self, 'after_load', $result);
+
+  return $result;

 }
 
 }
 

-sub attr_percent {
-  SL::DB::Helpers::AttrPercent::define(@_);
+sub save {
+  my ($self, @args) = @_;
+
+  my ($result, $exception);
+  my $worker = sub {
+    SL::DB::Object::Hooks::run_hooks($self, 'before_save');
+    $exception = $EVAL_ERROR unless eval {
+      $result = $self->SUPER::save(@args);
+      1;
+    };
+    SL::DB::Object::Hooks::run_hooks($self, 'after_save', $result);
+
+    return $result;
+  };
+
+  $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker);
+
+  die $exception if $exception;
+
+  return $result;
+}
+
+sub delete {
+  my ($self, @args) = @_;
+
+  my ($result, $exception);
+  my $worker = sub {
+    SL::DB::Object::Hooks::run_hooks($self, 'before_delete');
+    $exception = $EVAL_ERROR unless eval {
+      $result = $self->SUPER::delete(@args);
+      1;
+    };
+    SL::DB::Object::Hooks::run_hooks($self, 'after_delete', $result);
+
+    return $result;
+  };
+
+  $self->db->in_transaction ? $worker->() : $self->db->do_transaction($worker);
+
+  die $exception if $exception;
+
+  return $result;

 }
 
 1;
 }
 
 1;


@@ -161,6 +217,31 @@ Returns the manager package for the object or class that it is called
 on. Can be used from methods in this package for getting the actual
 object's manager.
 
 on. Can be used from methods in this package for getting the actual
 object's manager.
 

+=item C<call_sub $name, @args>
+
+Calls the sub C<$name> on C<$self> with the arguments C<@args> and
+returns its result. This is meant for situations in which the sub's
+name is a composite, e.g.
+
+  my $chart_id = $buchungsgruppe->call_sub(($is_sales ? "income" : "expense") . "_accno_id_${taxzone_id}");
+
+=item C<call_sub_if $name, $check, @args>
+
+Calls the sub C<$name> on C<$self> with the arguments C<@args> if
+C<$check> is trueish. If C<$check> is a code reference then it will be
+called with C<$self> as the only argument and its result determines
+whether or not C<$name> is called.
+
+Returns the sub's result if the check is positive and C<$self>
+otherwise.
+
+=item C<get_first_conflicting @attributes>
+
+Returns the first object for which all properties listed in
+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.
+

 =back
 
 =head1 AUTHOR
 =back
 
 =head1 AUTHOR