Primärschlüsselspaltennamen aus Meta-Informationen holen

Benutzerdefinierte Variablen verweisen auf die Primärschlüsselspalte
ihrer Bezugstabelle. Dieser Spaltenname kann beim Helper mit der
Option 'id' überschrieben werden. Allerdings defaultete er vorher auf
'id', was für viele Tabellen stimmte, nicht aber z.B. für 'contacts',
wo es die Spalte 'cp_cv_id' ist.

Für 'contacts' passierte dann Folgendes, wenn man
'$contact->custom_variables' aufrief:

Die Funktion 'custom_variables' ist eine one-to-many-Relation, sie
erfordert also einen DB-Zugriff. Dafür wird die Spaltenbeziehung
'cvar.trans_id == contacts.primary_key_column_name' herangezogen. Der
'primary_key_column_name' ist nicht angegeben, Defaultwert ist
'id'. RDBO versucht also, die Spalte 'id' aus dem Objekt '$contact'
auszulesen, mappt dafür den Spaltennamen auf den Methodennamen dafür.

Dieses Mapping liefert den leeren String. Das überprüft RDBO in dem
Moment aber nicht, sondern ruft "$object->$method()" auf. Das wirft
eine Exception, RDBO fängt diese ab, überprüft dann, ob '$AUTOLOAD'
einen Paketnamen enthält. Und dann kommt diese wenig erhellende
Fehlermeldung heraus:

Can't locate object method "Contact::" via package "SL::DB" at /usr/share/perl5/Rose/DB/Object.pm line 1646

diff --git a/SL/DB/Helper/CustomVariables.pm b/SL/DB/Helper/CustomVariables.pm
index ef6a0a9..c935cba 100644 (file)
--- a/SL/DB/Helper/CustomVariables.pm
+++ b/SL/DB/Helper/CustomVariables.pm
@@ -18,7 +18,7 @@ sub import {
 
   $params{module}     ||= _calc_modules_from_overloads(%params) if $params{overloads};
   $params{sub_module} ||= '';
-  $params{id}         ||= 'id';
+  $params{id}         ||= _get_primary_key_column($caller_package);
 
   $params{module} || $params{sub_module}  or croak 'need param module or sub_module';
 
@@ -51,7 +51,7 @@ sub make_cvar_accessor {
     custom_variables => {
       type         => 'one to many',
       class        => 'SL::DB::CustomVariable',
-      column_map   => { ($params{id} || 'id') => 'trans_id' },
+      column_map   => { $params{id} => 'trans_id' },
       query_args   => [ sub_module => $params{sub_module}, @module_filter ],
     }
   );
@@ -165,6 +165,17 @@ sub _calc_modules_from_overloads {
   return [ keys %modules ];
 }
 
+sub _get_primary_key_column {
+  my ($caller_package) = @_;
+  my $meta             = $caller_package->meta;
+
+  my $column_name;
+  $column_name = $meta->{primary_key}->{columns}->[0] if $meta->{primary_key} && (ref($meta->{primary_key}->{columns}) eq 'ARRAY') && (1 == scalar(@{ $meta->{primary_key}->{columns} }));
+
+  croak "Unable to retrieve primary key column name: meta information for package $caller_package not set up correctly" unless $column_name;
+
+  return $column_name;
+}
 
 1;