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