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 List::UtilsBy qw(sort_by partition_by);
   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, or 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   make_cvar_as_hashref($caller_package, %params);
  31   make_cvar_value_parser($caller_package, %params);
  32   make_cvar_custom_filter($caller_package, %params);
  33 }
  34
  35 sub save_meta_info {
  36   my ($caller_package, %params) = @_;
  37
  38   my $meta = $caller_package->meta;
  39   return 0 if $meta->{META_CVARS()};
  40
  41   $meta->{META_CVARS()} = \%params;
  42
  43   return 1;
  44 }
  45
  46 sub make_cvar_accessor {
  47   my ($caller_package, %params) = @_;
  48
  49   my $modules = ('ARRAY' eq ref $params{module}) ?
  50       join ',', @{ $params{module} } :
  51       $params{module};
  52   my @module_filter = $modules ?
  53     ("config_id" => [ \"(SELECT custom_variable_configs.id FROM custom_variable_configs WHERE custom_variable_configs.module IN ( '$modules' ))" ]) : # " make emacs happy
  54     ();
  55
  56   $caller_package->meta->add_relationships(
  57     custom_variables => {
  58       type         => 'one to many',
  59       class        => 'SL::DB::CustomVariable',
  60       column_map   => { $params{id} => 'trans_id' },
  61       query_args   => [ sub_module => $params{sub_module}, @module_filter ],
  62     }
  63   );
  64 }
  65
  66 sub make_cvar_alias {
  67   my ($caller_package) = @_;
  68   no strict 'refs';
  69   *{ $caller_package . '::cvars' } =  sub {
  70     goto &{ $caller_package . '::custom_variables' };
  71   }
  72 }
  73
  74 # this is used for templates where you need to list every applicable config
  75 # auto vivifies non existent cvar objects as necessary.
  76 sub make_cvar_by_configs {
  77   my ($caller_package, %params) = @_;
  78
  79   no strict 'refs';
  80   *{ $caller_package . '::cvars_by_config' } = sub {
  81     my ($self) = @_;
  82     @_ > 1 and croak "not an accessor";
  83
  84     my $configs     = _all_configs(%params);
  85     my $cvars       = $self->custom_variables;
  86     my %cvars_by_config = map { $_->config_id => $_ } @$cvars;
  87     my $invalids    = _all_invalids($self->${\ $self->meta->primary_key_columns->[0]->name }, $configs, %params);
  88     my %invalids_by_config = map { $_->config_id => 1 } @$invalids;
  89
  90     my @return = map(
  91       {
  92         my $cvar;
  93         if ( $cvars_by_config{$_->id} ) {
  94           $cvar = $cvars_by_config{$_->id};
  95         }
  96         else {
  97           $cvar = _new_cvar($self, %params, config => $_);
  98           $self->add_custom_variables($cvar);
  99         }
 100         $cvar->{is_valid} = !$invalids_by_config{$_->id};
 101         $cvar->{config}   = $_;
 102         $cvar;
 103       }
 104       @$configs
 105     );
 106
 107     @return = sort_by { $_->config->sortkey } @return;
 108
 109     return \@return;
 110   }
 111 }
 112
 113 # this is used for print templates where you need to refer to a variable by name
 114 # TODO typically these were referred as prefix_'cvar'_name
 115 sub make_cvar_by_name {
 116   my ($caller_package, %params) = @_;
 117
 118   no strict 'refs';
 119   *{ $caller_package . '::cvar_by_name' } = sub {
 120     my ($self, $name) = @_;
 121
 122     my $configs = _all_configs(%params);
 123     my $cvars   = $self->custom_variables;
 124     my $config  = first { $_->name eq $name } @$configs;
 125
 126     croak "unknown cvar name $name" unless $config;
 127
 128     my $cvar    = first { $_->config_id eq $config->id } @$cvars;
 129
 130     if (!$cvar) {
 131       $cvar = _new_cvar($self, %params, config => $config);
 132       $self->add_custom_variables($cvar);
 133     }
 134
 135     return $cvar;
 136   }
 137 }
 138
 139 sub make_cvar_as_hashref {
 140   my ($caller_package, %params) = @_;
 141
 142   no strict 'refs';
 143   *{ $caller_package . '::cvar_as_hashref' } = sub {
 144     my ($self) = @_;
 145     @_ > 1 and croak "not an accessor";
 146
 147     my $cvars_by_config = $self->cvars_by_config;
 148
 149     my %return = map {
 150       $_->config->name => { value => $_->value_as_text, is_valid => $_->is_valid }
 151     } @$cvars_by_config;
 152
 153     return \%return;
 154   }
 155 }
 156
 157 sub make_cvar_value_parser {
 158   my ($caller_package) = @_;
 159   no strict 'refs';
 160   *{ $caller_package . '::parse_custom_variable_values' } =  sub {
 161     my ($self) = @_;
 162
 163     $_->parse_value for @{ $self->custom_variables || [] };
 164
 165     return $self;
 166   };
 167
 168   $caller_package->before_save('parse_custom_variable_values');
 169 }
 170
 171 sub _all_configs {
 172   my (%params) = @_;
 173
 174   require SL::DB::CustomVariableConfig;
 175
 176   my $cache  = $::request->cache("::SL::DB::Helper::CustomVariables::object_cache");
 177
 178   if (!$cache->{all}) {
 179     my $configs = SL::DB::Manager::CustomVariableConfig->get_all_sorted;
 180     $cache->{all}    =  $configs;
 181     $cache->{module} = { partition_by { $_->module } @$configs };
 182   }
 183
 184   return $params{module} && !ref $params{module} ? $cache->{module}{$params{module}}
 185        : $params{module} &&  ref $params{module} ? [ map { @{ $cache->{module}{$_} // [] } } @{ $params{module} } ]
 186        : $cache->{all};
 187 }
 188
 189 sub _overload_by_module {
 190   my ($module, %params) = @_;
 191
 192   keys %{ $params{overloads} }; # reset each iterator
 193   while (my ($fk, $def) = each %{ $params{overloads} }) {
 194     return ($fk, $def->{class}) if $def->{module} eq $module;
 195   }
 196
 197   croak "unknown overload, cannot resolve module $module";
 198 }
 199
 200 sub _new_cvar {
 201   my ($self, %params) = @_;
 202   my $inherited_value;
 203   # check overloading first
 204   if ($params{sub_module}) {
 205     my ($fk, $class) = _overload_by_module($params{config}->module, %params);
 206     my $base_cvar = $class->new(id => $self->$fk)->load->cvar_by_name($params{config}->name);
 207     $inherited_value = $base_cvar->value;
 208   }
 209
 210   my $cvar = SL::DB::CustomVariable->new(
 211     config     => $params{config},
 212     trans_id   => $self->${ \ $params{id} },
 213     sub_module => $params{sub_module},
 214   );
 215   # value needs config
 216   $inherited_value
 217    ? $cvar->value($inherited_value)
 218    : $cvar->value($params{config}->type_dependent_default_value);
 219   return $cvar;
 220 }
 221
 222 sub _calc_modules_from_overloads {
 223   my (%params) = @_;
 224   my %modules;
 225
 226   for my $def (values %{ $params{overloads} || {} }) {
 227     $modules{$def->{module}} = 1;
 228   }
 229
 230   return [ keys %modules ];
 231 }
 232
 233 sub _get_primary_key_column {
 234   my ($caller_package) = @_;
 235   my $meta             = $caller_package->meta;
 236
 237   my $column_name;
 238   $column_name = $meta->{primary_key}->{columns}->[0] if $meta->{primary_key} && (ref($meta->{primary_key}->{columns}) eq 'ARRAY') && (1 == scalar(@{ $meta->{primary_key}->{columns} }));
 239
 240   croak "Unable to retrieve primary key column name: meta information for package $caller_package not set up correctly" unless $column_name;
 241
 242   return $column_name;
 243 }
 244
 245 sub make_cvar_custom_filter {
 246   my ($caller_package, %params) = @_;
 247
 248   my $manager    = $caller_package->meta->convention_manager->auto_manager_class_name;
 249
 250   return unless $manager->can('filter');
 251
 252   $manager->add_filter_specs(
 253     cvar => sub {
 254       my ($key, $value, $prefix, $config_id) = @_;
 255       my $config = SL::DB::Manager::CustomVariableConfig->find_by(id => $config_id);
 256
 257       if (!$config) {
 258         die "invalid config_id in $caller_package\::cvar custom filter: $config_id";
 259       }
 260
 261       if ($config->module != $params{module}) {
 262         die "invalid config_id in $caller_package\::cvar custom filter: expected module $params{module} - got @{[ $config->module ]}";
 263       }
 264
 265       my @filter;
 266       if ($config->type eq 'bool') {
 267         @filter = $value ? ($config->value_col => 1) : (or => [ $config->value_col => undef, $config->value_col => 0 ]);
 268       } else {
 269         @filter = ($config->value_col => $value);
 270       }
 271
 272       my (%query, %bind_vals);
 273       ($query{customized}, $bind_vals{customized}) = Rose::DB::Object::QueryBuilder::build_select(
 274         dbh                  => $config->dbh,
 275         select               => 'trans_id',
 276         tables               => [ 'custom_variables' ],
 277         columns              => { custom_variables => [ qw(trans_id config_id text_value number_value bool_value timestamp_value sub_module) ] },
 278         query                => [
 279           config_id          => $config_id,
 280           sub_module         => $params{sub_module},
 281           @filter,
 282         ],
 283         query_is_sql         => 1,
 284       );
 285
 286       if ($config->type eq 'bool') {
 287         if ($value) {
 288           @filter = (
 289             '!default_value' => undef,
 290             '!default_value' => '',
 291             default_value    => '1',
 292           );
 293
 294         } else {
 295           @filter = (
 296             or => [
 297               default_value => '0',
 298               default_value => '',
 299               default_value => undef,
 300             ],
 301           );
 302         }
 303
 304       } else {
 305         @filter = (
 306           '!default_value' => undef,
 307           '!default_value' => '',
 308           default_value    => $value,
 309         );
 310       }
 311
 312
 313       my $conversion  = $config->type =~ m{^(?:date|timestamp)$}       ? $config->type
 314                       : $config->type =~ m{^(?:customer|vendor|part)$} ? 'integer'
 315                       : $config->type eq 'number'                      ? 'numeric'
 316                       :                                                  '';
 317
 318       ($query{config}, $bind_vals{config}) = Rose::DB::Object::QueryBuilder::build_select(
 319         dbh                => $config->dbh,
 320         select             => 'id',
 321         tables             => [ 'custom_variable_configs' ],
 322         columns            => { custom_variable_configs => [ qw(id default_value) ] },
 323         query              => [
 324           id               => $config->id,
 325           @filter,
 326         ],
 327         query_is_sql       => 1,
 328       );
 329
 330       $query{config} =~ s{ (?<! NOT\( ) default_value (?! \s*is\s+not\s+null) }{default_value::${conversion}}x if $conversion;
 331
 332       ($query{not_customized}, $bind_vals{not_customized}) = Rose::DB::Object::QueryBuilder::build_select(
 333         dbh          => $config->dbh,
 334         select       => 'trans_id',
 335         tables       => [ 'custom_variables' ],
 336         columns      => { custom_variables => [ qw(trans_id config_id sub_module) ] },
 337         query        => [
 338           config_id  => $config_id,
 339           sub_module => $params{sub_module},
 340         ],
 341         query_is_sql => 1,
 342       );
 343
 344       foreach my $key (keys %query) {
 345         # remove rose aliases. query builder sadly is not reentrant, and will reuse the same aliases. :(
 346         $query{$key} =~ s{\bt\d+(?:\.)?\b}{}g;
 347
 348         # manually inline the values. again, rose doesn't know how to handle bind params in subqueries :(
 349         $query{$key} =~ s{\?}{ $config->dbh->quote(shift @{ $bind_vals{$key} }) }xeg;
 350
 351         $query{$key} =~ s{\n}{ }g;
 352       }
 353
 354       my $qry_config = "EXISTS (" . $query{config} . ")";
 355
 356       my @result = (
 357         'or' => [
 358           $prefix . 'id'   => [ \$query{customized} ],
 359           and              => [
 360             "!${prefix}id" => [ \$query{not_customized}  ],
 361             \$qry_config,
 362           ]
 363         ],
 364       );
 365
 366       return @result;
 367     }
 368   );
 369 }
 370
 371
 372 sub _all_invalids {
 373   my ($trans_id, $configs, %params) = @_;
 374
 375   require SL::DB::CustomVariableValidity;
 376
 377   # easy 1: no trans_id, all valid by default.
 378   return [] unless $trans_id;
 379
 380   # easy 2: no module in params? no validity
 381   return [] unless $params{module};
 382
 383   my %wanted_modules = ref $params{module} ? map { $_ => 1 } @{ $params{module} } : ($params{module} => 1);
 384   my @module_configs = grep { $wanted_modules{$_->module} } @$configs;
 385
 386   return [] unless @module_configs;
 387
 388   # nor find all entries for that and return
 389   SL::DB::Manager::CustomVariableValidity->get_all(
 390     query => [
 391       config_id => [ map { $_->id } @module_configs ],
 392       trans_id => $trans_id,
 393     ]
 394   );
 395 }
 396
 397 1;
 398
 399 __END__
 400
 401 =encoding utf-8
 402
 403 =head1 NAME
 404
 405 SL::DB::Helper::CustomVariables - Mixin to provide custom variable relations
 406
 407 =head1 SYNOPSIS
 408
 409   # use in a primary class
 410   use SL::DB::Helper::CustomVariables (
 411     module      => 'IC',
 412     cvars_alias => 1,
 413   );
 414
 415   # use overloading in a secondary class
 416   use SL::DB::Helper::CustomVariables (
 417     sub_module  => 'orderitems',
 418     cvars_alias => 1,
 419     overloads   => {
 420       parts_id    => {
 421         class => 'SL::DB::Part',
 422         module => 'IC',
 423       }
 424     }
 425   );
 426
 427 =head1 DESCRIPTION
 428
 429 This module provides methods to deal with named custom variables. Two concepts are understood.
 430
 431 =head2 Primary CVar Classes
 432
 433 Primary classes are those that feature cvars for themselves. Currently those
 434 are Part, Contact, Customer and Vendor. cvars for these will get saved directly
 435 for the object.
 436
 437 =head2 Secondary CVar Classes
 438
 439 Secondary classes inherit their cvars from member relationships. This is built
 440 so that orders can save a copy of the cvars of their parts, customers and the
 441 like to be immutable later on.
 442
 443 Secondary classes may currently not have cvars of their own.
 444
 445 =head1 INSTALLED METHODS
 446
 447 =over 4
 448
 449 =item C<custom_variables [ CUSTOM_VARIABLES ]>
 450
 451 This is a Rose::DB::Object::Relationship accessor, generated for cvars. Use it
 452 like any other OneToMany relationship.
 453
 454 Note that unlike L</cvars_by_config> this accessor only returns
 455 variables that have already been created for this object. No variables
 456 will be autovivified for configs for which no variable has been
 457 created yet.
 458
 459 =item C<cvars [ CUSTOM_VARIABLES ]>
 460
 461 Alias to C<custom_variables>. Will only be installed if C<cvars_alias> was
 462 passed to import.
 463
 464 =item C<cvars_by_config>
 465
 466 This will return a list of CVars with the following changes over the standard accessor:
 467
 468 =over 4
 469
 470 =item *
 471
 472 The list will be returned in the sorted order of the configs.
 473
 474 =item *
 475
 476 For every config exactly one CVar will be returned.
 477
 478 =item *
 479
 480 If no cvar was found for a config, a new one will be vivified, set to the
 481 correct config, module etc, and registered into the object.
 482
 483 =item *
 484
 485 Vivified cvars for secondary classes will first try to find their base object
 486 and use that value. If no such value or cvar is found the default value from
 487 configs applies.
 488
 489 =back
 490
 491 This is useful if you need to list every possible CVar, like in CRUD masks.
 492
 493 =item C<cvar_by_name NAME [ VALUE ]>
 494
 495 Returns the CVar object for this object which matches the given internal name.
 496 Useful for print templates. If the requested cvar is not present, it will be
 497 vivified with the same rules as in C<cvars_by_config>.
 498
 499 =item C<parse_custom_variable_values>
 500
 501 When you want to edit custom variables in a form then you have
 502 unparsed values from the user. These should be written to the
 503 variable's C<unparsed_value> field.
 504
 505 This function then processes all variables and parses their
 506 C<unparsed_value> field into the proper field. It returns C<$self> for
 507 easy chaining.
 508
 509 This is automatically called in a C<before_save> hook so you don't
 510 have to do it manually if you save directly after assigning the
 511 values.
 512
 513 In an HTML form you could e.g. use something like the following:
 514
 515   [%- FOREACH var = SELF.project.cvars_by_config.as_list %]
 516     [% HTML.escape(var.config.description) %]:
 517     [% L.hidden_tag('project.custom_variables[+].config_id', var.config.id) %]
 518     [% PROCESS 'common/render_cvar_input.html' var_name='project.custom_variables[].unparsed_value' %]
 519   [%- END %]
 520
 521 Later in the controller when you want to save this project you don't
 522 have to do anything special:
 523
 524   my $project = SL::DB::Project->new;
 525   my $params  = $::form->{project} || {};
 526
 527   $project->assign_attributes(%{ $params });
 528
 529   $project->parse_custom_variable_values->save;
 530
 531 However, if you need access to a variable's value before saving in
 532 some way then you have to call this function manually. For example:
 533
 534   my $project = SL::DB::Project->new;
 535   my $params  = $::form->{project} || {};
 536
 537   $project->assign_attributes(%{ $params });
 538
 539   $project->parse_custom_variable_values;
 540
 541   print STDERR "CVar[0] value: " . $project->custom_variables->[0]->value . "\n";
 542
 543 =back
 544
 545 =head1 INSTALLED MANAGER METHODS
 546
 547 =over 4
 548
 549 =item Custom filter for GetModels
 550
 551 If the Manager for the calling C<SL::DB::Object> has included the helper L<SL::DB::Helper::Filtered>, a custom filter for cvars will be added to the specs, with the following syntax:
 552
 553   filter.cvar.$config_id
 554
 555 =back
 556
 557 =head1 BUGS AND CAVEATS
 558
 559 =over 4
 560
 561 =item * Conditional method export
 562
 563 Prolonged use has shown that users expect all methods to be present or none.
 564 Future versions of this will likely remove the optional aliasing.
 565
 566 =item * Semantics need to be updated
 567
 568 There are a few transitions that are currently neither supported nor well
 569 defined, most of them happening when the config of a cvar gets changed, but
 570 whose instances have already been saved. This needs to be cleaned up.
 571
 572 =back
 573
 574 =head1 AUTHOR
 575
 576 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>,
 577 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 578
 579 =cut