SL/DB/Helper/CustomVariables.pm

   1 package SL::DB::Helper::CustomVariables;
   2
   3 use strict;
   4 use Carp;
   5 use Data::Dumper;
   6 use List::Util qw(first);
   7
   8 use constant META_CVARS => 'cvars_config';
   9
  10 sub import {
  11   my ($class, %params) = @_;
  12   my $caller_package = caller;
  13
  14   # TODO: if module is empty, module overloading needs to take effect
  15   # certain stuff may have more than one overload, odr even more than one type
  16   defined $caller_package     or croak 'need to be included from a caller reference';
  17
  18   $params{module}     ||= _calc_modules_from_overloads(%params) if $params{overloads};
  19   $params{sub_module} ||= '';
  20   $params{id}         ||= _get_primary_key_column($caller_package);
  21
  22   $params{module} || $params{sub_module}  or croak 'need param module or sub_module';
  23
  24   return unless save_meta_info($caller_package, %params);
  25   make_cvar_accessor($caller_package, %params);
  26   make_cvar_alias($caller_package, %params)      if $params{cvars_alias};
  27   make_cvar_by_configs($caller_package, %params);
  28   make_cvar_by_name($caller_package, %params);
  29 }
  30
  31 sub save_meta_info {
  32   my ($caller_package, %params) = @_;
  33
  34   my $meta = $caller_package->meta;
  35   return 0 if $meta->{META_CVARS()};
  36
  37   $meta->{META_CVARS()} = \%params;
  38
  39   return 1;
  40 }
  41
  42 sub make_cvar_accessor {
  43   my ($caller_package, %params) = @_;
  44
  45   my @module_filter = $params{module} ?
  46     ("config_id" => [ \"(SELECT custom_variable_configs.id FROM custom_variable_configs WHERE custom_variable_configs.module = '$params{module}')" ]) :
  47     ();
  48
  49   $caller_package->meta->add_relationships(
  50     custom_variables => {
  51       type         => 'one to many',
  52       class        => 'SL::DB::CustomVariable',
  53       column_map   => { $params{id} => 'trans_id' },
  54       query_args   => [ sub_module => $params{sub_module}, @module_filter ],
  55     }
  56   );
  57 }
  58
  59 sub make_cvar_alias {
  60   my ($caller_package) = @_;
  61   no strict 'refs';
  62   *{ $caller_package . '::cvars' } =  sub {
  63     goto &{ $caller_package . '::custom_variables' };
  64   }
  65 }
  66
  67 # this is used for templates where you need to list every applicable config
  68 # auto vivifies non existent cvar objects as necessary.
  69 sub make_cvar_by_configs {
  70   my ($caller_package, %params) = @_;
  71
  72   no strict 'refs';
  73   *{ $caller_package . '::cvars_by_config' } = sub {
  74     my ($self) = @_;
  75     @_ > 1 and croak "not an accessor";
  76
  77     my $configs     = _all_configs(%params);
  78     my $cvars       = $self->custom_variables;
  79     my %cvars_by_config = map { $_->config_id => $_ } @$cvars;
  80
  81     my @return  = map { $cvars_by_config{$_->id} || _new_cvar($self, %params, config => $_) } @$configs;
  82
  83     return \@return;
  84   }
  85 }
  86
  87 # this is used for print templates where you need to refer to a variable by name
  88 # TODO typically these were referred as prefix_'cvar'_name
  89 sub make_cvar_by_name {
  90   my ($caller_package, %params) = @_;
  91
  92   no strict 'refs';
  93   *{ $caller_package . '::cvar_by_name' } = sub {
  94     my ($self, $name) = @_;
  95
  96     my $configs = _all_configs(%params);
  97     my $cvars   = $self->custom_variables;
  98     my $config  = first { $_->name eq $name } @$configs;
  99
 100     croak "unknown cvar name $name" unless $config;
 101
 102     my $cvar    = first { $_->config_id eq $config->id } @$cvars;
 103
 104     if (!$cvar) {
 105       $cvar = _new_cvar($self, %params, config => $config);
 106       $self->add_custom_variables($cvar);
 107     }
 108
 109     return $cvar;
 110   }
 111 }
 112
 113 sub _all_configs {
 114   my (%params) = @_;
 115
 116   require SL::DB::CustomVariableConfig;
 117
 118   $params{module}
 119     ? SL::DB::Manager::CustomVariableConfig->get_all(query => [ module => $params{module} ])
 120     : SL::DB::Manager::CustomVariableConfig->get_all;
 121 }
 122
 123 sub _overload_by_module {
 124   my ($module, %params) = @_;
 125
 126   keys %{ $params{overloads} }; # reset each iterator
 127   while (my ($fk, $def) = each %{ $params{overloads} }) {
 128     return ($fk, $def->{class}) if $def->{module} eq $module;
 129   }
 130
 131   croak "unknown overload, cannot resolve module $module";
 132 }
 133
 134 sub _new_cvar {
 135   my ($self, %params) = @_;
 136   my $inherited_value;
 137   # check overloading first
 138   if ($params{sub_module}) {
 139     my ($fk, $class) = _overload_by_module($params{config}->module, %params);
 140     my $base_cvar = $class->new(id => $self->$fk)->load->cvar_by_name($params{config}->name);
 141     $inherited_value = $base_cvar->value;
 142   }
 143
 144   my $cvar = SL::DB::CustomVariable->new(
 145     config     => $params{config},
 146     trans_id   => $self->${ \ $params{id} },
 147     sub_module => $params{sub_module},
 148   );
 149   # value needs config
 150   $inherited_value
 151    ? $cvar->value($inherited_value)
 152    : $cvar->value($params{config}->default_value);
 153   return $cvar;
 154 }
 155
 156 sub _calc_modules_from_overloads {
 157   my (%params) = @_;
 158   my %modules;
 159
 160   for my $def (values %{ $params{overloads} || {} }) {
 161     $modules{$def->{module}} = 1;
 162   }
 163
 164   return [ keys %modules ];
 165 }
 166
 167 sub _get_primary_key_column {
 168   my ($caller_package) = @_;
 169   my $meta             = $caller_package->meta;
 170
 171   my $column_name;
 172   $column_name = $meta->{primary_key}->{columns}->[0] if $meta->{primary_key} && (ref($meta->{primary_key}->{columns}) eq 'ARRAY') && (1 == scalar(@{ $meta->{primary_key}->{columns} }));
 173
 174   croak "Unable to retrieve primary key column name: meta information for package $caller_package not set up correctly" unless $column_name;
 175
 176   return $column_name;
 177 }
 178
 179 1;
 180
 181 __END__
 182
 183 =encoding utf-8
 184
 185 =head1 NAME
 186
 187 SL::DB::Helper::CustomVariables - Mixin to provide custom variables relations
 188
 189 =head1 SYNOPSIS
 190
 191   # use in a primary class
 192   use SL::DB::Helper::CustomVariables (
 193     module      => 'IC',
 194     cvars_alias => 1,
 195   );
 196
 197   # use overloading in a secondary class
 198   use SL::DB::Helper::CustomVariables (
 199     sub_module  => 'orderitems',
 200     cvars_alias => 1,
 201     overloads   => {
 202       parts_id    => {
 203         class => 'SL::DB::Part',
 204         module => 'IC',
 205       }
 206     }
 207   );
 208
 209 =head1 DESCRIPTION
 210
 211 This module provides methods to deal with named custom variables. Two concepts are understood.
 212
 213 =head2 Primary CVar Classes
 214
 215 Primary classes are those that feature cvars for themselves. Currently those
 216 are Part, Contact, Customer and Vendor. cvars for these will get saved directly
 217 for the object.
 218
 219 =head2 Secondary CVar Classes
 220
 221 Secondary classes inherit their cvars from member relationships. This is built
 222 so that orders can save a copy of the cvars of their parts, customers and the
 223 like to be immutable later on.
 224
 225 Secondary classes may currently not have cvars of their own.
 226
 227 =head1 INSTALLED METHODS
 228
 229 =over 4
 230
 231 =item C<custom_variables [ CUSTOM_VARIABLES ]>
 232
 233 This is a Rose::DB::Object::Relationship accessor, generated for cvars. Use it
 234 like any other OneToMany relationship.
 235
 236 =item C<cvars [ CUSTOM_VARIABLES ]>
 237
 238 Alias to C<custom_variables>. Will only be installed if C<cvars_alias> was
 239 passed to import.
 240
 241 =item C<cvars_by_config>
 242
 243 Thi will return a list of CVars with the following changes over the standard accessor:
 244
 245 =over 4
 246
 247 =item *
 248
 249 The list will be returned in the sorted order of the configs.
 250
 251 =item *
 252
 253 For every config exactly one CVar will be returned.
 254
 255 =item *
 256
 257 If no cvar was found for a config, a new one will be vivified, set to the
 258 correct config, module etc, and registered into the object.
 259
 260 =item *
 261
 262 Vivified cvars for secondary classes will first try to find their base object
 263 and use that value. If no such value or cvar is found the default value from
 264 configs applies.
 265
 266 =back
 267
 268 This is useful if you need to list every possible CVar, like in CRUD masks.
 269
 270 =item C<cvar_by_name NAME [ VALUE ]>
 271
 272 Returns the CVar object for this object which matches the given internal name.
 273 Useful for print templates. If the requested cvar is not present, it will be
 274 vivified with the same rules as in C<cvars_by_config>.
 275
 276 =back
 277
 278 =head1 AUTHOR
 279
 280 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 281
 282 =cut