1 package SL::Presenter::Tag;
5 use SL::HTML::Restrict;
6 use SL::Presenter::EscapedText qw(escape);
8 use Exporter qw(import);
10 html_tag input_tag hidden_tag javascript man_days_tag name_to_id select_tag
11 checkbox_tag button_tag submit_tag ajax_submit_tag input_number_tag
12 stringify_attributes restricted_html textarea_tag link
14 our %EXPORT_TAGS = (ALL => \@EXPORT_OK);
18 my %_valueless_attributes = map { $_ => 1 } qw(
19 checked compact declare defer disabled ismap multiple noresize noshade nowrap
20 readonly selected hidden
23 my %_singleton_tags = map { $_ => 1 } qw(
24 area base br col command embed hr img input keygen link meta param source
29 my ($object, $method, @params) = @_;
30 return $object->$method(@params);
33 { # This will give you an id for identifying html tags and such.
34 # It's guaranteed to be unique unless you exceed 10 mio calls per request.
35 # Do not use these id's to store information across requests.
36 my $_id_sequence = int rand 1e7;
38 return ( $_id_sequence = ($_id_sequence + 1) % 1e7 );
44 $string =~ s/(\"|\'|\\)/\\$1/g;
48 sub stringify_attributes {
52 while (my ($name, $value) = each %params) {
54 next if $_valueless_attributes{$name} && !$value;
55 $value = '' if !defined($value);
56 push @result, $_valueless_attributes{$name} ? escape($name) : escape($name) . '="' . escape($value) . '"';
59 return @result ? ' ' . join(' ', @result) : '';
63 my ($tag, $content, %params) = @_;
64 my $attributes = stringify_attributes(%params);
66 return "<${tag}${attributes}>" if !defined($content) && $_singleton_tags{$tag};
67 return "<${tag}${attributes}>${content}</${tag}>";
71 my ($name, $value, %attributes) = @_;
73 _set_id_attribute(\%attributes, $name);
74 $attributes{type} ||= 'text';
76 html_tag('input', undef, %attributes, name => $name, value => $value);
80 my ($name, $value, %attributes) = @_;
81 input_tag($name, $value, %attributes, type => 'hidden');
85 my ($name, $object, %attributes) = @_;
87 my $size = delete($attributes{size}) || 5;
91 my $time_selection = input_tag("${name}_as_man_days_string", _call_on($object, "${method}_as_man_days_string"), %attributes, size => $size);
92 my $unit_selection = select_tag("${name}_as_man_days_unit", [[ 'h', $::locale->text('h') ], [ 'man_day', $::locale->text('MD') ]],
93 %attributes, default => _call_on($object, "${method}_as_man_days_unit"));
95 return $time_selection . $unit_selection;
101 $name =~ s/\[\+?\]/ _id() /ge; # give constructs with [] or [+] unique ids
102 $name =~ s/[^\w_]/_/g;
109 my ($name, $collection, %attributes) = @_;
111 _set_id_attribute(\%attributes, $name);
113 my $value_key = delete($attributes{value_key}) || 'id';
114 my $title_key = delete($attributes{title_key}) || $value_key;
115 my $default_key = delete($attributes{default_key}) || 'selected';
116 my $default_val_key = delete($attributes{default_value_key});
117 my $default_coll = delete($attributes{default});
119 my $value_title_sub = delete($attributes{value_title_sub});
121 my $value_sub = delete($attributes{value_sub});
122 my $title_sub = delete($attributes{title_sub});
123 my $default_sub = delete($attributes{default_sub});
125 my $with_empty = delete($attributes{with_empty});
126 my $empty_title = delete($attributes{empty_title});
128 my $with_optgroups = delete($attributes{with_optgroups});
130 undef $default_key if $default_sub || $default_val_key;
132 my $normalize_entry = sub {
133 my ($type, $entry, $sub, $key) = @_;
135 return $sub->($entry) if $sub;
137 my $ref = ref($entry);
140 return $entry if $type eq 'value' || $type eq 'title';
144 if ( $ref eq 'ARRAY' ) {
145 return $entry->[ $type eq 'value' ? 0 : $type eq 'title' ? 1 : 2 ];
148 return $entry->{$key} if $ref eq 'HASH';
149 return $entry->$key if $type ne 'default' || $entry->can($key);
154 if (defined($default_coll) && !ref $default_coll) {
155 %selected = ($default_coll => 1);
157 } elsif (ref($default_coll) eq 'HASH') {
158 %selected = %{ $default_coll };
160 } elsif ($default_coll) {
161 $default_coll = [ $default_coll ] unless 'ARRAY' eq ref $default_coll;
163 %selected = $default_val_key ? map({ ($normalize_entry->('value', $_, undef, $default_val_key) => 1) } @{ $default_coll })
164 : map({ ($_ => 1) } @{ $default_coll });
167 my $list_to_code = sub {
168 my ($sub_collection) = @_;
170 if ('ARRAY' ne ref $sub_collection) {
171 $sub_collection = [ $sub_collection ];
175 foreach my $entry ( @{ $sub_collection } ) {
179 if ( $value_title_sub ) {
180 ($value, $title) = @{ $value_title_sub->($entry) };
183 $value = $normalize_entry->('value', $entry, $value_sub, $value_key);
184 $title = $normalize_entry->('title', $entry, $title_sub, $title_key);
187 my $default = $default_key ? $normalize_entry->('default', $entry, $default_sub, $default_key) : 0;
189 push(@options, [$value, $title, $selected{$value} || $default]);
192 return join '', map { html_tag('option', escape($_->[1]), value => $_->[0], selected => $_->[2]) } @options;
196 $code .= html_tag('option', escape($empty_title || ''), value => '') if $with_empty;
198 if (!$with_optgroups) {
199 $code .= $list_to_code->($collection);
202 $code .= join '', map {
203 my ($optgroup_title, $sub_collection) = @{ $_ };
204 html_tag('optgroup', $list_to_code->($sub_collection), label => $optgroup_title)
208 html_tag('select', $code, %attributes, name => $name);
212 my ($name, %attributes) = @_;
214 _set_id_attribute(\%attributes, $name);
216 $attributes{value} = 1 unless defined $attributes{value};
217 my $label = delete $attributes{label};
218 my $checkall = delete $attributes{checkall};
219 my $for_submit = delete $attributes{for_submit};
221 if ($attributes{checked}) {
222 $attributes{checked} = 'checked';
224 delete $attributes{checked};
228 $code .= hidden_tag($name, 0, %attributes, id => $attributes{id} . '_hidden') if $for_submit;
229 $code .= html_tag('input', undef, %attributes, name => $name, type => 'checkbox');
230 $code .= html_tag('label', $label, for => $attributes{id}) if $label;
231 $code .= javascript(qq|\$('#$attributes{id}').checkall('$checkall');|) if $checkall;
237 my ($onclick, $value, %attributes) = @_;
239 _set_id_attribute(\%attributes, $attributes{name}) if $attributes{name};
240 $attributes{type} ||= 'button';
242 $onclick = 'if (!confirm("'. _J(delete($attributes{confirm})) .'")) return false; ' . $onclick if $attributes{confirm};
244 html_tag('input', undef, %attributes, value => $value, onclick => $onclick);
248 my ($name, $value, %attributes) = @_;
250 _set_id_attribute(\%attributes, $attributes{name}) if $attributes{name};
252 if ( $attributes{confirm} ) {
253 $attributes{onclick} = 'return confirm("'. _J(delete($attributes{confirm})) .'");';
256 input_tag($name, $value, %attributes, type => 'submit', class => 'submit');
259 sub ajax_submit_tag {
260 my ($url, $form_selector, $text, %attributes) = @_;
263 $form_selector = _J($form_selector);
264 my $onclick = qq|kivi.submit_ajax_form('${url}', '${form_selector}')|;
266 button_tag($onclick, $text, %attributes);
269 sub input_number_tag {
270 my ($name, $value, %params) = @_;
272 _set_id_attribute(\%params, $name);
273 my @onchange = $params{onchange} ? (onChange => delete $params{onchange}) : ();
274 my @classes = ('numeric');
275 push @classes, delete($params{class}) if $params{class};
276 my %class = @classes ? (class => join(' ', @classes)) : ();
278 $::request->layout->add_javascripts('kivi.Validator.js');
279 $::request->presenter->need_reinit_widgets($params{id});
282 $name, $::form->format_amount(\%::myconfig, $value, $params{precision}),
283 "data-validate" => "number",
292 html_tag('script', $data, type => 'text/javascript');
295 sub _set_id_attribute {
296 my ($attributes, $name, $unique) = @_;
298 if (!delete($attributes->{no_id}) && !$attributes->{id}) {
299 $attributes->{id} = name_to_id($name);
300 $attributes->{id} .= '_' . $attributes->{value} if $unique;
308 sub restricted_html {
311 $html_restricter ||= SL::HTML::Restrict->create;
312 return $html_restricter->process($value);
316 my ($name, $content, %attributes) = @_;
318 _set_id_attribute(\%attributes, $name);
319 $attributes{rows} *= 1; # required by standard
320 $attributes{cols} *= 1; # required by standard
322 html_tag('textarea', $content, %attributes, name => $name);
326 my ($href, $content, %params) = @_;
330 html_tag('a', $content, %params, href => $href);
342 SL::Presenter::Tag - Layouting / tag generation
350 [% P.select_tag('direction', [ [ 'left', 'To the left' ], [ 'right', 'To the right', 1 ] ]) %]
352 [% P.select_tag('direction', [ { direction => 'left', display => 'To the left' },
353 { direction => 'right', display => 'To the right' } ],
354 value_key => 'direction', title_key => 'display', default => 'right') %]
356 [% P.select_tag('direction', [ { direction => 'left', display => 'To the left' },
357 { direction => 'right', display => 'To the right', selected => 1 } ],
358 value_key => 'direction', title_key => 'display') %]
360 # Use an RDBO object and its n:m relationship as the default
361 # values. For example, a user can be a member of many groups. "All
362 # groups" is therefore the full collection and "$user->groups" is a
363 # list of RDBO AuthGroup objects whose IDs must match the ones in
364 # "All groups". This could look like the following:
365 [% P.select_tag('user.groups[]', SELF.all_groups, multiple=1,
366 default=SELF.user.groups, default_value_key='id' ) %]
370 A module modeled a bit after Rails' ActionView helpers. Several small
371 functions that create HTML tags from various kinds of data sources.
373 The C<id> attribute is usually calculated automatically. This can be
374 overridden by either specifying an C<id> attribute or by setting
379 =head2 LOW-LEVEL FUNCTIONS
383 =item C<html_tag $tag_name, $content_string, %attributes>
385 Creates an opening and closing HTML tag for C<$tag_name> and puts
386 C<$content_string> between the two. If C<$content_string> is undefined
387 or empty then only a E<lt>tag/E<gt> tag will be created. Attributes
388 are key/value pairs added to the opening tag.
390 C<$content_string> is not HTML escaped.
392 =item C<name_to_id $name>
394 Converts a name to a HTML id by replacing various characters.
396 =item C<stringify_attributes %items>
398 Creates a string from all elements in C<%items> suitable for usage as
399 HTML tag attributes. Keys and values are HTML escaped even though keys
400 must not contain non-ASCII characters for browsers to accept them.
402 =item C<restricted_html $html>
404 Returns HTML stripped of unknown tags. See L<SL::HTML::Restrict>.
408 =head2 HIGH-LEVEL FUNCTIONS
412 =item C<input_tag $name, $value, %attributes>
414 Creates a HTML 'input type=text' tag named C<$name> with the value
415 C<$value> and with arbitrary HTML attributes from C<%attributes>. The
416 tag's C<id> defaults to C<name_to_id($name)>.
418 =item C<submit_tag $name, $value, %attributes>
420 Creates a HTML 'input type=submit class=submit' tag named C<$name> with the
421 value C<$value> and with arbitrary HTML attributes from C<%attributes>. The
422 tag's C<id> defaults to C<name_to_id($name)>.
424 If C<$attributes{confirm}> is set then a JavaScript popup dialog will
425 be added via the C<onclick> handler asking the question given with
426 C<$attributes{confirm}>. The request is only submitted if the user
427 clicks the dialog's ok/yes button.
429 =item C<ajax_submit_tag $url, $form_selector, $text, %attributes>
431 Creates a HTML 'input type="button"' tag with a very specific onclick
432 handler that submits the form given by the jQuery selector
433 C<$form_selector> to the URL C<$url> (the actual JavaScript function
434 called for that is C<kivi.submit_ajax_form()> in
435 C<js/client_js.js>). The button's label will be C<$text>.
437 =item C<button_tag $onclick, $text, %attributes>
439 Creates a HTML 'input type="button"' tag with an onclick handler
440 C<$onclick> and a value of C<$text>. The button does not have a name
441 nor an ID by default.
443 If C<$attributes{confirm}> is set then a JavaScript popup dialog will
444 be prepended to the C<$onclick> handler asking the question given with
445 C<$attributes{confirm}>. The request is only submitted if the user
446 clicks the dialog's "ok/yes" button.
448 =item C<man_days_tag $name, $object, %attributes>
450 Creates two HTML inputs: a text input for entering a number and a drop
451 down box for chosing the unit (either 'man days' or 'hours').
453 C<$object> must be a L<Rose::DB::Object> instance using the
454 L<SL::DB::Helper::AttrDuration> helper.
456 C<$name> is supposed to be the name of the underlying column,
457 e.g. C<time_estimation> for an instance of
458 C<SL::DB::RequirementSpecItem>. If C<$name> has the form
459 C<prefix.method> then the full C<$name> is used for the input's base
460 names while the methods called on C<$object> are only the suffix. This
461 makes it possible to write statements like e.g.
463 [% P.man_days_tag("requirement_spec_item.time_estimation", SELF.item) %]
465 The attribute C<size> can be used to set the text input's size. It
468 =item C<hidden_tag $name, $value, %attributes>
470 Creates a HTML 'input type=hidden' tag named C<$name> with the value
471 C<$value> and with arbitrary HTML attributes from C<%attributes>. The
472 tag's C<id> defaults to C<name_to_id($name)>.
474 =item C<checkbox_tag $name, %attributes>
476 Creates a HTML 'input type=checkbox' tag named C<$name> with arbitrary
477 HTML attributes from C<%attributes>. The tag's C<id> defaults to
478 C<name_to_id($name)>. The tag's C<value> defaults to C<1>.
480 If C<%attributes> contains a key C<label> then a HTML 'label' tag is
481 created with said C<label>. No attribute named C<label> is created in
484 If C<%attributes> contains a key C<checkall> then the value is taken as a
485 JQuery selector and clicking this checkbox will also toggle all checkboxes
486 matching the selector.
488 =item C<select_tag $name, \@collection, %attributes>
490 Creates an HTML 'select' tag named C<$name> with the contents of one
491 'E<lt>optionE<gt>' tag for each element in C<\@collection> and with arbitrary
492 HTML attributes from C<%attributes>. The value
493 to use and the title to display are extracted from the elements in
494 C<\@collection>. Each element can be one of four things:
498 =item 1. An array reference with at least two elements. The first element is
499 the value, the second element is its title. The third element is optional and and should contain a boolean.
500 If it is true, than the element will be used as default.
502 =item 2. A scalar. The scalar is both the value and the title.
504 =item 3. A hash reference. In this case C<%attributes> must contain
505 I<value_key>, I<title_key> and may contain I<default_key> keys that name the keys in the element to use
506 for the value, title and default respectively.
508 =item 4. A blessed reference. In this case C<%attributes> must contain
509 I<value_key>, I<title_key> and may contain I<default_key> keys that name functions called on the blessed
510 reference whose return values are used as the value, title and default
515 For cases 3 and 4 C<$attributes{value_key}> defaults to C<id>,
516 C<$attributes{title_key}> defaults to C<$attributes{value_key}> and
517 C<$attributes{default_key}> defaults to C<selected>. Note that
518 C<$attributes{default_key}> is set to C<undef> if
519 C<$attributes{default_value_key}> is used as well (see below).
521 In addition to pure keys/method you can also provide coderefs as I<value_sub>
522 and/or I<title_sub> and/or I<default_sub>. If present, these take precedence over keys or methods,
523 and are called with the element as first argument. It must return the value, title or default.
525 Lastly a joint coderef I<value_title_sub> may be provided, which in turn takes
526 precedence over the C<value_sub> and C<title_sub> subs. It will only be called once for each
527 element and must return a list of value and title.
529 If the option C<with_empty> is set then an empty element (value
530 C<undef>) will be used as the first element. The title to display for
531 this element can be set with the option C<empty_title> and defaults to
534 The tag's C<id> defaults to C<name_to_id($name)>.
536 The option C<default> can be quite a lot of things:
540 =item 1. A scalar value. This is the value of the entry that's
543 =item 2. A hash reference for C<multiple=1>. Whether or not an entry
544 is selected by default is looked up in this hash.
546 =item 3. An array reference containing scalar values. Same as 1., just
547 for the case of C<multiple=1>.
549 =item 4. If C<default_value_key> is given: an array reference of hash
550 references. For each hash reference the value belonging to the key
551 C<default_value_key> is treated as one value to select by
552 default. Constructs a hash that's treated like 3.
554 =item 5. If C<default_value_key> is given: an array reference of
555 blessed objects. For each object the value returne from calling the
556 function named C<default_value_key> on the object is treated as one
557 value to select by default. Constructs a hash that's treated like 3.
561 5. also applies to single RDBO instances (due to 'wantarray'
562 shenanigans assigning RDBO's relationships to a hash key will result
563 in a single RDBO object being assigned instead of an array reference
564 containing that single RDBO object).
566 If the option C<with_optgroups> is set then this function expects
567 C<\@collection> to be one level deeper. The upper-most level is
568 translated into an HTML C<optgroup> tag. So the structure becomes:
572 =item 1. Array of array references. Each element in the
573 C<\@collection> is converted into an optgroup.
575 =item 2. The optgroup's C<label> attribute will be set to the
576 first element in the array element. The second array element is then
577 converted to a list of C<option> tags as described above.
581 Example for use of optgroups:
583 # First in a controller:
585 [ t8("First optgroup with three items"),
586 [ { id => 42, name => "item one" },
587 { id => 54, name => "second item" },
588 { id => 23, name => "and the third one" },
590 [ t8("Another optgroup, with a lot of items from Rose"),
591 SL::DB::Manager::Customer->get_all_sorted ],
594 # Later in the template:
595 [% L.select_tag('the_selection', COLLECTION, with_optgroups=1, title_key='name') %]
605 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
606 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>