Umstellung Form::throw_on_error auf Verwendung von Exception::Lite anstelle von Hashrefs
[kivitendo-erp.git] / SL / Template / Plugin / L.pm
1 package SL::Template::Plugin::L;
2
3 use base qw( Template::Plugin );
4 use Template::Plugin;
5 use List::MoreUtils qw(apply);
6 use List::Util qw(max);
7
8 use strict;
9
10 { # This will give you an id for identifying html tags and such.
11   # It's guaranteed to be unique unless you exceed 10 mio calls per request.
12   # Do not use these id's to store information across requests.
13 my $_id_sequence = int rand 1e7;
14 sub _tag_id {
15   return $_id_sequence = ($_id_sequence + 1) % 1e7;
16 }
17 }
18
19 sub _H {
20   my $string = shift;
21   return $::locale->quote_special_chars('HTML', $string);
22 }
23
24 sub _J {
25   my $string =  "" . shift;
26   $string    =~ s/\"/\\\"/g;
27   return $string;
28 }
29
30 sub _hashify {
31   return (@_ && (ref($_[0]) eq 'HASH')) ? %{ $_[0] } : @_;
32 }
33
34 sub new {
35   my ($class, $context, @args) = @_;
36
37   return bless {
38     CONTEXT => $context,
39   }, $class;
40 }
41
42 sub _context {
43   die 'not an accessor' if @_ > 1;
44   return $_[0]->{CONTEXT};
45 }
46
47 sub name_to_id {
48   my $self =  shift;
49   my $name =  shift;
50
51   $name    =~ s/[^\w_]/_/g;
52   $name    =~ s/_+/_/g;
53
54   return $name;
55 }
56
57 sub attributes {
58   my ($self, @slurp)    = @_;
59   my %options = _hashify(@slurp);
60
61   my @result = ();
62   while (my ($name, $value) = each %options) {
63     next unless $name;
64     next if $name eq 'disabled' && !$value;
65     $value = '' if !defined($value);
66     push @result, _H($name) . '="' . _H($value) . '"';
67   }
68
69   return @result ? ' ' . join(' ', @result) : '';
70 }
71
72 sub html_tag {
73   my ($self, $tag, $content, @slurp) = @_;
74   my $attributes = $self->attributes(@slurp);
75
76   return "<${tag}${attributes}/>" unless defined($content);
77   return "<${tag}${attributes}>${content}</${tag}>";
78 }
79
80 sub select_tag {
81   my $self            = shift;
82   my $name            = shift;
83   my $options_str     = shift;
84   my %attributes      = _hashify(@_);
85
86   $attributes{id}   ||= $self->name_to_id($name);
87   $options_str        = $self->options_for_select($options_str) if ref $options_str;
88
89   return $self->html_tag('select', $options_str, %attributes, name => $name);
90 }
91
92 sub textarea_tag {
93   my ($self, $name, $content, @slurp) = @_;
94   my %attributes      = _hashify(@slurp);
95
96   $attributes{id}   ||= $self->name_to_id($name);
97   $content            = $content ? _H($content) : '';
98
99   return $self->html_tag('textarea', $content, %attributes, name => $name);
100 }
101
102 sub checkbox_tag {
103   my ($self, $name, @slurp) = @_;
104   my %attributes       = _hashify(@slurp);
105
106   $attributes{id}    ||= $self->name_to_id($name);
107   $attributes{value}   = 1 unless defined $attributes{value};
108   my $label            = delete $attributes{label};
109
110   if ($attributes{checked}) {
111     $attributes{checked} = 'checked';
112   } else {
113     delete $attributes{checked};
114   }
115
116   my $code  = $self->html_tag('input', undef,  %attributes, name => $name, type => 'checkbox');
117   $code    .= $self->html_tag('label', $label, for => $attributes{id}) if $label;
118
119   return $code;
120 }
121
122 sub radio_button_tag {
123   my $self             = shift;
124   my $name             = shift;
125   my %attributes       = _hashify(@_);
126
127   $attributes{value}   = 1 unless defined $attributes{value};
128   $attributes{id}    ||= $self->name_to_id($name . "_" . $attributes{value});
129   my $label            = delete $attributes{label};
130
131   if ($attributes{checked}) {
132     $attributes{checked} = 'checked';
133   } else {
134     delete $attributes{checked};
135   }
136
137   my $code  = $self->html_tag('input', undef,  %attributes, name => $name, type => 'radio');
138   $code    .= $self->html_tag('label', $label, for => $attributes{id}) if $label;
139
140   return $code;
141 }
142
143 sub input_tag {
144   my ($self, $name, $value, @slurp) = @_;
145   my %attributes      = _hashify(@slurp);
146
147   $attributes{id}   ||= $self->name_to_id($name);
148   $attributes{type} ||= 'text';
149
150   return $self->html_tag('input', undef, %attributes, name => $name, value => $value);
151 }
152
153 sub hidden_tag {
154   return shift->input_tag(@_, type => 'hidden');
155 }
156
157 sub div_tag {
158   my ($self, $content, @slurp) = @_;
159   return $self->html_tag('div', $content, @slurp);
160 }
161
162 sub ul_tag {
163   my ($self, $content, @slurp) = @_;
164   return $self->html_tag('ul', $content, @slurp);
165 }
166
167 sub li_tag {
168   my ($self, $content, @slurp) = @_;
169   return $self->html_tag('li', $content, @slurp);
170 }
171
172 sub link {
173   my ($self, $href, $content, @slurp) = @_;
174   my %params = _hashify(@slurp);
175
176   $href ||= '#';
177
178   return $self->html_tag('a', $content, %params, href => $href);
179 }
180
181 sub submit_tag {
182   my ($self, $name, $value, @slurp) = @_;
183   my %attributes = _hashify(@slurp);
184
185   $attributes{onclick} = "if (confirm('" . delete($attributes{confirm}) . "')) return true; else return false;" if $attributes{confirm};
186
187   return $self->input_tag($name, $value, %attributes, type => 'submit', class => 'submit');
188 }
189
190 sub button_tag {
191   my ($self, $onclick, $value, @slurp) = @_;
192   my %attributes = _hashify(@slurp);
193
194   return $self->input_tag(undef, $value, %attributes, type => 'button', onclick => $onclick);
195 }
196
197 sub options_for_select {
198   my $self            = shift;
199   my $collection      = shift;
200   my %options         = _hashify(@_);
201
202   my $value_key       = $options{value} || 'id';
203   my $title_key       = $options{title} || $value_key;
204
205   my $value_sub       = $options{value_sub};
206   my $title_sub       = $options{title_sub};
207
208   my $value_title_sub = $options{value_title_sub};
209
210   my %selected        = map { ( $_ => 1 ) } @{ ref($options{default}) eq 'ARRAY' ? $options{default} : defined($options{default}) ? [ $options{default} ] : [] };
211
212   my $access = sub {
213     my ($element, $index, $key, $sub) = @_;
214     my $ref = ref $element;
215     return  $sub            ? $sub->($element)
216          : !$ref            ? $element
217          :  $ref eq 'ARRAY' ? $element->[$index]
218          :  $ref eq 'HASH'  ? $element->{$key}
219          :                    $element->$key;
220   };
221
222   my @elements = ();
223   push @elements, [ undef, $options{empty_title} || '' ] if $options{with_empty};
224   push @elements, map [
225     $value_title_sub ? $value_title_sub->($_) : (
226       $access->($_, 0, $value_key, $value_sub),
227       $access->($_, 1, $title_key, $title_sub),
228     )
229   ], @{ $collection } if $collection && ref $collection eq 'ARRAY';
230
231   my $code = '';
232   foreach my $result (@elements) {
233     my %attributes = ( value => $result->[0] );
234     $attributes{selected} = 'selected' if $selected{ defined($result->[0]) ? $result->[0] : '' };
235
236     $code .= $self->html_tag('option', _H($result->[1]), %attributes);
237   }
238
239   return $code;
240 }
241
242 sub javascript {
243   my ($self, $data) = @_;
244   return $self->html_tag('script', $data, type => 'text/javascript');
245 }
246
247 sub stylesheet_tag {
248   my $self = shift;
249   my $code = '';
250
251   foreach my $file (@_) {
252     $file .= '.css'        unless $file =~ m/\.css$/;
253     $file  = "css/${file}" unless $file =~ m|/|;
254
255     $code .= qq|<link rel="stylesheet" href="${file}" type="text/css" media="screen" />|;
256   }
257
258   return $code;
259 }
260
261 sub date_tag {
262   my ($self, $name, $value, @slurp) = @_;
263   my %params   = _hashify(@slurp);
264   my $name_e   = _H($name);
265   my $seq      = _tag_id();
266   my $datefmt  = apply {
267     s/d+/\%d/gi;
268     s/m+/\%m/gi;
269     s/y+/\%Y/gi;
270   } $::myconfig{"dateformat"};
271
272   $params{cal_align} ||= 'BR';
273
274   $self->input_tag($name, $value,
275     id     => $name_e,
276     size   => 11,
277     title  => _H($::myconfig{dateformat}),
278     onBlur => 'check_right_date_format(this)',
279     %params,
280   ) . ((!$params{no_cal}) ?
281   $self->html_tag('img', undef,
282     src    => 'image/calendar.png',
283     id     => "trigger$seq",
284     title  => _H($::myconfig{dateformat}),
285     %params,
286   ) .
287   $self->javascript(
288     "Calendar.setup({ inputField: '$name_e', ifFormat: '$datefmt', align: '$params{cal_align}', button: 'trigger$seq' });"
289   ) : '');
290 }
291
292 sub javascript_tag {
293   my $self = shift;
294   my $code = '';
295
296   foreach my $file (@_) {
297     $file .= '.js'        unless $file =~ m/\.js$/;
298     $file  = "js/${file}" unless $file =~ m|/|;
299
300     $code .= qq|<script type="text/javascript" src="${file}"></script>|;
301   }
302
303   return $code;
304 }
305
306 sub tabbed {
307   my ($self, $tabs, @slurp) = @_;
308   my %params   = _hashify(@slurp);
309   my $id       = $params{id} || 'tab_' . _tag_id();
310
311   $params{selected} *= 1;
312
313   die 'L.tabbed needs an arrayred of tabs for first argument'
314     unless ref $tabs eq 'ARRAY';
315
316   my (@header, @blocks);
317   for my $i (0..$#$tabs) {
318     my $tab = $tabs->[$i];
319
320     next if $tab eq '';
321
322     my $selected = $params{selected} == $i;
323     my $tab_id   = "__tab_id_$i";
324     push @header, $self->li_tag(
325       $self->link('', $tab->{name}, rel => $tab_id),
326         ($selected ? (class => 'selected') : ())
327     );
328     push @blocks, $self->div_tag($tab->{data},
329       id => $tab_id, class => 'tabcontent');
330   }
331
332   return '' unless @header;
333   return $self->ul_tag(
334     join('', @header), id => $id, class => 'shadetabs'
335   ) .
336   $self->div_tag(
337     join('', @blocks), class => 'tabcontentstyle'
338   ) .
339   $self->javascript(
340     qq|var $id = new ddtabcontent("$id");$id.setpersist(true);| .
341     qq|$id.setselectedClassTarget("link");$id.init();|
342   );
343 }
344
345 sub tab {
346   my ($self, $name, $src, @slurp) = @_;
347   my %params = _hashify(@slurp);
348
349   $params{method} ||= 'process';
350
351   return () if defined $params{if} && !$params{if};
352
353   my $data;
354   if ($params{method} eq 'raw') {
355     $data = $src;
356   } elsif ($params{method} eq 'process') {
357     $data = $self->_context->process($src, %{ $params{args} || {} });
358   } else {
359     die "unknown tag method '$params{method}'";
360   }
361
362   return () unless $data;
363
364   return +{ name => $name, data => $data };
365 }
366
367 sub areainput_tag {
368   my ($self, $name, $value, @slurp) = @_;
369   my %attributes      = _hashify(@slurp);
370
371   my $rows = delete $attributes{rows}     || 1;
372   my $min  = delete $attributes{min_rows} || 1;
373
374   return $rows > 1
375     ? $self->textarea_tag($name, $value, %attributes, rows => max $rows, $min)
376     : $self->input_tag($name, $value, %attributes);
377 }
378
379 sub multiselect2side {
380   my ($self, $id, @slurp) = @_;
381   my %params              = _hashify(@slurp);
382
383   $params{labelsx}        = "\"" . _J($params{labelsx} || $::locale->text('Available')) . "\"";
384   $params{labeldx}        = "\"" . _J($params{labeldx} || $::locale->text('Selected'))  . "\"";
385   $params{moveOptions}    = 'false';
386
387   my $vars                = join(', ', map { "${_}: " . $params{$_} } keys %params);
388   my $code                = <<EOCODE;
389 <script type="text/javascript">
390   \$().ready(function() {
391     \$('#${id}').multiselect2side({ ${vars} });
392   });
393 </script>
394 EOCODE
395
396   return $code;
397 }
398
399 sub online_help_tag {
400   my ($self, $tag, @slurp) = @_;
401   my %params               = _hashify(@slurp);
402   my $cc                   = $::myconfig{countrycode};
403   my $file                 = "doc/online/$cc/$tag.html";
404   my $text                 = $params{text} || $::locale->text('Help');
405
406   die 'malformed help tag' unless $tag =~ /^[a-zA-Z0-9_]+$/;
407   return unless -f $file;
408   return $self->html_tag('a', $text, href => $file, target => '_blank');
409 }
410
411 sub dump {
412   my $self = shift;
413   require Data::Dumper;
414   return '<pre>' . Data::Dumper::Dumper(@_) . '</pre>';
415 }
416
417 1;
418
419 __END__
420
421 =head1 NAME
422
423 SL::Templates::Plugin::L -- Layouting / tag generation
424
425 =head1 SYNOPSIS
426
427 Usage from a template:
428
429   [% USE L %]
430
431   [% L.select_tag('direction', [ [ 'left', 'To the left' ], [ 'right', 'To the right' ] ]) %]
432
433   [% L.select_tag('direction', L.options_for_select([ { direction => 'left',  display => 'To the left'  },
434                                                       { direction => 'right', display => 'To the right' } ],
435                                                     value => 'direction', title => 'display', default => 'right')) %]
436
437 =head1 DESCRIPTION
438
439 A module modeled a bit after Rails' ActionView helpers. Several small
440 functions that create HTML tags from various kinds of data sources.
441
442 =head1 FUNCTIONS
443
444 =head2 LOW-LEVEL FUNCTIONS
445
446 =over 4
447
448 =item C<name_to_id $name>
449
450 Converts a name to a HTML id by replacing various characters.
451
452 =item C<attributes %items>
453
454 Creates a string from all elements in C<%items> suitable for usage as
455 HTML tag attributes. Keys and values are HTML escaped even though keys
456 must not contain non-ASCII characters for browsers to accept them.
457
458 =item C<html_tag $tag_name, $content_string, %attributes>
459
460 Creates an opening and closing HTML tag for C<$tag_name> and puts
461 C<$content_string> between the two. If C<$content_string> is undefined
462 or empty then only a E<lt>tag/E<gt> tag will be created. Attributes
463 are key/value pairs added to the opening tag.
464
465 C<$content_string> is not HTML escaped.
466
467 =back
468
469 =head2 HIGH-LEVEL FUNCTIONS
470
471 =over 4
472
473 =item C<select_tag $name, $options_string, %attributes>
474
475 Creates a HTML 'select' tag named C<$name> with the contents
476 C<$options_string> and with arbitrary HTML attributes from
477 C<%attributes>. The tag's C<id> defaults to C<name_to_id($name)>.
478
479 The C<$options_string> is usually created by the
480 L</options_for_select> function. If C<$options_string> is an array
481 reference then it will be passed to L</options_for_select>
482 automatically.
483
484 =item C<input_tag $name, $value, %attributes>
485
486 Creates a HTML 'input type=text' tag named C<$name> with the value
487 C<$value> and with arbitrary HTML attributes from C<%attributes>. The
488 tag's C<id> defaults to C<name_to_id($name)>.
489
490 =item C<hidden_tag $name, $value, %attributes>
491
492 Creates a HTML 'input type=hidden' tag named C<$name> with the value
493 C<$value> and with arbitrary HTML attributes from C<%attributes>. The
494 tag's C<id> defaults to C<name_to_id($name)>.
495
496 =item C<submit_tag $name, $value, %attributes>
497
498 Creates a HTML 'input type=submit class=submit' tag named C<$name> with the
499 value C<$value> and with arbitrary HTML attributes from C<%attributes>. The
500 tag's C<id> defaults to C<name_to_id($name)>.
501
502 If C<$attributes{confirm}> is set then a JavaScript popup dialog will
503 be added via the C<onclick> handler asking the question given with
504 C<$attributes{confirm}>. If request is only submitted if the user
505 clicks the dialog's ok/yes button.
506
507 =item C<textarea_tag $name, $value, %attributes>
508
509 Creates a HTML 'textarea' tag named C<$name> with the content
510 C<$value> and with arbitrary HTML attributes from C<%attributes>. The
511 tag's C<id> defaults to C<name_to_id($name)>.
512
513 =item C<checkbox_tag $name, %attributes>
514
515 Creates a HTML 'input type=checkbox' tag named C<$name> with arbitrary
516 HTML attributes from C<%attributes>. The tag's C<id> defaults to
517 C<name_to_id($name)>. The tag's C<value> defaults to C<1>.
518
519 If C<%attributes> contains a key C<label> then a HTML 'label' tag is
520 created with said C<label>. No attribute named C<label> is created in
521 that case.
522
523 =item C<date_tag $name, $value, cal_align =E<gt> $align_code, %attributes>
524
525 Creates a date input field, with an attached javascript that will open a
526 calendar on click. The javascript ist by default anchoered at the bottom right
527 sight. This can be overridden with C<cal_align>, see Calendar documentation for
528 the details, usually you'll want a two letter abbreviation of the alignment.
529 Right + Bottom becomes C<BL>.
530
531 =item C<radio_button_tag $name, %attributes>
532
533 Creates a HTML 'input type=radio' tag named C<$name> with arbitrary
534 HTML attributes from C<%attributes>. The tag's C<value> defaults to
535 C<1>. The tag's C<id> defaults to C<name_to_id($name . "_" . $value)>.
536
537 If C<%attributes> contains a key C<label> then a HTML 'label' tag is
538 created with said C<label>. No attribute named C<label> is created in
539 that case.
540
541 =item C<javascript_tag $file1, $file2, $file3...>
542
543 Creates a HTML 'E<lt>script type="text/javascript" src="..."E<gt>'
544 tag for each file name parameter passed. Each file name will be
545 postfixed with '.js' if it isn't already and prefixed with 'js/' if it
546 doesn't contain a slash.
547
548 =item C<stylesheet_tag $file1, $file2, $file3...>
549
550 Creates a HTML 'E<lt>link rel="text/stylesheet" href="..."E<gt>' tag
551 for each file name parameter passed. Each file name will be postfixed
552 with '.css' if it isn't already and prefixed with 'css/' if it doesn't
553 contain a slash.
554
555 =item C<date_tag $name, $value, cal_align =E<gt> $align_code, %attributes>
556
557 Creates a date input field, with an attached javascript that will open a
558 calendar on click. The javascript ist by default anchoered at the bottom right
559 sight. This can be overridden with C<cal_align>, see Calendar documentation for
560 the details, usually you'll want a two letter abbreviation of the alignment.
561 Right + Bottom becomes C<BL>.
562
563 =item C<tabbed \@tab, %attributes>
564
565 Will create a tabbed area. The tabs should be created with the helper function
566 C<tab>. Example:
567
568   [% L.tabbed([
569     L.tab(LxERP.t8('Basic Data'),       'part/_main_tab.html'),
570     L.tab(LxERP.t8('Custom Variables'), 'part/_cvar_tab.html', if => SELF.display_cvar_tab),
571   ]) %]
572
573 An optional attribute is C<selected>, which accepts the ordinal of a tab which
574 should be selected by default.
575
576 =item C<areainput_tag $name, $content, %PARAMS>
577
578 Creates a generic input tag or textarea tag, depending on content size. The
579 mount of desired rows must be given with C<rows> parameter, Accpeted parameters
580 include C<min_rows> for rendering a minimum of rows if a textarea is displayed.
581
582 You can force input by setting rows to 1, and you can force textarea by setting
583 rows to anything >1.
584
585 =item C<multiselect2side $id, %params>
586
587 Creates a JavaScript snippet calling the jQuery function
588 C<multiselect2side> on the select control with the ID C<$id>. The
589 select itself is not created. C<%params> can contain the following
590 entries:
591
592 =over 2
593
594 =item C<labelsx>
595
596 The label of the list of available options. Defaults to the
597 translation of 'Available'.
598
599 =item C<labeldx>
600
601 The label of the list of selected options. Defaults to the
602 translation of 'Selected'.
603
604 =back
605
606 =item C<dump REF>
607
608 Dumps the Argument using L<Data::Dumper> into a E<lt>preE<gt> block.
609
610 =back
611
612 =head2 CONVERSION FUNCTIONS
613
614 =over 4
615
616 =item C<options_for_select \@collection, %options>
617
618 Creates a string suitable for a HTML 'select' tag consisting of one
619 'E<lt>optionE<gt>' tag for each element in C<\@collection>. The value
620 to use and the title to display are extracted from the elements in
621 C<\@collection>. Each element can be one of four things:
622
623 =over 12
624
625 =item 1. An array reference with at least two elements. The first element is
626 the value, the second element is its title.
627
628 =item 2. A scalar. The scalar is both the value and the title.
629
630 =item 3. A hash reference. In this case C<%options> must contain
631 I<value> and I<title> keys that name the keys in the element to use
632 for the value and title respectively.
633
634 =item 4. A blessed reference. In this case C<%options> must contain
635 I<value> and I<title> keys that name functions called on the blessed
636 reference whose return values are used as the value and title
637 respectively.
638
639 =back
640
641 For cases 3 and 4 C<$options{value}> defaults to C<id> and
642 C<$options{title}> defaults to C<$options{value}>.
643
644 In addition to pure keys/method you can also provide coderefs as I<value_sub>
645 and/or I<title_sub>. If present, these take precedence over keys or methods,
646 and are called with the element as first argument. It must return the value or
647 title.
648
649 Lastly a joint coderef I<value_title_sub> may be provided, which in turn takes
650 precedence over each individual sub. It will only be called once for each
651 element and must return a list of value and title.
652
653 If the option C<with_empty> is set then an empty element (value
654 C<undef>) will be used as the first element. The title to display for
655 this element can be set with the option C<empty_title> and defaults to
656 an empty string.
657
658 The option C<default> can be either a scalar or an array reference
659 containing the values of the options which should be set to be
660 selected.
661
662 =item C<tab, description, target, %PARAMS>
663
664 Creates a tab for C<tabbed>. The description will be used as displayed name.
665 The target should be a block or template that can be processed. C<tab> supports
666 a C<method> parameter, which can override the process method to apply target.
667 C<method => 'raw'> will just include the given text as is. I was too lazy to
668 implement C<include> properly.
669
670 Also an C<if> attribute is supported, so that tabs can be suppressed based on
671 some occasion. In this case the supplied block won't even get processed, and
672 the resulting tab will get ignored by C<tabbed>:
673
674   L.tab('Awesome tab wih much info', '_much_info.html', if => SELF.wants_all)
675
676 =back
677
678 =head1 MODULE AUTHORS
679
680 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
681
682 L<http://linet-services.de>