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