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}         ||= _get_primary_key_column($caller_package);
  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} => '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 sub _get_primary_key_column {
 169   my ($caller_package) = @_;
 170   my $meta             = $caller_package->meta;
 171
 172   my $column_name;
 173   $column_name = $meta->{primary_key}->{columns}->[0] if $meta->{primary_key} && (ref($meta->{primary_key}->{columns}) eq 'ARRAY') && (1 == scalar(@{ $meta->{primary_key}->{columns} }));
 174
 175   croak "Unable to retrieve primary key column name: meta information for package $caller_package not set up correctly" unless $column_name;
 176
 177   return $column_name;
 178 }
 179
 180 1;
 181
 182 __END__
 183
 184 =encoding utf-8
 185
 186 =head1 NAME
 187
 188 SL::DB::Helper::CustomVariables - Mixin to provide custom variables relations
 189
 190 =head1 SYNOPSIS
 191
 192   # use in a primary class
 193   use SL::DB::Helper::CustomVariables (
 194     module      => 'IC',
 195     cvars_alias => 1,
 196   );
 197
 198   # use overloading in a secondary class
 199   use SL::DB::Helper::CustomVariables (
 200     sub_module  => 'orderitems',
 201     cvars_alias => 1,
 202     overloads   => {
 203       parts_id    => 'SL::DB::Part',
 204     }
 205   );
 206
 207 =head1 DESCRIPTION
 208
 209 This module provides methods to deal with named custom variables. Two concepts are understood.
 210
 211 =head2 Primary CVar Classes
 212
 213 Primary classes are those that feature cvars for themselves. Currently those
 214 are Part, Contact, Customer and Vendor. cvars for these will get saved directly
 215 for the object.
 216
 217 =head2 Secondary CVar Classes
 218
 219 Secondary classes inherit their cvars from member relationships. This is built
 220 so that orders can save a copy of the cvars of their parts, customers and the
 221 like to be immutable later on.
 222
 223 Secondary classes may currently not have cvars of their own.
 224
 225 =head1 INSTALLED METHODS
 226
 227 =over 4
 228
 229 =item C<custom_variables [ CUSTOM_VARIABLES ]>
 230
 231 This is a Rose::DB::Object::Relationship accessor, generated for cvars. Use it
 232 like any other OneToMany relationship.
 233
 234 =item C<cvars [ CUSTOM_VARIABLES ]>
 235
 236 Alias to C<custom_variables>. Will only be installed if C<cvars_alias> was
 237 passed to import.
 238
 239 =item C<cvars_by_config>
 240
 241 Thi will return a list of CVars with the following changes over the standard accessor:
 242
 243 =over 4
 244
 245 =item *
 246
 247 The list will be returned in the sorted order of the configs.
 248
 249 =item *
 250
 251 For every config exactly one CVar will be returned.
 252
 253 =item *
 254
 255 If no cvar was found for a config, a new one will be vivified, set to the
 256 correct config, module etc, and registered into the object.
 257
 258 =item *
 259
 260 Vivified cvars for secondary classes will first try to find their base object
 261 and use that value. If no such value or cvar is found the default value from
 262 configs applies.
 263
 264 =back
 265
 266 This is useful if you need to list every possible CVar, like in CRUD masks.
 267
 268 =item C<cvar_by_name NAME [ VALUE ]>
 269
 270 Returns the CVar object for this object which matches the given internal name.
 271 Useful for print templates. If the requested cvar is not present, it will be
 272 vivified with the same rules as in C<cvars_by_config>.
 273
 274 =back
 275
 276 =head1 AUTHOR
 277
 278 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 279
 280 =cut