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