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 use SL::DB::CustomVariableConfig;
   8
   9 use constant META_CVARS => 'cvars_config';
  10
  11 sub import {
  12   my ($class, %params) = @_;
  13   my $caller_package = caller;
  14
  15   # TODO: if module is empty, module overloading needs to take effect
  16   # certain stuff may have more than one overload, odr even more than one type
  17   defined $caller_package     or croak 'need to be included from a caller reference';
  18
  19   $params{module}     ||= _calc_modules_from_overloads(%params) if $params{overloads};
  20   $params{sub_module} ||= '';
  21   $params{id}         ||= 'id';
  22
  23   $params{module} || $params{sub_module}  or croak 'need param module or sub_module';
  24
  25   save_meta_info($caller_package, %params);
  26   make_cvar_accessor($caller_package, %params);
  27   make_cvar_alias($caller_package, %params)      if $params{cvars_alias};
  28   make_cvar_by_configs($caller_package, %params);
  29   make_cvar_by_name($caller_package, %params);
  30 }
  31
  32 sub save_meta_info {
  33   my ($caller_package, %params) = @_;
  34
  35   my $meta = $caller_package->meta;
  36   return 0 if $meta->{META_CVARS()};
  37
  38   $meta->{META_CVARS()} = \%params;
  39 }
  40
  41 sub make_cvar_accessor {
  42   my ($caller_package, %params) = @_;
  43
  44   my @module_filter = $params{module} ?
  45     ("config.module" => $params{module}) :
  46     ();
  47
  48   $caller_package->meta->add_relationships(
  49     custom_variables => {
  50       type         => 'one to many',
  51       class        => 'SL::DB::CustomVariable',
  52       column_map   => { ($params{id} || 'id') => 'trans_id' },
  53       manager_args => { with_objects => 'config' },
  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 existant 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   $params{module}
 116     ? SL::DB::Manager::CustomVariableConfig->get_all(query => [ module => $params{module} ])
 117     : SL::DB::Manager::CustomVariableConfig->get_all;
 118 }
 119
 120 sub _overload_by_module {
 121   my ($module, %params) = @_;
 122
 123   while (my ($fk, $class) = each %{ $params{overloads} }) {
 124     return ($fk, $class) if $class->meta->{META_CVARS()}->{module} eq $module;
 125   }
 126
 127   croak "unknown overload, cannot resolve module $module";
 128 }
 129
 130 sub _new_cvar {
 131   my ($self, %params) = @_;
 132   my $inherited_value;
 133   # check overloading first
 134   if ($params{sub_module}) {
 135     my ($fk, $class) = _overload_by_module($params{config}->module, %params);
 136     my $base_cvar = $class->new(id => $self->$fk)->load->cvar_by_name($params{config}->name);
 137     $inherited_value = $base_cvar->value;
 138   }
 139
 140   my $cvar = SL::DB::CustomVariable->new(
 141     config     => $params{config},
 142     trans_id   => $self->${ \ $params{id} },
 143     sub_module => $params{sub_module},
 144   );
 145   # value needs config
 146   $inherited_value
 147    ? $cvar->value($inherited_value)
 148    : $cvar->value($params{config}->default_value);
 149   return $cvar;
 150 }
 151
 152 sub _calc_modules_from_overloads {
 153   my (%params) = @_;
 154   my %modules;
 155
 156   while (my ($fk, $class) = each %{ $params{overloads} }) {
 157     eval "require $class"; # make sure the class is loaded
 158     my $module = $class->meta->{META_CVARS()}->{module};
 159     next if ref $module;
 160     $modules{$module} = 1;
 161   }
 162
 163   return [ keys %modules ];
 164 }
 165
 166
 167 1;
 168
 169 __END__
 170
 171 =encoding utf-8
 172
 173 =head1 NAME
 174
 175 SL::DB::Helper::CustomVariables - Mixin to provide custom variables relations
 176
 177 =head1 SYNOPSIS
 178
 179   # use in a primary class
 180   use SL::DB::Helper::CustomVariables (
 181     module      => 'IC',
 182     cvars_alias => 1,
 183   );
 184
 185   # use overloading in a secondary class
 186   use SL::DB::Helper::CustomVariables (
 187     sub_module  => 'orderitems',
 188     cvars_alias => 1,
 189     overloads   => {
 190       parts_id    => 'SL::DB::Part',
 191     }
 192   );
 193
 194 =head1 DESCRIPTION
 195
 196 This module provides methods to deal with named custom variables. Two concepts are understood.
 197
 198 =head2 Primary CVar Classes
 199
 200 Primary classes are those that feature cvars for themselves. Currently those
 201 are Part, Contact, Customer and Vendor. cvars for these will get saved directly
 202 for the object.
 203
 204 =head2 Secondary CVar Classes
 205
 206 Secondary classes inherit their cvars from member relationships. This is built
 207 so that orders can save a copy of the cvars of their parts, customers and the
 208 like to be immutable later on.
 209
 210 Secondary classes may currently not have cvars of their own.
 211
 212 =head1 INSTALLED METHODS
 213
 214 =over 4
 215
 216 =item C<custom_variables [ CUSTOM_VARIABLES ]>
 217
 218 This is a Rose::DB::Object::Relationship accessor, generated for cvars. Use it
 219 like any other OneToMany relationship.
 220
 221 =item C<cvars [ CUSTOM_VARIABLES ]>
 222
 223 Alias to C<custom_variables>. Will only be installed if C<cvars_alias> was
 224 passed to import.
 225
 226 =item C<cvars_by_config>
 227
 228 Thi will return a list of CVars with the following changes over the standard accessor:
 229
 230 =over 4
 231
 232 =item *
 233
 234 The list will be returned in the sorted order of the configs.
 235
 236 =item *
 237
 238 For every config exactly one CVar will be returned.
 239
 240 =item *
 241
 242 If no cvar was found for a config, a new one will be vivified, set to the
 243 correct config, module etc, and registered into the object.
 244
 245 =item *
 246
 247 Vivified cvars for secondary classes will first try to find their base object
 248 and use that value. If no such value or cvar is found the default value from
 249 configs applies.
 250
 251 =back
 252
 253 This is useful if you need to list every possible CVar, like in CRUD masks.
 254
 255 =item C<cvar_by_name NAME [ VALUE ]>
 256
 257 Returns the CVar object for this object which matches the given internal name.
 258 Useful for print templates. If the requested cvar is not present, it will be
 259 vivified with the same rules as in C<cvars_by_config>.
 260
 261 =back
 262
 263 =head1 AUTHOR
 264
 265 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 266
 267 =cut