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