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