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