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