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