SL/Presenter/MaterialComponents.pm

   1 package SL::Presenter::MaterialComponents;
   2
   3 use strict;
   4
   5 use SL::HTML::Restrict;
   6 use SL::MoreCommon qw(listify);
   7 use SL::Presenter::EscapedText qw(escape);
   8 use SL::Presenter::Tag qw(html_tag);
   9 use Scalar::Util qw(blessed);
  10 use List::UtilsBy qw(partition_by);
  11
  12 use Exporter qw(import);
  13 our @EXPORT_OK = qw(
  14   button_tag
  15   input_tag
  16   textarea_tag
  17   date_tag
  18   submit_tag
  19   icon
  20   select_tag
  21   checkbox_tag
  22 );
  23 our %EXPORT_TAGS = (ALL => \@EXPORT_OK);
  24
  25 use constant BUTTON          => 'btn';
  26 use constant BUTTON_FLAT     => 'btn-flat';
  27 use constant BUTTON_FLOATING => 'btn-floating';
  28 use constant BUTTON_LARGE    => 'btn-large';
  29 use constant BUTTON_SMALL    => 'btn-small';
  30 use constant DISABLED        => 'disabled';
  31 use constant LEFT            => 'left';
  32 use constant MATERIAL_ICONS  => 'material-icons';
  33 use constant RIGHT           => 'right';
  34 use constant LARGE           => 'large';
  35 use constant MEDIUM          => 'medium';
  36 use constant SMALL           => 'small';
  37 use constant TINY            => 'tiny';
  38 use constant INPUT_FIELD     => 'input-field';
  39 use constant DATEPICKER      => 'datepicker';
  40
  41 use constant WAVES_EFFECT    => 'waves-effect';
  42 use constant WAVES_LIGHT     => 'waves-light';
  43
  44
  45 my %optional_classes = (
  46   button => {
  47     disabled => DISABLED,
  48     flat     => BUTTON_FLAT,
  49     floating => BUTTON_FLOATING,
  50     large    => BUTTON_LARGE,
  51     small    => BUTTON_SMALL,
  52   },
  53   icon => {
  54     left   => LEFT,
  55     right  => RIGHT,
  56     large  => LARGE,
  57     medium => MEDIUM,
  58     small  => SMALL,
  59     tiny   => TINY,
  60   },
  61   size => {
  62     map { $_ => $_ }
  63       qw(col row),
  64       (map { "s$_" } 1..12),
  65       (map { "m$_" } 1..12),
  66       (map { "l$_" } 1..12),
  67   },
  68 );
  69
  70 use Carp;
  71
  72 sub _confirm_js {
  73   'if (!confirm("'. _J($_[0]) .'")) return false;'
  74 }
  75
  76 sub _confirm_to_onclick {
  77   my ($attributes, $onclick) = @_;
  78
  79   if ($attributes->{confirm}) {
  80     $$onclick //= '';
  81     $$onclick = _confirm_js(delete($attributes->{confirm})) . $attributes->{onlick};
  82   }
  83 }
  84
  85 # used to extract material properties that need to be translated to classes
  86 # supports prefixing for delegation
  87 # returns a list of classes, mutates the attributes
  88 sub _extract_attribute_classes {
  89   my ($attributes, $type, $prefix) = @_;
  90
  91   my @classes;
  92   my $attr;
  93   for my $key (keys %$attributes) {
  94     if ($prefix) {
  95       next unless $key =~ /^${prefix}_(.*)/;
  96       $attr = $1;
  97     } else {
  98       $attr = $key;
  99     }
 100
 101     if ($optional_classes{$type}{$attr}) {
 102       $attributes->{$key} = undef;
 103       push @classes, $optional_classes{$type}{$attr};
 104     }
 105   }
 106
 107   # delete all undefined values
 108   my @delete_keys = grep { !defined $attributes->{$_} } keys %$attributes;
 109   delete $attributes->{$_} for @delete_keys;
 110
 111   @classes;
 112 }
 113
 114 # used to extract material classes that are passed directly as classes
 115 sub _extract_classes {
 116   my ($attributes, $type) = @_;
 117
 118   my @classes = map { split / / } listify($attributes->{class});
 119   my %classes = partition_by { !!$optional_classes{$type}{$_} } @classes;
 120
 121   $attributes->{class} = $classes{''};
 122   $classes{1};
 123 }
 124
 125 sub _set_id_attribute {
 126   my ($attributes, $name, $unique) = @_;
 127
 128   if (!delete($attributes->{no_id}) && !$attributes->{id}) {
 129     $attributes->{id}  = name_to_id($name);
 130     $attributes->{id} .= '_' . $attributes->{value} if $unique;
 131   }
 132
 133   %{ $attributes };
 134 }
 135
 136 { # This will give you an id for identifying html tags and such.
 137   # It's guaranteed to be unique unless you exceed 10 mio calls per request.
 138   # Do not use these id's to store information across requests.
 139 my $_id_sequence = int rand 1e7;
 140 sub _id {
 141   return ( $_id_sequence = ($_id_sequence + 1) % 1e7 );
 142 }
 143 }
 144
 145 sub name_to_id {
 146   my ($name) = @_;
 147
 148   if (!$name) {
 149     return "id_" . _id();
 150   }
 151
 152   $name =~ s/\[\+?\]/ _id() /ge; # give constructs with [] or [+] unique ids
 153   $name =~ s/[^\w_]/_/g;
 154   $name =~ s/_+/_/g;
 155
 156   return $name;
 157 }
 158
 159 sub button_tag {
 160   my ($onclick, $value, %attributes) = @_;
 161
 162   _set_id_attribute(\%attributes, $attributes{name}) if $attributes{name};
 163   _confirm_to_onclick(\%attributes, \$onclick);
 164
 165   my @button_classes = _extract_attribute_classes(\%attributes, "button");
 166   my @icon_classes   = _extract_attribute_classes(\%attributes, "icon", "icon");
 167
 168   $attributes{class} = [
 169     grep { $_ } $attributes{class}, WAVES_EFFECT, WAVES_LIGHT, BUTTON, @button_classes
 170   ];
 171
 172   if ($attributes{icon}) {
 173     $value = icon(delete $attributes{icon}, class => \@icon_classes)
 174            . $value;
 175   }
 176
 177   html_tag('a', $value, %attributes, onclick => $onclick);
 178 }
 179
 180 sub submit_tag {
 181   my ($name, $value, %attributes) = @_;
 182
 183   _set_id_attribute(\%attributes, $attributes{name}) if $attributes{name};
 184   _confirm_to_onclick(\%attributes, \($attributes{onclick} //= ''));
 185
 186   my @button_classes = _extract_attribute_classes(\%attributes, "button");
 187   my @icon_classes   = _extract_attribute_classes(\%attributes, "icon", "icon");
 188
 189   $attributes{class} = [
 190     grep { $_ } $attributes{class}, WAVES_EFFECT, WAVES_LIGHT, BUTTON, @button_classes
 191   ];
 192
 193   if ($attributes{icon}) {
 194     $value = icon(delete $attributes{icon}, class => \@icon_classes)
 195            . $value;
 196   }
 197
 198   html_tag('button', $value, type => 'submit',  %attributes);
 199 }
 200
 201
 202 sub icon {
 203   my ($name, %attributes) = @_;
 204
 205   my @icon_classes = _extract_attribute_classes(\%attributes, "icon");
 206
 207   html_tag('i', $name, class => [ grep { $_ } MATERIAL_ICONS, @icon_classes, delete $attributes{class} ], %attributes);
 208 }
 209
 210
 211 sub input_tag {
 212   my ($name, $value, %attributes) = @_;
 213
 214   _set_id_attribute(\%attributes, $attributes{name});
 215
 216   my $class = delete $attributes{class};
 217   my $icon  = $attributes{icon}
 218     ? icon(delete $attributes{icon}, class => 'prefix')
 219     : '';
 220
 221   my $label = $attributes{label}
 222     ? html_tag('label', delete $attributes{label}, for => $attributes{id})
 223     : '';
 224
 225   $attributes{type} //= 'text';
 226
 227   html_tag('div',
 228     $icon .
 229     html_tag('input', undef, value => $value, %attributes, name => $name) .
 230     $label,
 231     class => [ grep $_, $class, INPUT_FIELD ],
 232   );
 233 }
 234
 235 sub textarea_tag {
 236   my ($name, $value, %attributes) = @_;
 237
 238   _set_id_attribute(\%attributes, $attributes{name});
 239
 240   my $class = delete $attributes{class};
 241   my $icon  = $attributes{icon}
 242     ? icon(delete $attributes{icon}, class => 'prefix')
 243     : '';
 244
 245   my $label = $attributes{label}
 246     ? html_tag('label', delete $attributes{label}, for => $attributes{id})
 247     : '';
 248
 249   html_tag('div',
 250     $icon .
 251     html_tag('textarea', $value, class => 'materialize-textarea', %attributes, name => $name) .
 252     $label,
 253     class => [ grep $_, $class, INPUT_FIELD ],
 254   );
 255 }
 256
 257 sub date_tag {
 258   my ($name, $value, %attributes) = @_;
 259
 260   _set_id_attribute(\%attributes, $name);
 261
 262   my $icon  = $attributes{icon}
 263     ? icon(delete $attributes{icon}, class => 'prefix')
 264     : '';
 265
 266   my $label = $attributes{label}
 267     ? html_tag('label', delete $attributes{label}, for => $attributes{id})
 268     : '';
 269
 270   $attributes{type} = 'text'; # required for materialize
 271
 272   my @onchange = $attributes{onchange} ? (onChange => delete $attributes{onchange}) : ();
 273   my @classes  = (delete $attributes{class});
 274
 275   $::request->layout->add_javascripts('kivi.Validator.js');
 276   $::request->presenter->need_reinit_widgets($attributes{id});
 277
 278   $attributes{'data-validate'} = join(' ', "date", grep { $_ } (delete $attributes{'data-validate'}));
 279
 280   html_tag('div',
 281     $icon .
 282     html_tag('input',
 283       blessed($value) ? $value->to_lxoffice : $value,
 284       size   => 11, type => 'text', name => $name,
 285       %attributes,
 286       class => DATEPICKER, @onchange,
 287     ) .
 288     $label,
 289     class => [ grep $_, @classes, INPUT_FIELD ],
 290   );
 291 }
 292
 293 sub select_tag {
 294   my ($name, $collection, %attributes) = @_;
 295
 296
 297   _set_id_attribute(\%attributes, $name);
 298   my @size_classes   = _extract_classes(\%attributes, "size");
 299
 300
 301   my $icon  = $attributes{icon}
 302     ? icon(delete $attributes{icon}, class => 'prefix')
 303     : '';
 304
 305   my $label = $attributes{label}
 306     ? html_tag('label', delete $attributes{label}, for => $attributes{id}, class => 'active')
 307     : '';
 308
 309   my $select_html = SL::Presenter::Tag::select_tag($name, $collection, %attributes,
 310     class => 'browser-default');
 311
 312   html_tag('div',
 313     $icon . $select_html . $label,
 314     class => [ INPUT_FIELD, @size_classes ],
 315   );
 316 }
 317
 318 sub checkbox_tag {
 319   my ($name, %attributes) = @_;
 320
 321   _set_id_attribute(\%attributes, $name);
 322
 323   my $label = $attributes{label}
 324     ? html_tag('span', delete $attributes{label})
 325     : '';
 326
 327   my $checkbox_html = SL::Presenter::Tag::checkbox_tag($name, %attributes);
 328
 329   html_tag('label',
 330     $checkbox_html . $label,
 331   );
 332 }
 333
 334
 335 1;
 336 __END__
 337
 338 =pod
 339
 340 =encoding utf8
 341
 342 =head1 NAME
 343
 344 SL::Presenter::MaterialComponents - MaterialCSS Component wrapper
 345
 346 =head1 SYNOPSIS
 347
 348
 349 =head1 DESCRIPTION
 350
 351 This is a collection of components in the style of L<SL::Presenter::Tag>
 352 intended for materialzecss. They should be useable similarly to their original
 353 versions but be well-behaved for materialize.
 354
 355 They will also recognize some materialize conventions:
 356
 357 =over 4
 358
 359 =item icon>
 360
 361 Most elements can be decorated with an icon by supplying the C<icon> with the name.
 362
 363 =item grid classes
 364
 365 Grid classes like C<s12> or C<m6> can be given as keys with any truish value or
 366 directly as classes.
 367
 368 =back
 369
 370 =head1 BUGS & ISSUES
 371
 372 There is a bug in MaterializeCSS, when using a Materialize select element on an iphone,
 373 the wrong element is selected. This is currently worked around in the presenter by using
 374 the 'browser-default' class on the select element as well as the 'active' class on the
 375 label (to prevent the label from overlapping the select element).
 376 This should be fixed, upstream, in MaterializeCSS. However it seems that the project is
 377 not maintained anymore (according to github issues[^1]). There is a community fork[^2],
 378 which it's still maintained and where the problem seems to be fixed already. It is currently
 379 in alpha V. 2.0.3-alpha. Maybe it would be good to consider switching to that fork at some
 380 point.
 381
 382 [1]: e.g. https://github.com/Dogfalo/materialize/issues/6688
 383 [2]: https://github.com/materializecss/materialize
 384
 385 =head1 AUTHOR
 386
 387 Sven Schöling E<lt>s.schoeling@googlemail.comE<gt>
 388
 389 =cut