Lizenzen sind im Config-Abschnitt "features", nicht "system"

[mfinanz.git] / SL / DB / Object.pm

diff --git a/SL/DB/Object.pm b/SL/DB/Object.pm
index f138518007537b98aebb07d5c69c1e0754a1c08f..71e0a3939b3f76b147aaa89eb8db49c0c9706f50 100644 (file)
--- a/SL/DB/Object.pm
+++ b/SL/DB/Object.pm
@@ -2,14 +2,13 @@ package SL::DB::Object;
 
 use strict;
 
 
 use strict;
 

-use Readonly;

 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::Attr;
-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 base qw(Rose::DB::Object);
 
 
 use base qw(Rose::DB::Object);
 


@@ -25,13 +24,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 {


@@ -41,7 +40,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;


@@ -61,9 +60,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);
   }
 


@@ -78,6 +78,12 @@ sub update_attributes {
   return $self;
 }
 
   return $self;
 }
 

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

 1;
 
 __END__
 1;
 
 __END__


@@ -131,6 +137,14 @@ 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}");
+

 =back
 
 =head1 AUTHOR
 =back
 
 =head1 AUTHOR