Neuer Subtest in 002goodperl.t: .pl und .pm Dateien sollen keine HTML Tags enthalten.
[kivitendo-erp.git] / SL / CVar.pm
1 package CVar;
2
3 use strict;
4
5 use List::Util qw(first);
6 use Data::Dumper;
7
8 use SL::DBUtils;
9 use SL::MoreCommon qw(listify);
10
11 sub get_configs {
12   $main::lxdebug->enter_sub();
13
14   my $self     = shift;
15   my %params   = @_;
16
17   my $myconfig = \%main::myconfig;
18   my $form     = $main::form;
19
20   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
21
22   my ($where, @values);
23   if ($params{module}) {
24     $where = 'WHERE module = ?';
25     push @values, $params{module};
26   }
27
28   my $query    = qq|SELECT * FROM custom_variable_configs $where ORDER BY sortkey|;
29
30   my $configs  = selectall_hashref_query($form, $dbh, $query, @values);
31
32   foreach my $config (@{ $configs }) {
33     if ($config->{type} eq 'select') {
34       $config->{OPTIONS} = [ map { { 'value' => $_ } } split(m/\#\#/, $config->{options}) ];
35
36     } elsif ($config->{type} eq 'number') {
37       $config->{precision} = $1 if ($config->{options} =~ m/precision=(\d+)/i);
38
39     }
40
41     $self->_unpack_flags($config);
42   }
43
44   $main::lxdebug->leave_sub();
45
46   return $configs;
47 }
48
49 sub get_config {
50   $main::lxdebug->enter_sub();
51
52   my $self     = shift;
53   my %params   = @_;
54
55   Common::check_params(\%params, qw(id));
56
57   my $myconfig = \%main::myconfig;
58   my $form     = $main::form;
59
60   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
61
62   my $query    = qq|SELECT * FROM custom_variable_configs WHERE id = ?|;
63
64   my $config   = selectfirst_hashref_query($form, $dbh, $query, conv_i($params{id})) || { };
65
66   $self->_unpack_flags($config);
67
68   $main::lxdebug->leave_sub();
69
70   return $config;
71 }
72
73 sub _unpack_flags {
74   $main::lxdebug->enter_sub();
75
76   my $self   = shift;
77   my $config = shift;
78
79   foreach my $flag (split m/:/, $config->{flags}) {
80     if ($flag =~ m/(.*?)=(.*)/) {
81       $config->{"flag_${1}"}    = $2;
82     } else {
83       $config->{"flag_${flag}"} = 1;
84     }
85   }
86
87   $main::lxdebug->leave_sub();
88 }
89
90 sub save_config {
91   $main::lxdebug->enter_sub();
92
93   my $self     = shift;
94   my %params   = @_;
95
96   Common::check_params(\%params, qw(module config));
97
98   my $myconfig = \%main::myconfig;
99   my $form     = $main::form;
100
101   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
102
103   my $q_id     = qq|SELECT nextval('custom_variable_configs_id')|;
104   my $h_id     = prepare_query($form, $dbh, $q_id);
105
106   my $q_new    =
107     qq|INSERT INTO custom_variable_configs (name, description, type, default_value, options, searchable, includeable, included_by_default, module, flags, id, sortkey)
108        VALUES                              (?,    ?,           ?,    ?,             ?,       ?,          ?,           ?,                   ?,      ?,     ?,
109          (SELECT COALESCE(MAX(sortkey) + 1, 1) FROM custom_variable_configs))|;
110   my $h_new    = prepare_query($form, $dbh, $q_new);
111
112   my $q_update =
113     qq|UPDATE custom_variable_configs SET
114          name        = ?, description         = ?,
115          type        = ?, default_value       = ?,
116          options     = ?, searchable          = ?,
117          includeable = ?, included_by_default = ?,
118          module      = ?, flags               = ?
119        WHERE id  = ?|;
120   my $h_update = prepare_query($form, $dbh, $q_update);
121
122   my @configs;
123   if ('ARRAY' eq ref $params{config}) {
124     @configs = @{ $params{config} };
125   } else {
126     @configs = ($params{config});
127   }
128
129   foreach my $config (@configs) {
130     my ($h_actual, $q_actual);
131
132     if (!$config->{id}) {
133       do_statement($form, $h_id, $q_id);
134       ($config->{id}) = $h_id->fetchrow_array();
135
136       $h_actual       = $h_new;
137       $q_actual       = $q_new;
138
139     } else {
140       $h_actual       = $h_update;
141       $q_actual       = $q_update;
142     }
143
144     do_statement($form, $h_actual, $q_actual, @{$config}{qw(name description type default_value options)},
145                  $config->{searchable} ? 't' : 'f', $config->{includeable} ? 't' : 'f', $config->{included_by_default} ? 't' : 'f',
146                  $params{module}, $config->{flags}, conv_i($config->{id}));
147   }
148
149   $h_id->finish();
150   $h_new->finish();
151   $h_update->finish();
152
153   $dbh->commit();
154
155   $main::lxdebug->leave_sub();
156 }
157
158 sub delete_config {
159   $main::lxdebug->enter_sub();
160
161   my $self     = shift;
162   my %params   = @_;
163
164   Common::check_params(\%params, qw(id));
165
166   my $myconfig = \%main::myconfig;
167   my $form     = $main::form;
168
169   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
170
171   do_query($form, $dbh, qq|DELETE FROM custom_variables        WHERE config_id = ?|, conv_i($params{id}));
172   do_query($form, $dbh, qq|DELETE FROM custom_variable_configs WHERE id        = ?|, conv_i($params{id}));
173
174   $dbh->commit();
175
176   $main::lxdebug->leave_sub();
177 }
178
179 sub get_custom_variables {
180   $main::lxdebug->enter_sub();
181
182   my $self     = shift;
183   my %params   = @_;
184
185   Common::check_params(\%params, qw(module));
186
187   my $myconfig = \%main::myconfig;
188   my $form     = $main::form;
189
190   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
191
192   my $trans_id = $params{trans_id} ? 'OR (v.trans_id = ?) ' : '';
193
194   my $q_cfg    =
195     qq|SELECT id, name, description, type, default_value, options,
196          date_trunc('seconds', localtimestamp) AS current_timestamp, current_date AS current_date
197        FROM custom_variable_configs
198        WHERE module = ?
199        ORDER BY sortkey|;
200
201   my $q_var    =
202     qq|SELECT text_value, timestamp_value, timestamp_value::date AS date_value, number_value, bool_value
203        FROM custom_variables
204        WHERE (config_id = ?) AND (trans_id = ?)|;
205   $q_var      .= qq| AND (sub_module = ?)| if $params{sub_module};
206   my $h_var    = prepare_query($form, $dbh, $q_var);
207
208   my $custom_variables = selectall_hashref_query($form, $dbh, $q_cfg, $params{module});
209
210   foreach my $cvar (@{ $custom_variables }) {
211     if ($cvar->{type} eq 'textfield') {
212       $cvar->{width}  = 30;
213       $cvar->{height} =  5;
214
215       $cvar->{width}  = $1 if ($cvar->{options} =~ m/width=(\d+)/i);
216       $cvar->{height} = $1 if ($cvar->{options} =~ m/height=(\d+)/i);
217
218     } elsif ($cvar->{type} eq 'text') {
219       $cvar->{maxlength} = $1 if ($cvar->{options} =~ m/maxlength=(\d+)/i);
220
221     } elsif ($cvar->{type} eq 'number') {
222       $cvar->{precision} = $1 if ($cvar->{options} =~ m/precision=(\d+)/i);
223
224     } elsif ($cvar->{type} eq 'select') {
225       $cvar->{OPTIONS} = [ map { { 'value' => $_ } } split(m/\#\#/, $cvar->{options}) ];
226     }
227
228     my $act_var;
229     if ($params{trans_id}) {
230       my @values = (conv_i($cvar->{id}), conv_i($params{trans_id}));
231       push @values, $params{sub_module} if $params{sub_module};
232
233       do_statement($form, $h_var, $q_var, @values);
234       $act_var = $h_var->fetchrow_hashref();
235
236       $act_var->{valid} = $self->get_custom_variables_validity(config_id => $cvar->{id}, trans_id => $params{trans_id});
237     }
238
239     if ($act_var) {
240       $cvar->{value} = $cvar->{type} eq 'date'      ? $act_var->{date_value}
241                      : $cvar->{type} eq 'timestamp' ? $act_var->{timestamp_value}
242                      : $cvar->{type} eq 'number'    ? $act_var->{number_value}
243                      : $cvar->{type} eq 'bool'      ? $act_var->{bool_value}
244                      :                                $act_var->{text_value};
245       $cvar->{valid} = $act_var->{valid};
246     } else {
247       $cvar->{valid}  =  1;
248
249       if ($cvar->{type} eq 'date') {
250         if ($cvar->{default_value} eq 'NOW') {
251           $cvar->{value} = $cvar->{current_date};
252         } else {
253           $cvar->{value} = $cvar->{default_value};
254         }
255
256       } elsif ($cvar->{type} eq 'timestamp') {
257         if ($cvar->{default_value} eq 'NOW') {
258           $cvar->{value} = $cvar->{current_timestamp};
259         } else {
260           $cvar->{value} = $cvar->{default_value};
261         }
262
263       } elsif ($cvar->{type} eq 'bool') {
264         $cvar->{value} = $cvar->{default_value} * 1;
265
266       } elsif ($cvar->{type} eq 'number') {
267         $cvar->{value} = $cvar->{default_value} * 1 if ($cvar->{default_value} ne '');
268
269       } else {
270         $cvar->{value} = $cvar->{default_value};
271       }
272     }
273
274     if ($cvar->{type} eq 'number') {
275       $cvar->{value} = $form->format_amount($myconfig, $cvar->{value} * 1, $cvar->{precision});
276     }
277   }
278
279   $h_var->finish();
280
281   $main::lxdebug->leave_sub();
282
283   return $custom_variables;
284 }
285
286 sub save_custom_variables {
287   $main::lxdebug->enter_sub();
288
289   my $self     = shift;
290   my %params   = @_;
291
292   Common::check_params(\%params, qw(module trans_id variables));
293
294   my $myconfig = \%main::myconfig;
295   my $form     = $main::form;
296
297   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
298
299   my @configs  = $params{configs} ? @{ $params{configs} } : grep { $_->{module} eq $params{module} } @{ CVar->get_configs() };
300
301   my $query    =
302     qq|DELETE FROM custom_variables
303        WHERE (trans_id  = ?)
304          AND (config_id IN (SELECT DISTINCT id
305                             FROM custom_variable_configs
306                             WHERE module = ?))|;
307   my @values   = (conv_i($params{trans_id}), $params{module});
308
309   if ($params{sub_module}) {
310     $query .= qq| AND (sub_module = ?)|;
311     push @values, $params{sub_module};
312   }
313
314   do_query($form, $dbh, $query, @values);
315
316   $query  =
317     qq|INSERT INTO custom_variables (config_id, sub_module, trans_id, bool_value, timestamp_value, text_value, number_value)
318        VALUES                       (?,         ?,          ?,        ?,          ?,               ?,          ?)|;
319   my $sth = prepare_query($form, $dbh, $query);
320
321   foreach my $config (@configs) {
322     my @values = (conv_i($config->{id}), "$params{sub_module}", conv_i($params{trans_id}));
323
324     my $value  = $params{variables}->{"$params{name_prefix}cvar_$config->{name}$params{name_postfix}"};
325
326     if (($config->{type} eq 'text') || ($config->{type} eq 'textfield') || ($config->{type} eq 'select')) {
327       push @values, undef, undef, $value, undef;
328
329     } elsif (($config->{type} eq 'date') || ($config->{type} eq 'timestamp')) {
330       push @values, undef, conv_date($value), undef, undef;
331
332     } elsif ($config->{type} eq 'number') {
333       push @values, undef, undef, undef, conv_i($form->parse_amount($myconfig, $value));
334
335     } elsif ($config->{type} eq 'bool') {
336       push @values, $value ? 't' : 'f', undef, undef, undef;
337     }
338
339     do_statement($form, $sth, $query, @values);
340
341     unless ($params{always_valid}) {
342       $self->save_custom_variables_validity(trans_id => $params{trans_id}, config_id => $config->{id},
343         validity => ($params{variables}->{"$params{name_prefix}cvar_$config->{name}$params{name_postfix}_valid"} ? 1 : 0)
344       );
345     };
346   }
347
348   $sth->finish();
349
350   $dbh->commit();
351
352   $main::lxdebug->leave_sub();
353 }
354
355 sub render_inputs {
356   $main::lxdebug->enter_sub(2);
357
358   my $self     = shift;
359   my %params   = @_;
360
361   Common::check_params(\%params, qw(variables));
362
363   my $myconfig = \%main::myconfig;
364   my $form     = $main::form;
365
366   my %options  = ( name_prefix       => "$params{name_prefix}",
367                    name_postfix      => "$params{name_postfix}",
368                    hide_non_editable => $params{hide_non_editable},
369                    show_disabled_message => $params{show_disabled_message},
370                  );
371
372   foreach my $var (@{ $params{variables} }) {
373     $var->{HTML_CODE} = $form->parse_html_template('amcvar/render_inputs',     { var => $var, %options });
374     $var->{VALID_BOX} = $form->parse_html_template('amcvar/render_checkboxes', { var => $var, %options });
375   }
376
377   $main::lxdebug->leave_sub(2);
378 }
379
380 sub render_search_options {
381   $main::lxdebug->enter_sub();
382
383   my $self     = shift;
384   my %params   = @_;
385
386   Common::check_params(\%params, qw(variables));
387
388   my $myconfig = \%main::myconfig;
389   my $form     = $main::form;
390
391   $params{hidden_cvar_filters} = $myconfig->{hide_cvar_search_options};
392
393   $params{include_prefix}   = 'l_' unless defined($params{include_prefix});
394   $params{include_value}  ||= '1';
395
396   my $filter  = $form->parse_html_template('amcvar/search_filter',  \%params);
397   my $include = $form->parse_html_template('amcvar/search_include', \%params);
398
399   $main::lxdebug->leave_sub();
400
401   return ($filter, $include);
402 }
403
404 sub build_filter_query {
405   $main::lxdebug->enter_sub();
406
407   my $self     = shift;
408   my %params   = @_;
409
410   Common::check_params(\%params, qw(module trans_id_field filter));
411
412   my $myconfig = \%main::myconfig;
413   my $form     = $main::form;
414
415   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
416
417   my $configs  = $self->get_configs(%params);
418
419   my (@where, @values);
420
421   foreach my $config (@{ $configs }) {
422     next unless ($config->{searchable});
423
424     my $name = "cvar_$config->{name}";
425
426     my (@sub_values, @sub_where, $not);
427
428     if (($config->{type} eq 'text') || ($config->{type} eq 'textfield')) {
429       next unless ($params{filter}->{$name});
430
431       push @sub_where,  qq|cvar.text_value ILIKE ?|;
432       push @sub_values, '%' . $params{filter}->{$name} . '%'
433
434     } elsif ($config->{type} eq 'select') {
435       next unless ($params{filter}->{$name});
436
437       push @sub_where,  qq|cvar.text_value = ?|;
438       push @sub_values, $params{filter}->{$name};
439
440     } elsif (($config->{type} eq 'date') || ($config->{type} eq 'timestamp')) {
441       my $name_from = "${name}_from";
442       my $name_to   = "${name}_to";
443
444       if ($params{filter}->{$name_from}) {
445         push @sub_where,  qq|cvar.timestamp_value >= ?|;
446         push @sub_values, conv_date($params{filter}->{$name_from});
447       }
448
449       if ($params{filter}->{$name_to}) {
450         push @sub_where,  qq|cvar.timestamp_value <= ?|;
451         push @sub_values, conv_date($params{filter}->{$name_to});
452       }
453
454     } elsif ($config->{type} eq 'number') {
455       next if ($params{filter}->{$name} eq '');
456
457       my $f_op = $params{filter}->{"${name}_qtyop"};
458
459       my $op;
460       if ($f_op eq '==') {
461         $op  = '=';
462
463       } elsif ($f_op eq '=/=') {
464         $not = 'NOT';
465         $op  = '<>';
466
467       } elsif ($f_op eq '<') {
468         $not = 'NOT';
469         $op  = '>=';
470
471       } elsif ($f_op eq '<=') {
472         $not = 'NOT';
473         $op  = '>';
474
475       } elsif (($f_op eq '>') || ($f_op eq '>=')) {
476         $op  = $f_op;
477
478       } else {
479         $op  = '=';
480       }
481
482       push @sub_where,  qq|cvar.number_value $op ?|;
483       push @sub_values, $form->parse_amount($myconfig, $params{filter}->{$name});
484
485     } elsif ($config->{type} eq 'bool') {
486       next unless ($params{filter}->{$name});
487
488       $not = 'NOT' if ($params{filter}->{$name} eq 'no');
489       push @sub_where,  qq|COALESCE(cvar.bool_value, false) = TRUE|;
490     }
491
492     if (@sub_where) {
493       push @sub_where,  qq|cvar.sub_module = ?|;
494       push @sub_values, "$params{sub_module}";
495
496       push @where,
497         qq|$not EXISTS(
498              SELECT cvar.id
499              FROM custom_variables cvar
500              LEFT JOIN custom_variable_configs cvarcfg ON (cvar.config_id = cvarcfg.id)
501              WHERE (cvarcfg.module = ?)
502                AND (cvarcfg.id     = ?)
503                AND (cvar.trans_id  = $params{trans_id_field})
504                AND | . join(' AND ', map { "($_)" } @sub_where) . qq|)|;
505       push @values, $params{module}, conv_i($config->{id}), @sub_values;
506     }
507   }
508
509   my $query = join ' AND ', @where;
510
511   $main::lxdebug->leave_sub();
512
513   return ($query, @values);
514 }
515
516 sub add_custom_variables_to_report {
517   $main::lxdebug->enter_sub();
518
519   my $self      = shift;
520   my %params    = @_;
521
522   Common::check_params(\%params, qw(module trans_id_field column_defs data configs));
523
524   my $myconfig  = \%main::myconfig;
525   my $form      = $main::form;
526   my $locale    = $main::locale;
527
528   my $dbh       = $params{dbh} || $form->get_standard_dbh($myconfig);
529
530   my $configs   = [ grep { $_->{includeable} && $params{column_defs}->{"cvar_$_->{name}"}->{visible} } @{ $params{configs} } ];
531
532   if (!scalar(@{ $params{data} }) || ! scalar(@{ $configs })) {
533     $main::lxdebug->leave_sub();
534     return;
535   }
536
537   # allow sub_module to be a coderef or a fixed value
538   if (ref $params{sub_module} ne 'CODE') {
539     my $sub_module = "$params{sub_module}";
540     $params{sub_module} = sub { $sub_module };
541   }
542
543   my %cfg_map   = map { $_->{id} => $_ } @{ $configs };
544   my @cfg_ids   = keys %cfg_map;
545
546   my $query     =
547     qq|SELECT text_value, timestamp_value, timestamp_value::date AS date_value, number_value, bool_value, config_id
548        FROM custom_variables
549        WHERE (config_id IN (| . join(', ', ('?') x scalar(@cfg_ids)) . qq|))
550          AND (trans_id = ?)
551          AND (sub_module = ?)|;
552   my $sth       = prepare_query($form, $dbh, $query);
553
554   foreach my $row (@{ $params{data} }) {
555     do_statement($form, $sth, $query, @cfg_ids, conv_i($row->{$params{trans_id_field}}), $params{sub_module}->($row));
556
557     while (my $ref = $sth->fetchrow_hashref()) {
558       my $cfg = $cfg_map{$ref->{config_id}};
559
560       $row->{"cvar_$cfg->{name}"} =
561           $cfg->{type} eq 'date'      ? $ref->{date_value}
562         : $cfg->{type} eq 'timestamp' ? $ref->{timestamp_value}
563         : $cfg->{type} eq 'number'    ? $form->format_amount($myconfig, $ref->{number_value} * 1, $cfg->{precision})
564         : $cfg->{type} eq 'bool'      ? ($ref->{bool_value} ? $locale->text('Yes') : $locale->text('No'))
565         :                               $ref->{text_value};
566     }
567   }
568
569   $sth->finish();
570
571   $main::lxdebug->leave_sub();
572 }
573
574 sub get_field_format_list {
575   $main::lxdebug->enter_sub();
576
577   my $self          = shift;
578   my %params        = @_;
579
580   Common::check_params(\%params, qw(module));
581
582   my $myconfig      = \%main::myconfig;
583   my $form          = $main::form;
584
585   my $dbh           = $params{dbh} || $form->get_standard_dbh($myconfig);
586
587   my $configs       = $self->get_configs(%params);
588
589   my $date_fields   = [];
590   my $number_fields = {};
591
592   foreach my $config (@{ $configs }) {
593     my $name = "$params{prefix}cvar_$config->{name}";
594
595     if ($config->{type} eq 'date') {
596       push @{ $date_fields }, $name;
597
598     } elsif ($config->{type} eq 'number') {
599       $number_fields->{$config->{precision}} ||= [];
600       push @{ $number_fields->{$config->{precision}} }, $name;
601     }
602   }
603
604   $main::lxdebug->leave_sub();
605
606   return ($date_fields, $number_fields);
607 }
608
609 =head2 VALIDITY
610
611 Suppose the following scenario:
612
613 You have a lot of parts in your database, and a set of properties cofigured. Now not every part has every of these properties, some combinations will just make no sense. In order to clean up your inputs a bit, you want to mark certain combinations as invalid, blocking them from modification and possibly display.
614
615 Validity is assumed. If you modify validity, you actually save B<invalidity>.
616 iNvalidity is saved as a function of config_id, and the trans_id
617
618 In the naive way, disable an attribute for a specific id (simple)
619
620 =cut
621 sub save_custom_variables_validity {
622   $main::lxdebug->enter_sub();
623
624   my $self     = shift;
625   my %params   = @_;
626
627   Common::check_params(\%params, qw(config_id trans_id validity));
628
629   my $myconfig = \%main::myconfig;
630   my $form     = $main::form;
631
632   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
633
634   my (@where, @values);
635   add_token(\@where, \@values, col => "config_id", val => $params{config_id}, esc => \&conv_i);
636   add_token(\@where, \@values, col => "trans_id",  val => $params{trans_id},  esc => \&conv_i);
637
638   my $where = scalar @where ? "WHERE " . join ' AND ', @where : '';
639   my $query = qq|DELETE FROM custom_variables_validity $where|;
640
641   do_query($form, $dbh, $query, @values);
642
643   $query  =
644     qq|INSERT INTO custom_variables_validity (config_id, trans_id)
645        VALUES                                (?,         ?       )|;
646   my $sth = prepare_query($form, $dbh, $query);
647
648   unless ($params{validity}) {
649     foreach my $config_id (listify $params{config_id}) {
650       foreach my $trans_id (listify $params{trans_id}) {
651         do_statement($form, $sth, $query, conv_i($config_id), conv_i($trans_id));
652       }
653     }
654   }
655
656   $sth->finish();
657
658   $dbh->commit();
659
660   $main::lxdebug->leave_sub();
661 }
662
663 sub get_custom_variables_validity {
664   $main::lxdebug->enter_sub(2);
665
666   my $self     = shift;
667   my %params   = @_;
668
669   Common::check_params(\%params, qw(config_id trans_id));
670
671   my $myconfig = \%main::myconfig;
672   my $form     = $main::form;
673
674   my $dbh      = $params{dbh} || $form->get_standard_dbh($myconfig);
675
676   my $query    = qq|SELECT COUNT(*) FROM custom_variables_validity WHERE config_id = ? AND trans_id = ?|;
677
678   my ($invalid) = selectfirst_array_query($form, $dbh, $query, conv_i($params{config_id}), conv_i($params{trans_id}));
679
680   $main::lxdebug->leave_sub(2);
681
682   return !$invalid;
683 }
684
685 1;