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