use strict;
+use SL::HTML::Restrict;
+
use parent qw(Exporter);
use Exporter qw(import);
-our @EXPORT = qw(html_tag input_tag name_to_id select_tag stringify_attributes);
+our @EXPORT = qw(html_tag input_tag man_days_tag name_to_id select_tag stringify_attributes restricted_html);
use Carp;
my %_valueless_attributes = map { $_ => 1 } qw(
checked compact declare defer disabled ismap multiple noresize noshade nowrap
- readonly selected
+ readonly selected hidden
);
+sub _call_on {
+ my ($object, $method, @params) = @_;
+ return $object->$method(@params);
+}
+
+{ # This will give you an id for identifying html tags and such.
+ # It's guaranteed to be unique unless you exceed 10 mio calls per request.
+ # Do not use these id's to store information across requests.
+my $_id_sequence = int rand 1e7;
+sub _id {
+ return ( $_id_sequence = ($_id_sequence + 1) % 1e7 );
+}
+}
+
+
sub stringify_attributes {
my ($self, %params) = @_;
sub input_tag {
my ($self, $name, $value, %attributes) = @_;
- $attributes{id} ||= $self->name_to_id($name);
+ _set_id_attribute(\%attributes, $name);
$attributes{type} ||= 'text';
return $self->html_tag('input', undef, %attributes, name => $name, value => $value);
}
+sub man_days_tag {
+ my ($self, $name, $object, %attributes) = @_;
+
+ my $size = delete($attributes{size}) || 5;
+ my $method = $name;
+ $method =~ s/^.*\.//;
+
+ my $time_selection = $self->input_tag( "${name}_as_man_days_string", _call_on($object, "${method}_as_man_days_string"), %attributes, size => $size);
+ my $unit_selection = $self->select_tag("${name}_as_man_days_unit", [[ 'h', $::locale->text('h') ], [ 'man_day', $::locale->text('MD') ]],
+ %attributes, default => _call_on($object, "${method}_as_man_days_unit"));
+
+ return $time_selection . $unit_selection;
+}
+
sub name_to_id {
my ($self, $name) = @_;
+ $name =~ s/\[\+?\]/ _id() /ge; # give constructs with [] or [+] unique ids
$name =~ s/[^\w_]/_/g;
$name =~ s/_+/_/g;
sub select_tag {
my ($self, $name, $collection, %attributes) = @_;
- $attributes{id} ||= $self->name_to_id($name);
+ _set_id_attribute(\%attributes, $name);
my $value_key = delete($attributes{value_key}) || 'id';
my $title_key = delete($attributes{title_key}) || $value_key;
my $default_key = delete($attributes{default_key}) || 'selected';
-
+ my $default_val_key = delete($attributes{default_value_key});
+ my $default_coll = delete($attributes{default});
my $value_title_sub = delete($attributes{value_title_sub});
my $with_optgroups = delete($attributes{with_optgroups});
- my %selected;
-
- if ( ref($attributes{default}) eq 'ARRAY' ) {
-
- foreach my $entry (@{$attributes{default}}) {
- $selected{$entry} = 1;
- }
- } elsif ( defined($attributes{default}) ) {
- $selected{$attributes{default}} = 1;
- }
-
- delete($attributes{default});
-
-
- my @all_options;
- push @all_options, [undef, $empty_title || ''] if $with_empty;
+ undef $default_key if $default_sub || $default_val_key;
my $normalize_entry = sub {
my ($type, $entry, $sub, $key) = @_;
return undef;
};
+ my %selected;
+ if (defined($default_coll) && !ref $default_coll) {
+ %selected = ($default_coll => 1);
+
+ } elsif (ref($default_coll) eq 'HASH') {
+ %selected = %{ $default_coll };
+
+ } elsif ($default_coll) {
+ $default_coll = [ $default_coll ] unless 'ARRAY' eq ref $default_coll;
+
+ %selected = $default_val_key ? map({ ($normalize_entry->('value', $_, undef, $default_val_key) => 1) } @{ $default_coll })
+ : map({ ($_ => 1) } @{ $default_coll });
+ }
+
my $list_to_code = sub {
my ($sub_collection) = @_;
+ if ('ARRAY' ne ref $sub_collection) {
+ $sub_collection = [ $sub_collection ];
+ }
+
my @options;
foreach my $entry ( @{ $sub_collection } ) {
my $value;
$title = $normalize_entry->('title', $entry, $title_sub, $title_key);
}
- my $default = $normalize_entry->('default', $entry, $default_sub, $default_key);
-
- push(@options, [$value, $title, $default]);
- }
+ my $default = $default_key ? $normalize_entry->('default', $entry, $default_sub, $default_key) : 0;
- foreach my $entry (@options) {
- $entry->[2] = 1 if $selected{$entry->[0]};
+ push(@options, [$value, $title, $selected{$value} || $default]);
}
return join '', map { $self->html_tag('option', $self->escape($_->[1]), value => $_->[0], selected => $_->[2]) } @options;
};
- my $code;
+ my $code = '';
+ $code .= $self->html_tag('option', $self->escape($empty_title || ''), value => '') if $with_empty;
if (!$with_optgroups) {
- $code = $list_to_code->($collection);
+ $code .= $list_to_code->($collection);
} else {
- $code = join '', map {
+ $code .= join '', map {
my ($optgroup_title, $sub_collection) = @{ $_ };
$self->html_tag('optgroup', $list_to_code->($sub_collection), label => $optgroup_title)
} @{ $collection };
return $self->html_tag('select', $code, %attributes, name => $name);
}
+sub _set_id_attribute {
+ my ($attributes, $name, $unique) = @_;
+
+ if (!delete($attributes->{no_id}) && !$attributes->{id}) {
+ $attributes->{id} = name_to_id(undef, $name);
+ $attributes->{id} .= '_' . $attributes->{value} if $unique;
+ }
+
+ return %{ $attributes };
+}
+
+my $html_restricter;
+
+sub restricted_html {
+ my ($self, $value) = @_;
+
+ $html_restricter ||= SL::HTML::Restrict->create;
+ return $html_restricter->process($value);
+}
+
1;
__END__
=head1 SYNOPSIS
-Usage from a template:
+Usage in a template:
[% USE P %]
[% P.select_tag('direction', [ { direction => 'left', display => 'To the left' },
{ direction => 'right', display => 'To the right' } ],
- value_key => 'direction', title_key => 'display', default => 'right')) %]
+ value_key => 'direction', title_key => 'display', default => 'right') %]
[% P.select_tag('direction', [ { direction => 'left', display => 'To the left' },
{ direction => 'right', display => 'To the right', selected => 1 } ],
- value_key => 'direction', title_key => 'display')) %]
+ value_key => 'direction', title_key => 'display') %]
+
+ # Use an RDBO object and its n:m relationship as the default
+ # values. For example, a user can be a member of many groups. "All
+ # groups" is therefore the full collection and "$user->groups" is a
+ # list of RDBO AuthGroup objects whose IDs must match the ones in
+ # "All groups". This could look like the following:
+ [% P.select_tag('user.groups[]', SELF.all_groups, multiple=1,
+ default=SELF.user.groups, default_value_key='id' ) %]
=head1 DESCRIPTION
A module modeled a bit after Rails' ActionView helpers. Several small
functions that create HTML tags from various kinds of data sources.
+The C<id> attribute is usually calculated automatically. This can be
+overridden by either specifying an C<id> attribute or by setting
+C<no_id> to trueish.
+
=head1 FUNCTIONS
=head2 LOW-LEVEL FUNCTIONS
HTML tag attributes. Keys and values are HTML escaped even though keys
must not contain non-ASCII characters for browsers to accept them.
+=item C<restricted_html $html>
+
+Returns HTML stripped of unknown tags. See L<SL::HTML::Restrict>.
+
=back
=head2 HIGH-LEVEL FUNCTIONS
C<$value> and with arbitrary HTML attributes from C<%attributes>. The
tag's C<id> defaults to C<name_to_id($name)>.
+=item C<man_days_tag $name, $object, %attributes>
+
+Creates two HTML inputs: a text input for entering a number and a drop
+down box for chosing the unit (either 'man days' or 'hours').
+
+C<$object> must be a L<Rose::DB::Object> instance using the
+L<SL::DB::Helper::AttrDuration> helper.
+
+C<$name> is supposed to be the name of the underlying column,
+e.g. C<time_estimation> for an instance of
+C<SL::DB::RequirementSpecItem>. If C<$name> has the form
+C<prefix.method> then the full C<$name> is used for the input's base
+names while the methods called on C<$object> are only the suffix. This
+makes it possible to write statements like e.g.
+
+ [% P.man_days_tag("requirement_spec_item.time_estimation", SELF.item) %]
+
+The attribute C<size> can be used to set the text input's size. It
+defaults to 5.
+
=item C<select_tag $name, \@collection, %attributes>
-Creates a HTML 'select' tag named C<$name> with the contents of one
+Creates an HTML 'select' tag named C<$name> with the contents of one
'E<lt>optionE<gt>' tag for each element in C<\@collection> and with arbitrary
HTML attributes from C<%attributes>. The value
to use and the title to display are extracted from the elements in
=back
For cases 3 and 4 C<$attributes{value_key}> defaults to C<id>,
-C<$attributes{title_key}> defaults to C<$attributes{value_key}>
-and C<$attributes{default_key}> defaults to C<selected>.
+C<$attributes{title_key}> defaults to C<$attributes{value_key}> and
+C<$attributes{default_key}> defaults to C<selected>. Note that
+C<$attributes{default_key}> is set to C<undef> if
+C<$attributes{default_value_key}> is used as well (see below).
In addition to pure keys/method you can also provide coderefs as I<value_sub>
and/or I<title_sub> and/or I<default_sub>. If present, these take precedence over keys or methods,
this element can be set with the option C<empty_title> and defaults to
an empty string.
-The option C<default> can be either a scalar or an array reference
-containing the values of the options which should be set to be
-selected.
-
The tag's C<id> defaults to C<name_to_id($name)>.
+The option C<default> can be quite a lot of things:
+
+=over 4
+
+=item 1. A scalar value. This is the value of the entry that's
+selected by default.
+
+=item 2. A hash reference for C<multiple=1>. Whether or not an entry
+is selected by default is looked up in this hash.
+
+=item 3. An array reference containing scalar values. Same as 1., just
+for the case of C<multiple=1>.
+
+=item 4. If C<default_value_key> is given: an array reference of hash
+references. For each hash reference the value belonging to the key
+C<default_value_key> is treated as one value to select by
+default. Constructs a hash that's treated like 3.
+
+=item 5. If C<default_value_key> is given: an array reference of
+blessed objects. For each object the value returne from calling the
+function named C<default_value_key> on the object is treated as one
+value to select by default. Constructs a hash that's treated like 3.
+
+=back
+
+5. also applies to single RDBO instances (due to 'wantarray'
+shenanigans assigning RDBO's relationships to a hash key will result
+in a single RDBO object being assigned instead of an array reference
+containing that single RDBO object).
+
If the option C<with_optgroups> is set then this function expects
C<\@collection> to be one level deeper. The upper-most level is
-translated into a HTML C<optgroup> tag. So the structure becomes:
+translated into an HTML C<optgroup> tag. So the structure becomes:
=over 4
=item 1. Array of array references. Each element in the
C<\@collection> is converted into an optgroup.
-=item 2. The optgroup's C<label> attribute will be set to the the
+=item 2. The optgroup's C<label> attribute will be set to the
first element in the array element. The second array element is then
-converted to a list of C<option> tags like it is described above.
+converted to a list of C<option> tags as described above.
=back
# First in a controller:
my @collection = (
- [ t8("First optgroup with two items"),
+ [ t8("First optgroup with three items"),
[ { id => 42, name => "item one" },
{ id => 54, name => "second item" },
{ id => 23, name => "and the third one" },
projects / kivitendo-erp.git / blobdiff