SL/Presenter/Tag.pm

   1 package SL::Presenter::Tag;
   2
   3 use strict;
   4
   5 use parent qw(Exporter);
   6
   7 use Exporter qw(import);
   8 our @EXPORT = qw(html_tag input_tag man_days_tag name_to_id select_tag stringify_attributes);
   9
  10 use Carp;
  11
  12 my %_valueless_attributes = map { $_ => 1 } qw(
  13   checked compact declare defer disabled ismap multiple noresize noshade nowrap
  14   readonly selected
  15 );
  16
  17 sub _call_on {
  18   my ($object, $method, @params) = @_;
  19   return $object->$method(@params);
  20 }
  21
  22
  23 sub stringify_attributes {
  24   my ($self, %params) = @_;
  25
  26   my @result = ();
  27   while (my ($name, $value) = each %params) {
  28     next unless $name;
  29     next if $_valueless_attributes{$name} && !$value;
  30     $value = '' if !defined($value);
  31     push @result, $_valueless_attributes{$name} ? $self->escape($name) : $self->escape($name) . '="' . $self->escape($value) . '"';
  32   }
  33
  34   return @result ? ' ' . join(' ', @result) : '';
  35 }
  36
  37 sub html_tag {
  38   my ($self, $tag, $content, %params) = @_;
  39   my $attributes = $self->stringify_attributes(%params);
  40
  41   return "<${tag}${attributes}>" unless defined($content);
  42   return "<${tag}${attributes}>${content}</${tag}>";
  43 }
  44
  45 sub input_tag {
  46   my ($self, $name, $value, %attributes) = @_;
  47
  48   _set_id_attribute(\%attributes, $name);
  49   $attributes{type} ||= 'text';
  50
  51   return $self->html_tag('input', undef, %attributes, name => $name, value => $value);
  52 }
  53
  54 sub man_days_tag {
  55   my ($self, $name, $object, %attributes) = @_;
  56
  57   my $size           =  delete($attributes{size})   || 5;
  58   my $method         =  $name;
  59   $method            =~ s/^.*\.//;
  60
  61   my $time_selection =  $self->input_tag( "${name}_as_man_days_string", _call_on($object, "${method}_as_man_days_string"), %attributes, size => $size);
  62   my $unit_selection =  $self->select_tag("${name}_as_man_days_unit",   [[ 'h', $::locale->text('h') ], [ 'man_day', $::locale->text('MD') ]],
  63                                           %attributes, default => _call_on($object, "${method}_as_man_days_unit"));
  64
  65   return $time_selection . $unit_selection;
  66 }
  67
  68 sub name_to_id {
  69   my ($self, $name) = @_;
  70
  71   $name =~ s/[^\w_]/_/g;
  72   $name =~ s/_+/_/g;
  73
  74   return $name;
  75 }
  76
  77 sub select_tag {
  78   my ($self, $name, $collection, %attributes) = @_;
  79
  80   _set_id_attribute(\%attributes, $name);
  81
  82   my $value_key       = delete($attributes{value_key})   || 'id';
  83   my $title_key       = delete($attributes{title_key})   || $value_key;
  84   my $default_key     = delete($attributes{default_key}) || 'selected';
  85
  86
  87   my $value_title_sub = delete($attributes{value_title_sub});
  88
  89   my $value_sub       = delete($attributes{value_sub});
  90   my $title_sub       = delete($attributes{title_sub});
  91   my $default_sub     = delete($attributes{default_sub});
  92
  93   my $with_empty      = delete($attributes{with_empty});
  94   my $empty_title     = delete($attributes{empty_title});
  95
  96   my $with_optgroups  = delete($attributes{with_optgroups});
  97
  98   my %selected;
  99
 100   if ( ref($attributes{default}) eq 'ARRAY' ) {
 101
 102     foreach my $entry (@{$attributes{default}}) {
 103       $selected{$entry} = 1;
 104     }
 105   } elsif ( defined($attributes{default}) ) {
 106     $selected{$attributes{default}} = 1;
 107   }
 108
 109   delete($attributes{default});
 110
 111   my $normalize_entry = sub {
 112     my ($type, $entry, $sub, $key) = @_;
 113
 114     return $sub->($entry) if $sub;
 115
 116     my $ref = ref($entry);
 117
 118     if ( !$ref ) {
 119       return $entry if $type eq 'value' || $type eq 'title';
 120       return 0;
 121     }
 122
 123     if ( $ref eq 'ARRAY' ) {
 124       return $entry->[ $type eq 'value' ? 0 : $type eq 'title' ? 1 : 2 ];
 125     }
 126
 127     return $entry->{$key} if $ref  eq 'HASH';
 128     return $entry->$key   if $type ne 'default' || $entry->can($key);
 129     return undef;
 130   };
 131
 132   my $list_to_code = sub {
 133     my ($sub_collection) = @_;
 134
 135     my @options;
 136     foreach my $entry ( @{ $sub_collection } ) {
 137       my $value;
 138       my $title;
 139
 140       if ( $value_title_sub ) {
 141         ($value, $title) = @{ $value_title_sub->($entry) };
 142       } else {
 143
 144         $value = $normalize_entry->('value', $entry, $value_sub, $value_key);
 145         $title = $normalize_entry->('title', $entry, $title_sub, $title_key);
 146       }
 147
 148       my $default = $normalize_entry->('default', $entry, $default_sub, $default_key);
 149
 150       push(@options, [$value, $title, $default]);
 151     }
 152
 153     foreach my $entry (@options) {
 154       $entry->[2] = 1 if $selected{$entry->[0]};
 155     }
 156
 157     return join '', map { $self->html_tag('option', $self->escape($_->[1]), value => $_->[0], selected => $_->[2]) } @options;
 158   };
 159
 160   my $code  = '';
 161   $code    .= $self->html_tag('option', $self->escape($empty_title || ''), value => '') if $with_empty;
 162
 163   if (!$with_optgroups) {
 164     $code .= $list_to_code->($collection);
 165
 166   } else {
 167     $code .= join '', map {
 168       my ($optgroup_title, $sub_collection) = @{ $_ };
 169       $self->html_tag('optgroup', $list_to_code->($sub_collection), label => $optgroup_title)
 170     } @{ $collection };
 171   }
 172
 173   return $self->html_tag('select', $code, %attributes, name => $name);
 174 }
 175
 176 sub _set_id_attribute {
 177   my ($attributes, $name) = @_;
 178
 179   $attributes->{id} = name_to_id(undef, $name) if !delete($attributes->{no_id}) && !$attributes->{id};
 180
 181   return %{ $attributes };
 182 }
 183
 184 1;
 185 __END__
 186
 187 =pod
 188
 189 =encoding utf8
 190
 191 =head1 NAME
 192
 193 SL::Presenter::Tag - Layouting / tag generation
 194
 195 =head1 SYNOPSIS
 196
 197 Usage from a template:
 198
 199   [% USE P %]
 200
 201   [% P.select_tag('direction', [ [ 'left', 'To the left' ], [ 'right', 'To the right', 1 ] ]) %]
 202
 203   [% P.select_tag('direction', [ { direction => 'left',  display => 'To the left'  },
 204                                  { direction => 'right', display => 'To the right' } ],
 205                                value_key => 'direction', title_key => 'display', default => 'right')) %]
 206
 207   [% P.select_tag('direction', [ { direction => 'left',  display => 'To the left'  },
 208                                  { direction => 'right', display => 'To the right', selected => 1 } ],
 209                                value_key => 'direction', title_key => 'display')) %]
 210
 211 =head1 DESCRIPTION
 212
 213 A module modeled a bit after Rails' ActionView helpers. Several small
 214 functions that create HTML tags from various kinds of data sources.
 215
 216 The C<id> attribute is usually calculated automatically. This can be
 217 overridden by either specifying an C<id> attribute or by setting
 218 C<no_id> to trueish.
 219
 220 =head1 FUNCTIONS
 221
 222 =head2 LOW-LEVEL FUNCTIONS
 223
 224 =over 4
 225
 226 =item C<html_tag $tag_name, $content_string, %attributes>
 227
 228 Creates an opening and closing HTML tag for C<$tag_name> and puts
 229 C<$content_string> between the two. If C<$content_string> is undefined
 230 or empty then only a E<lt>tag/E<gt> tag will be created. Attributes
 231 are key/value pairs added to the opening tag.
 232
 233 C<$content_string> is not HTML escaped.
 234
 235 =item C<name_to_id $name>
 236
 237 Converts a name to a HTML id by replacing various characters.
 238
 239 =item C<stringify_attributes %items>
 240
 241 Creates a string from all elements in C<%items> suitable for usage as
 242 HTML tag attributes. Keys and values are HTML escaped even though keys
 243 must not contain non-ASCII characters for browsers to accept them.
 244
 245 =back
 246
 247 =head2 HIGH-LEVEL FUNCTIONS
 248
 249 =over 4
 250
 251 =item C<input_tag $name, $value, %attributes>
 252
 253 Creates a HTML 'input type=text' tag named C<$name> with the value
 254 C<$value> and with arbitrary HTML attributes from C<%attributes>. The
 255 tag's C<id> defaults to C<name_to_id($name)>.
 256
 257 =item C<man_days_tag $name, $object, %attributes>
 258
 259 Creates two HTML inputs: a text input for entering a number and a drop
 260 down box for chosing the unit (either 'man days' or 'hours').
 261
 262 C<$object> must be a L<Rose::DB::Object> instance using the
 263 L<SL::DB::Helper::AttrDuration> helper.
 264
 265 C<$name> is supposed to be the name of the underlying column,
 266 e.g. C<time_estimation> for an instance of
 267 C<SL::DB::RequirementSpecItem>. If C<$name> has the form
 268 C<prefix.method> then the full C<$name> is used for the input's base
 269 names while the methods called on C<$object> are only the suffix. This
 270 makes it possible to write statements like e.g.
 271
 272   [% P.man_days_tag("requirement_spec_item.time_estimation", SELF.item) %]
 273
 274 The attribute C<size> can be used to set the text input's size. It
 275 defaults to 5.
 276
 277 =item C<select_tag $name, \@collection, %attributes>
 278
 279 Creates a HTML 'select' tag named C<$name> with the contents of one
 280 'E<lt>optionE<gt>' tag for each element in C<\@collection> and with arbitrary
 281 HTML attributes from C<%attributes>. The value
 282 to use and the title to display are extracted from the elements in
 283 C<\@collection>. Each element can be one of four things:
 284
 285 =over 12
 286
 287 =item 1. An array reference with at least two elements. The first element is
 288 the value, the second element is its title. The third element is optional and and should contain a boolean.
 289 If it is true, than the element will be used as default.
 290
 291 =item 2. A scalar. The scalar is both the value and the title.
 292
 293 =item 3. A hash reference. In this case C<%attributes> must contain
 294 I<value_key>, I<title_key> and may contain I<default_key> keys that name the keys in the element to use
 295 for the value, title and default respectively.
 296
 297 =item 4. A blessed reference. In this case C<%attributes> must contain
 298 I<value_key>, I<title_key> and may contain I<default_key> keys that name functions called on the blessed
 299 reference whose return values are used as the value, title and default
 300 respectively.
 301
 302 =back
 303
 304 For cases 3 and 4 C<$attributes{value_key}> defaults to C<id>,
 305 C<$attributes{title_key}> defaults to C<$attributes{value_key}>
 306 and C<$attributes{default_key}> defaults to C<selected>.
 307
 308 In addition to pure keys/method you can also provide coderefs as I<value_sub>
 309 and/or I<title_sub> and/or I<default_sub>. If present, these take precedence over keys or methods,
 310 and are called with the element as first argument. It must return the value, title or default.
 311
 312 Lastly a joint coderef I<value_title_sub> may be provided, which in turn takes
 313 precedence over the C<value_sub> and C<title_sub> subs. It will only be called once for each
 314 element and must return a list of value and title.
 315
 316 If the option C<with_empty> is set then an empty element (value
 317 C<undef>) will be used as the first element. The title to display for
 318 this element can be set with the option C<empty_title> and defaults to
 319 an empty string.
 320
 321 The option C<default> can be either a scalar or an array reference
 322 containing the values of the options which should be set to be
 323 selected.
 324
 325 The tag's C<id> defaults to C<name_to_id($name)>.
 326
 327 If the option C<with_optgroups> is set then this function expects
 328 C<\@collection> to be one level deeper. The upper-most level is
 329 translated into a HTML C<optgroup> tag. So the structure becomes:
 330
 331 =over 4
 332
 333 =item 1. Array of array references. Each element in the
 334 C<\@collection> is converted into an optgroup.
 335
 336 =item 2. The optgroup's C<label> attribute will be set to the the
 337 first element in the array element. The second array element is then
 338 converted to a list of C<option> tags like it is described above.
 339
 340 =back
 341
 342 Example for use of optgroups:
 343
 344   # First in a controller:
 345   my @collection = (
 346     [ t8("First optgroup with two items"),
 347       [ { id => 42, name => "item one" },
 348         { id => 54, name => "second item" },
 349         { id => 23, name => "and the third one" },
 350       ] ],
 351     [ t8("Another optgroup, with a lot of items from Rose"),
 352       SL::DB::Manager::Customer->get_all_sorted ],
 353   );
 354
 355   # Later in the template:
 356   [% L.select_tag('the_selection', COLLECTION, with_optgroups=1, title_key='name') %]
 357
 358 =back
 359
 360 =head1 BUGS
 361
 362 Nothing here yet.
 363
 364 =head1 AUTHOR
 365
 366 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
 367 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 368
 369 =cut