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