L/P.select_tag: Unterstützung für Text-Filter
[kivitendo-erp.git] / SL / Presenter / Tag.pm
1 package SL::Presenter::Tag;
2
3 use strict;
4
5 use SL::HTML::Restrict;
6 use SL::Presenter::EscapedText qw(escape);
7 use Scalar::Util qw(blessed);
8
9 use Exporter qw(import);
10 our @EXPORT_OK = qw(
11   html_tag input_tag hidden_tag javascript man_days_tag name_to_id select_tag
12   checkbox_tag button_tag submit_tag ajax_submit_tag input_number_tag
13   stringify_attributes restricted_html textarea_tag link_tag date_tag
14   div_tag);
15 our %EXPORT_TAGS = (ALL => \@EXPORT_OK);
16
17 use Carp;
18
19 my %_valueless_attributes = map { $_ => 1 } qw(
20   checked compact declare defer disabled ismap multiple noresize noshade nowrap
21   readonly selected hidden
22 );
23
24 my %_singleton_tags = map { $_ => 1 } qw(
25   area base br col command embed hr img input keygen link meta param source
26   track wbr
27 );
28
29 sub _call_on {
30   my ($object, $method, @params) = @_;
31   return $object->$method(@params);
32 }
33
34 { # This will give you an id for identifying html tags and such.
35   # It's guaranteed to be unique unless you exceed 10 mio calls per request.
36   # Do not use these id's to store information across requests.
37 my $_id_sequence = int rand 1e7;
38 sub _id {
39   return ( $_id_sequence = ($_id_sequence + 1) % 1e7 );
40 }
41 }
42
43 sub _J {
44   my $string = shift;
45   $string    =~ s/(\"|\'|\\)/\\$1/g;
46   return $string;
47 }
48
49 sub stringify_attributes {
50   my (%params) = @_;
51
52   my @result = ();
53   while (my ($name, $value) = each %params) {
54     next unless $name;
55     next if $_valueless_attributes{$name} && !$value;
56     $value = '' if !defined($value);
57     push @result, $_valueless_attributes{$name} ? escape($name) : escape($name) . '="' . escape($value) . '"';
58   }
59
60   return @result ? ' ' . join(' ', @result) : '';
61 }
62
63 sub html_tag {
64   my ($tag, $content, %params) = @_;
65   my $attributes = stringify_attributes(%params);
66
67   return "<${tag}${attributes}>" if !defined($content) && $_singleton_tags{$tag};
68   return "<${tag}${attributes}>${content}</${tag}>";
69 }
70
71 sub input_tag {
72   my ($name, $value, %attributes) = @_;
73
74   _set_id_attribute(\%attributes, $name);
75   $attributes{type} ||= 'text';
76
77   html_tag('input', undef, %attributes, name => $name, value => $value);
78 }
79
80 sub hidden_tag {
81   my ($name, $value, %attributes) = @_;
82   input_tag($name, $value, %attributes, type => 'hidden');
83 }
84
85 sub man_days_tag {
86   my ($name, $object, %attributes) = @_;
87
88   my $size           =  delete($attributes{size})   || 5;
89   my $method         =  $name;
90   $method            =~ s/^.*\.//;
91
92   my $time_selection = input_tag("${name}_as_man_days_string", _call_on($object, "${method}_as_man_days_string"), %attributes, size => $size);
93   my $unit_selection = select_tag("${name}_as_man_days_unit",   [[ 'h', $::locale->text('h') ], [ 'man_day', $::locale->text('MD') ]],
94                                           %attributes, default => _call_on($object, "${method}_as_man_days_unit"));
95
96   return $time_selection . $unit_selection;
97 }
98
99 sub name_to_id {
100   my ($name) = @_;
101
102   $name =~ s/\[\+?\]/ _id() /ge; # give constructs with [] or [+] unique ids
103   $name =~ s/[^\w_]/_/g;
104   $name =~ s/_+/_/g;
105
106   return $name;
107 }
108
109 sub select_tag {
110   my ($name, $collection, %attributes) = @_;
111
112   _set_id_attribute(\%attributes, $name);
113
114   $collection         = [] if defined($collection) && !ref($collection) && ($collection eq '');
115
116   my $with_filter     = delete($attributes{with_filter});
117   my $fil_placeholder = delete($attributes{filter_placeholder});
118   my $value_key       = delete($attributes{value_key})   || 'id';
119   my $title_key       = delete($attributes{title_key})   || $value_key;
120   my $default_key     = delete($attributes{default_key}) || 'selected';
121   my $default_val_key = delete($attributes{default_value_key});
122   my $default_coll    = delete($attributes{default});
123
124   my $value_title_sub = delete($attributes{value_title_sub});
125
126   my $value_sub       = delete($attributes{value_sub});
127   my $title_sub       = delete($attributes{title_sub});
128   my $default_sub     = delete($attributes{default_sub});
129
130   my $with_empty      = delete($attributes{with_empty});
131   my $empty_title     = delete($attributes{empty_title});
132
133   my $with_optgroups  = delete($attributes{with_optgroups});
134
135   undef $default_key if $default_sub || $default_val_key;
136
137   my $normalize_entry = sub {
138     my ($type, $entry, $sub, $key) = @_;
139
140     return $sub->($entry) if $sub;
141
142     my $ref = ref($entry);
143
144     if ( !$ref ) {
145       return $entry if $type eq 'value' || $type eq 'title';
146       return 0;
147     }
148
149     if ( $ref eq 'ARRAY' ) {
150       return $entry->[ $type eq 'value' ? 0 : $type eq 'title' ? 1 : 2 ];
151     }
152
153     return $entry->{$key} if $ref  eq 'HASH';
154     return $entry->$key   if $type ne 'default' || $entry->can($key);
155     return undef;
156   };
157
158   my %selected;
159   if (defined($default_coll) && !ref $default_coll) {
160     %selected = ($default_coll => 1);
161
162   } elsif (ref($default_coll) eq 'HASH') {
163     %selected = %{ $default_coll };
164
165   } elsif ($default_coll) {
166     $default_coll = [ $default_coll ] unless 'ARRAY' eq ref $default_coll;
167
168     %selected = $default_val_key ? map({ ($normalize_entry->('value', $_, undef, $default_val_key) => 1) } @{ $default_coll })
169               :                    map({ ($_                                                       => 1) } @{ $default_coll });
170   }
171
172   my $list_to_code = sub {
173     my ($sub_collection) = @_;
174
175     if ('ARRAY' ne ref $sub_collection) {
176       $sub_collection = [ $sub_collection ];
177     }
178
179     my @options;
180     foreach my $entry ( @{ $sub_collection } ) {
181       my $value;
182       my $title;
183
184       if ( $value_title_sub ) {
185         ($value, $title) = @{ $value_title_sub->($entry) };
186       } else {
187
188         $value = $normalize_entry->('value', $entry, $value_sub, $value_key);
189         $title = $normalize_entry->('title', $entry, $title_sub, $title_key);
190       }
191
192       my $default = $default_key ? $normalize_entry->('default', $entry, $default_sub, $default_key) : 0;
193
194       push(@options, [$value, $title, $selected{$value} || $default]);
195     }
196
197     return join '', map { html_tag('option', escape($_->[1]), value => $_->[0], selected => $_->[2]) } @options;
198   };
199
200   my $code  = '';
201   $code    .= html_tag('option', escape($empty_title || ''), value => '') if $with_empty;
202
203   if (!$with_optgroups) {
204     $code .= $list_to_code->($collection);
205
206   } else {
207     $code .= join '', map {
208       my ($optgroup_title, $sub_collection) = @{ $_ };
209       html_tag('optgroup', $list_to_code->($sub_collection), label => $optgroup_title)
210     } @{ $collection };
211   }
212
213   my $select_html = html_tag('select', $code, %attributes, name => $name);
214
215   if ($with_filter) {
216     my $input_style;
217
218     if (($attributes{style} // '') =~ m{width: *(\d+) *px}i) {
219       $input_style = "width: " . ($1 - 22) . "px";
220     }
221
222     my $input_html = html_tag(
223       'input', undef,
224       autocomplete     => 'off',
225       type             => 'text',
226       id               => $attributes{id} . '_filter',
227       'data-select-id' => $attributes{id},
228       (placeholder     => $fil_placeholder) x !!$fil_placeholder,
229       (style           => $input_style)     x !!$input_style,
230     );
231     $select_html = html_tag('div', $input_html . $select_html, class => "filtered_select");
232   }
233
234   return $select_html;
235 }
236
237 sub checkbox_tag {
238   my ($name, %attributes) = @_;
239
240   _set_id_attribute(\%attributes, $name);
241
242   $attributes{value}   = 1 unless defined $attributes{value};
243   my $label            = delete $attributes{label};
244   my $checkall         = delete $attributes{checkall};
245   my $for_submit       = delete $attributes{for_submit};
246
247   if ($attributes{checked}) {
248     $attributes{checked} = 'checked';
249   } else {
250     delete $attributes{checked};
251   }
252
253   my $code  = '';
254   $code    .= hidden_tag($name, 0, %attributes, id => $attributes{id} . '_hidden') if $for_submit;
255   $code    .= html_tag('input', undef,  %attributes, name => $name, type => 'checkbox');
256   $code    .= html_tag('label', $label, for => $attributes{id}) if $label;
257   $code    .= javascript(qq|\$('#$attributes{id}').checkall('$checkall');|) if $checkall;
258
259   return $code;
260 }
261
262 sub button_tag {
263   my ($onclick, $value, %attributes) = @_;
264
265   _set_id_attribute(\%attributes, $attributes{name}) if $attributes{name};
266   $attributes{type} ||= 'button';
267
268   $onclick = 'if (!confirm("'. _J(delete($attributes{confirm})) .'")) return false; ' . $onclick if $attributes{confirm};
269
270   html_tag('input', undef, %attributes, value => $value, onclick => $onclick);
271 }
272
273 sub submit_tag {
274   my ($name, $value, %attributes) = @_;
275
276   _set_id_attribute(\%attributes, $attributes{name}) if $attributes{name};
277
278   if ( $attributes{confirm} ) {
279     $attributes{onclick} = 'return confirm("'. _J(delete($attributes{confirm})) .'");';
280   }
281
282   input_tag($name, $value, %attributes, type => 'submit', class => 'submit');
283 }
284
285 sub ajax_submit_tag {
286   my ($url, $form_selector, $text, %attributes) = @_;
287
288   $url           = _J($url);
289   $form_selector = _J($form_selector);
290   my $onclick    = qq|kivi.submit_ajax_form('${url}', '${form_selector}')|;
291
292   button_tag($onclick, $text, %attributes);
293 }
294
295 sub input_number_tag {
296   my ($name, $value, %params) = @_;
297
298   _set_id_attribute(\%params, $name);
299   my @onchange = $params{onchange} ? (onChange => delete $params{onchange}) : ();
300   my @classes  = ('numeric');
301   push @classes, delete($params{class}) if $params{class};
302   my %class    = @classes ? (class => join(' ', @classes)) : ();
303
304   $::request->layout->add_javascripts('kivi.Validator.js');
305   $::request->presenter->need_reinit_widgets($params{id});
306
307   input_tag(
308     $name, $::form->format_amount(\%::myconfig, $value, $params{precision}),
309     "data-validate" => "number",
310     %params,
311     %class, @onchange,
312   );
313 }
314
315
316 sub javascript {
317   my ($data) = @_;
318   html_tag('script', $data, type => 'text/javascript');
319 }
320
321 sub _set_id_attribute {
322   my ($attributes, $name, $unique) = @_;
323
324   if (!delete($attributes->{no_id}) && !$attributes->{id}) {
325     $attributes->{id}  = name_to_id($name);
326     $attributes->{id} .= '_' . $attributes->{value} if $unique;
327   }
328
329   %{ $attributes };
330 }
331
332 my $html_restricter;
333
334 sub restricted_html {
335   my ($value) = @_;
336
337   $html_restricter ||= SL::HTML::Restrict->create;
338   return $html_restricter->process($value);
339 }
340
341 sub textarea_tag {
342   my ($name, $content, %attributes) = @_;
343
344   _set_id_attribute(\%attributes, $name);
345   $attributes{rows}  *= 1; # required by standard
346   $attributes{cols}  *= 1; # required by standard
347
348   html_tag('textarea', $content, %attributes, name => $name);
349 }
350
351 sub link_tag {
352   my ($href, $content, %params) = @_;
353
354   $href ||= '#';
355
356   html_tag('a', $content, %params, href => $href);
357 }
358 # alias for compatibility
359 sub link { goto &link_tag }
360
361 sub date_tag {
362   my ($name, $value, %params) = @_;
363
364   _set_id_attribute(\%params, $name);
365   my @onchange = $params{onchange} ? (onChange => delete $params{onchange}) : ();
366   my @classes  = $params{no_cal} || $params{readonly} ? () : ('datepicker');
367   push @classes, delete($params{class}) if $params{class};
368   my %class    = @classes ? (class => join(' ', @classes)) : ();
369
370   $::request->layout->add_javascripts('kivi.Validator.js');
371   $::request->presenter->need_reinit_widgets($params{id});
372
373   input_tag(
374     $name, blessed($value) ? $value->to_lxoffice : $value,
375     size   => 11,
376     "data-validate" => "date",
377     %params,
378     %class, @onchange,
379   );
380 }
381
382 sub div_tag {
383   my ($content, %params) = @_;
384   return html_tag('div', $content, %params);
385 }
386
387 1;
388 __END__
389
390 =pod
391
392 =encoding utf8
393
394 =head1 NAME
395
396 SL::Presenter::Tag - Layouting / tag generation
397
398 =head1 SYNOPSIS
399
400 Usage in a template:
401
402   [% USE P %]
403
404   [% P.select_tag('direction', [ [ 'left', 'To the left' ], [ 'right', 'To the right', 1 ] ]) %]
405
406   [% P.select_tag('direction', [ { direction => 'left',  display => 'To the left'  },
407                                  { direction => 'right', display => 'To the right' } ],
408                                value_key => 'direction', title_key => 'display', default => 'right') %]
409
410   [% P.select_tag('direction', [ { direction => 'left',  display => 'To the left'  },
411                                  { direction => 'right', display => 'To the right', selected => 1 } ],
412                                value_key => 'direction', title_key => 'display') %]
413
414   # Use an RDBO object and its n:m relationship as the default
415   # values. For example, a user can be a member of many groups. "All
416   # groups" is therefore the full collection and "$user->groups" is a
417   # list of RDBO AuthGroup objects whose IDs must match the ones in
418   # "All groups". This could look like the following:
419   [% P.select_tag('user.groups[]', SELF.all_groups, multiple=1,
420                   default=SELF.user.groups, default_value_key='id' ) %]
421
422 =head1 DESCRIPTION
423
424 A module modeled a bit after Rails' ActionView helpers. Several small
425 functions that create HTML tags from various kinds of data sources.
426
427 The C<id> attribute is usually calculated automatically. This can be
428 overridden by either specifying an C<id> attribute or by setting
429 C<no_id> to trueish.
430
431 =head1 FUNCTIONS
432
433 =head2 LOW-LEVEL FUNCTIONS
434
435 =over 4
436
437 =item C<html_tag $tag_name, $content_string, %attributes>
438
439 Creates an opening and closing HTML tag for C<$tag_name> and puts
440 C<$content_string> between the two. If C<$content_string> is undefined
441 or empty then only a E<lt>tag/E<gt> tag will be created. Attributes
442 are key/value pairs added to the opening tag.
443
444 C<$content_string> is not HTML escaped.
445
446 =item C<name_to_id $name>
447
448 Converts a name to a HTML id by replacing various characters.
449
450 =item C<stringify_attributes %items>
451
452 Creates a string from all elements in C<%items> suitable for usage as
453 HTML tag attributes. Keys and values are HTML escaped even though keys
454 must not contain non-ASCII characters for browsers to accept them.
455
456 =item C<restricted_html $html>
457
458 Returns HTML stripped of unknown tags. See L<SL::HTML::Restrict>.
459
460 =back
461
462 =head2 HIGH-LEVEL FUNCTIONS
463
464 =over 4
465
466 =item C<input_tag $name, $value, %attributes>
467
468 Creates a HTML 'input type=text' tag named C<$name> with the value
469 C<$value> and with arbitrary HTML attributes from C<%attributes>. The
470 tag's C<id> defaults to C<name_to_id($name)>.
471
472 =item C<submit_tag $name, $value, %attributes>
473
474 Creates a HTML 'input type=submit class=submit' tag named C<$name> with the
475 value C<$value> and with arbitrary HTML attributes from C<%attributes>. The
476 tag's C<id> defaults to C<name_to_id($name)>.
477
478 If C<$attributes{confirm}> is set then a JavaScript popup dialog will
479 be added via the C<onclick> handler asking the question given with
480 C<$attributes{confirm}>. The request is only submitted if the user
481 clicks the dialog's ok/yes button.
482
483 =item C<ajax_submit_tag $url, $form_selector, $text, %attributes>
484
485 Creates a HTML 'input type="button"' tag with a very specific onclick
486 handler that submits the form given by the jQuery selector
487 C<$form_selector> to the URL C<$url> (the actual JavaScript function
488 called for that is C<kivi.submit_ajax_form()> in
489 C<js/client_js.js>). The button's label will be C<$text>.
490
491 =item C<button_tag $onclick, $text, %attributes>
492
493 Creates a HTML 'input type="button"' tag with an onclick handler
494 C<$onclick> and a value of C<$text>. The button does not have a name
495 nor an ID by default.
496
497 If C<$attributes{confirm}> is set then a JavaScript popup dialog will
498 be prepended to the C<$onclick> handler asking the question given with
499 C<$attributes{confirm}>. The request is only submitted if the user
500 clicks the dialog's "ok/yes" button.
501
502 =item C<man_days_tag $name, $object, %attributes>
503
504 Creates two HTML inputs: a text input for entering a number and a drop
505 down box for chosing the unit (either 'man days' or 'hours').
506
507 C<$object> must be a L<Rose::DB::Object> instance using the
508 L<SL::DB::Helper::AttrDuration> helper.
509
510 C<$name> is supposed to be the name of the underlying column,
511 e.g. C<time_estimation> for an instance of
512 C<SL::DB::RequirementSpecItem>. If C<$name> has the form
513 C<prefix.method> then the full C<$name> is used for the input's base
514 names while the methods called on C<$object> are only the suffix. This
515 makes it possible to write statements like e.g.
516
517   [% P.man_days_tag("requirement_spec_item.time_estimation", SELF.item) %]
518
519 The attribute C<size> can be used to set the text input's size. It
520 defaults to 5.
521
522 =item C<hidden_tag $name, $value, %attributes>
523
524 Creates a HTML 'input type=hidden' tag named C<$name> with the value
525 C<$value> and with arbitrary HTML attributes from C<%attributes>. The
526 tag's C<id> defaults to C<name_to_id($name)>.
527
528 =item C<checkbox_tag $name, %attributes>
529
530 Creates a HTML 'input type=checkbox' tag named C<$name> with arbitrary
531 HTML attributes from C<%attributes>. The tag's C<id> defaults to
532 C<name_to_id($name)>. The tag's C<value> defaults to C<1>.
533
534 If C<%attributes> contains a key C<label> then a HTML 'label' tag is
535 created with said C<label>. No attribute named C<label> is created in
536 that case.
537
538 If C<%attributes> contains a key C<checkall> then the value is taken as a
539 JQuery selector and clicking this checkbox will also toggle all checkboxes
540 matching the selector.
541
542 =item C<select_tag $name, \@collection, %attributes>
543
544 Creates an HTML 'select' tag named C<$name> with the contents of one
545 'E<lt>optionE<gt>' tag for each element in C<\@collection> and with arbitrary
546 HTML attributes from C<%attributes>. The value
547 to use and the title to display are extracted from the elements in
548 C<\@collection>. Each element can be one of four things:
549
550 =over 12
551
552 =item 1. An array reference with at least two elements. The first element is
553 the value, the second element is its title. The third element is optional and and should contain a boolean.
554 If it is true, than the element will be used as default.
555
556 =item 2. A scalar. The scalar is both the value and the title.
557
558 =item 3. A hash reference. In this case C<%attributes> must contain
559 I<value_key>, I<title_key> and may contain I<default_key> keys that name the keys in the element to use
560 for the value, title and default respectively.
561
562 =item 4. A blessed reference. In this case C<%attributes> must contain
563 I<value_key>, I<title_key> and may contain I<default_key> keys that name functions called on the blessed
564 reference whose return values are used as the value, title and default
565 respectively.
566
567 =back
568
569 For cases 3 and 4 C<$attributes{value_key}> defaults to C<id>,
570 C<$attributes{title_key}> defaults to C<$attributes{value_key}> and
571 C<$attributes{default_key}> defaults to C<selected>. Note that
572 C<$attributes{default_key}> is set to C<undef> if
573 C<$attributes{default_value_key}> is used as well (see below).
574
575 In addition to pure keys/method you can also provide coderefs as I<value_sub>
576 and/or I<title_sub> and/or I<default_sub>. If present, these take precedence over keys or methods,
577 and are called with the element as first argument. It must return the value, title or default.
578
579 Lastly a joint coderef I<value_title_sub> may be provided, which in turn takes
580 precedence over the C<value_sub> and C<title_sub> subs. It will only be called once for each
581 element and must return a list of value and title.
582
583 If the option C<with_empty> is set then an empty element (value
584 C<undef>) will be used as the first element. The title to display for
585 this element can be set with the option C<empty_title> and defaults to
586 an empty string.
587
588 The tag's C<id> defaults to C<name_to_id($name)>.
589
590 The option C<default> can be quite a lot of things:
591
592 =over 4
593
594 =item 1. A scalar value. This is the value of the entry that's
595 selected by default.
596
597 =item 2. A hash reference for C<multiple=1>. Whether or not an entry
598 is selected by default is looked up in this hash.
599
600 =item 3. An array reference containing scalar values. Same as 1., just
601 for the case of C<multiple=1>.
602
603 =item 4. If C<default_value_key> is given: an array reference of hash
604 references. For each hash reference the value belonging to the key
605 C<default_value_key> is treated as one value to select by
606 default. Constructs a hash that's treated like 3.
607
608 =item 5. If C<default_value_key> is given: an array reference of
609 blessed objects. For each object the value returne from calling the
610 function named C<default_value_key> on the object is treated as one
611 value to select by default. Constructs a hash that's treated like 3.
612
613 =back
614
615 5. also applies to single RDBO instances (due to 'wantarray'
616 shenanigans assigning RDBO's relationships to a hash key will result
617 in a single RDBO object being assigned instead of an array reference
618 containing that single RDBO object).
619
620 If the option C<with_optgroups> is set then this function expects
621 C<\@collection> to be one level deeper. The upper-most level is
622 translated into an HTML C<optgroup> tag. So the structure becomes:
623
624 =over 4
625
626 =item 1. Array of array references. Each element in the
627 C<\@collection> is converted into an optgroup.
628
629 =item 2. The optgroup's C<label> attribute will be set to the
630 first element in the array element. The second array element is then
631 converted to a list of C<option> tags as described above.
632
633 =back
634
635 Example for use of optgroups:
636
637   # First in a controller:
638   my @collection = (
639     [ t8("First optgroup with three items"),
640       [ { id => 42, name => "item one" },
641         { id => 54, name => "second item" },
642         { id => 23, name => "and the third one" },
643       ] ],
644     [ t8("Another optgroup, with a lot of items from Rose"),
645       SL::DB::Manager::Customer->get_all_sorted ],
646   );
647
648   # Later in the template:
649   [% L.select_tag('the_selection', COLLECTION, with_optgroups=1, title_key='name') %]
650
651 =back
652
653 =head1 BUGS
654
655 Nothing here yet.
656
657 =head1 AUTHOR
658
659 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
660 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
661
662 =cut