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