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   $attributes{id}   ||= $self->name_to_id($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   $attributes{id}   ||= $self->name_to_id($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
 112   my @all_options;
 113   push @all_options, [undef, $empty_title || ''] if $with_empty;
 114
 115   my $normalize_entry = sub {
 116     my ($type, $entry, $sub, $key) = @_;
 117
 118     return $sub->($entry) if $sub;
 119
 120     my $ref = ref($entry);
 121
 122     if ( !$ref ) {
 123       return $entry if $type eq 'value' || $type eq 'title';
 124       return 0;
 125     }
 126
 127     if ( $ref eq 'ARRAY' ) {
 128       return $entry->[ $type eq 'value' ? 0 : $type eq 'title' ? 1 : 2 ];
 129     }
 130
 131     return $entry->{$key} if $ref  eq 'HASH';
 132     return $entry->$key   if $type ne 'default' || $entry->can($key);
 133     return undef;
 134   };
 135
 136   my $list_to_code = sub {
 137     my ($sub_collection) = @_;
 138
 139     my @options;
 140     foreach my $entry ( @{ $sub_collection } ) {
 141       my $value;
 142       my $title;
 143
 144       if ( $value_title_sub ) {
 145         ($value, $title) = @{ $value_title_sub->($entry) };
 146       } else {
 147
 148         $value = $normalize_entry->('value', $entry, $value_sub, $value_key);
 149         $title = $normalize_entry->('title', $entry, $title_sub, $title_key);
 150       }
 151
 152       my $default = $normalize_entry->('default', $entry, $default_sub, $default_key);
 153
 154       push(@options, [$value, $title, $default]);
 155     }
 156
 157     foreach my $entry (@options) {
 158       $entry->[2] = 1 if $selected{$entry->[0]};
 159     }
 160
 161     return join '', map { $self->html_tag('option', $self->escape($_->[1]), value => $_->[0], selected => $_->[2]) } @options;
 162   };
 163
 164   my $code;
 165
 166   if (!$with_optgroups) {
 167     $code = $list_to_code->($collection);
 168
 169   } else {
 170     $code = join '', map {
 171       my ($optgroup_title, $sub_collection) = @{ $_ };
 172       $self->html_tag('optgroup', $list_to_code->($sub_collection), label => $optgroup_title)
 173     } @{ $collection };
 174   }
 175
 176   return $self->html_tag('select', $code, %attributes, name => $name);
 177 }
 178
 179 1;
 180 __END__
 181
 182 =pod
 183
 184 =encoding utf8
 185
 186 =head1 NAME
 187
 188 SL::Presenter::Tag - Layouting / tag generation
 189
 190 =head1 SYNOPSIS
 191
 192 Usage from a template:
 193
 194   [% USE P %]
 195
 196   [% P.select_tag('direction', [ [ 'left', 'To the left' ], [ 'right', 'To the right', 1 ] ]) %]
 197
 198   [% P.select_tag('direction', [ { direction => 'left',  display => 'To the left'  },
 199                                  { direction => 'right', display => 'To the right' } ],
 200                                value_key => 'direction', title_key => 'display', default => 'right')) %]
 201
 202   [% P.select_tag('direction', [ { direction => 'left',  display => 'To the left'  },
 203                                  { direction => 'right', display => 'To the right', selected => 1 } ],
 204                                value_key => 'direction', title_key => 'display')) %]
 205
 206 =head1 DESCRIPTION
 207
 208 A module modeled a bit after Rails' ActionView helpers. Several small
 209 functions that create HTML tags from various kinds of data sources.
 210
 211 =head1 FUNCTIONS
 212
 213 =head2 LOW-LEVEL FUNCTIONS
 214
 215 =over 4
 216
 217 =item C<html_tag $tag_name, $content_string, %attributes>
 218
 219 Creates an opening and closing HTML tag for C<$tag_name> and puts
 220 C<$content_string> between the two. If C<$content_string> is undefined
 221 or empty then only a E<lt>tag/E<gt> tag will be created. Attributes
 222 are key/value pairs added to the opening tag.
 223
 224 C<$content_string> is not HTML escaped.
 225
 226 =item C<name_to_id $name>
 227
 228 Converts a name to a HTML id by replacing various characters.
 229
 230 =item C<stringify_attributes %items>
 231
 232 Creates a string from all elements in C<%items> suitable for usage as
 233 HTML tag attributes. Keys and values are HTML escaped even though keys
 234 must not contain non-ASCII characters for browsers to accept them.
 235
 236 =back
 237
 238 =head2 HIGH-LEVEL FUNCTIONS
 239
 240 =over 4
 241
 242 =item C<input_tag $name, $value, %attributes>
 243
 244 Creates a HTML 'input type=text' tag named C<$name> with the value
 245 C<$value> and with arbitrary HTML attributes from C<%attributes>. The
 246 tag's C<id> defaults to C<name_to_id($name)>.
 247
 248 =item C<man_days_tag $name, $object, %attributes>
 249
 250 Creates two HTML inputs: a text input for entering a number and a drop
 251 down box for chosing the unit (either 'man days' or 'hours').
 252
 253 C<$object> must be a L<Rose::DB::Object> instance using the
 254 L<SL::DB::Helper::AttrDuration> helper.
 255
 256 C<$name> is supposed to be the name of the underlying column,
 257 e.g. C<time_estimation> for an instance of
 258 C<SL::DB::RequirementSpecItem>. If C<$name> has the form
 259 C<prefix.method> then the full C<$name> is used for the input's base
 260 names while the methods called on C<$object> are only the suffix. This
 261 makes it possible to write statements like e.g.
 262
 263   [% P.man_days_tag("requirement_spec_item.time_estimation", SELF.item) %]
 264
 265 The attribute C<size> can be used to set the text input's size. It
 266 defaults to 5.
 267
 268 =item C<select_tag $name, \@collection, %attributes>
 269
 270 Creates a HTML 'select' tag named C<$name> with the contents of one
 271 'E<lt>optionE<gt>' tag for each element in C<\@collection> and with arbitrary
 272 HTML attributes from C<%attributes>. The value
 273 to use and the title to display are extracted from the elements in
 274 C<\@collection>. Each element can be one of four things:
 275
 276 =over 12
 277
 278 =item 1. An array reference with at least two elements. The first element is
 279 the value, the second element is its title. The third element is optional and and should contain a boolean.
 280 If it is true, than the element will be used as default.
 281
 282 =item 2. A scalar. The scalar is both the value and the title.
 283
 284 =item 3. A hash reference. In this case C<%attributes> must contain
 285 I<value_key>, I<title_key> and may contain I<default_key> keys that name the keys in the element to use
 286 for the value, title and default respectively.
 287
 288 =item 4. A blessed reference. In this case C<%attributes> must contain
 289 I<value_key>, I<title_key> and may contain I<default_key> keys that name functions called on the blessed
 290 reference whose return values are used as the value, title and default
 291 respectively.
 292
 293 =back
 294
 295 For cases 3 and 4 C<$attributes{value_key}> defaults to C<id>,
 296 C<$attributes{title_key}> defaults to C<$attributes{value_key}>
 297 and C<$attributes{default_key}> defaults to C<selected>.
 298
 299 In addition to pure keys/method you can also provide coderefs as I<value_sub>
 300 and/or I<title_sub> and/or I<default_sub>. If present, these take precedence over keys or methods,
 301 and are called with the element as first argument. It must return the value, title or default.
 302
 303 Lastly a joint coderef I<value_title_sub> may be provided, which in turn takes
 304 precedence over the C<value_sub> and C<title_sub> subs. It will only be called once for each
 305 element and must return a list of value and title.
 306
 307 If the option C<with_empty> is set then an empty element (value
 308 C<undef>) will be used as the first element. The title to display for
 309 this element can be set with the option C<empty_title> and defaults to
 310 an empty string.
 311
 312 The option C<default> can be either a scalar or an array reference
 313 containing the values of the options which should be set to be
 314 selected.
 315
 316 The tag's C<id> defaults to C<name_to_id($name)>.
 317
 318 If the option C<with_optgroups> is set then this function expects
 319 C<\@collection> to be one level deeper. The upper-most level is
 320 translated into a HTML C<optgroup> tag. So the structure becomes:
 321
 322 =over 4
 323
 324 =item 1. Array of array references. Each element in the
 325 C<\@collection> is converted into an optgroup.
 326
 327 =item 2. The optgroup's C<label> attribute will be set to the the
 328 first element in the array element. The second array element is then
 329 converted to a list of C<option> tags like it is described above.
 330
 331 =back
 332
 333 Example for use of optgroups:
 334
 335   # First in a controller:
 336   my @collection = (
 337     [ t8("First optgroup with two items"),
 338       [ { id => 42, name => "item one" },
 339         { id => 54, name => "second item" },
 340         { id => 23, name => "and the third one" },
 341       ] ],
 342     [ t8("Another optgroup, with a lot of items from Rose"),
 343       SL::DB::Manager::Customer->get_all_sorted ],
 344   );
 345
 346   # Later in the template:
 347   [% L.select_tag('the_selection', COLLECTION, with_optgroups=1, title_key='name') %]
 348
 349 =back
 350
 351 =head1 BUGS
 352
 353 Nothing here yet.
 354
 355 =head1 AUTHOR
 356
 357 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>,
 358 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 359
 360 =cut