SL/Presenter/MaterialComponents.pm

   1 package SL::Presenter::MaterialComponents;
   2
   3 use strict;
   4
   5 use SL::HTML::Restrict;
   6 use SL::Presenter::EscapedText qw(escape);
   7 use SL::Presenter::Tag qw(html_tag);
   8 use Scalar::Util qw(blessed);
   9
  10 use Exporter qw(import);
  11 our @EXPORT_OK = qw(
  12   button_tag
  13 );
  14 our %EXPORT_TAGS = (ALL => \@EXPORT_OK);
  15
  16 use constant BUTTON          => 'btn';
  17 use constant BUTTON_FLAT     => 'btn-flat';
  18 use constant BUTTON_FLOATING => 'btn-floating';
  19 use constant BUTTON_LARGE    => 'btn-large';
  20 use constant BUTTON_SMALL    => 'btn-small';
  21 use constant DISABLED        => 'disabled';
  22 use constant LEFT            => 'left';
  23 use constant MATERIAL_ICONS  => 'material-icons';
  24 use constant RIGHT           => 'right';
  25 use constant LARGE           => 'large';
  26 use constant MEDIUM          => 'medium';
  27 use constant SMALL           => 'small';
  28 use constant TINY            => 'tiny';
  29 use constant INPUT_FIELD     => 'input-field';
  30
  31 use constant WAVES_EFFECT    => 'waves-effect';
  32 use constant WAVES_LIGHT     => 'waves-light';
  33
  34
  35 my %optional_classes = (
  36   button => {
  37     disabled => DISABLED,
  38     flat     => BUTTON_FLAT,
  39     floating => BUTTON_FLOATING,
  40     large    => BUTTON_LARGE,
  41     small    => BUTTON_SMALL,
  42   },
  43   icon => {
  44     left   => LEFT,
  45     right  => RIGHT,
  46     large  => LARGE,
  47     medium => MEDIUM,
  48     small  => SMALL,
  49     tiny   => TINY,
  50   },
  51 );
  52
  53 use Carp;
  54
  55 sub _confirm_js {
  56   'if (!confirm("'. _J($_[0]) .'")) return false;'
  57 }
  58
  59 sub _confirm_to_onclick {
  60   my ($attributes, $onclick) = @_;
  61
  62   if ($attributes->{confirm}) {
  63     $$onclick //= '';
  64     $$onclick = _confirm_js(delete($attributes->{confirm})) . $attributes->{onlick};
  65   }
  66 }
  67
  68 # used to extract material properties that need to be translated to classes
  69 # supports prefixing for delegation
  70 # returns a list of classes, mutates the attributes
  71 sub _extract_attribute_classes {
  72   my ($attributes, $type, $prefix) = @_;
  73
  74   my @classes;
  75   my $attr;
  76   for my $key (keys %$attributes) {
  77     if ($prefix) {
  78       next unless $key =~ /^${prefix}_(.*)/;
  79       $attr = $1;
  80     } else {
  81       $attr = $key;
  82     }
  83
  84     if ($optional_classes{$type}{$attr}) {
  85       $attributes->{$key} = undef;
  86       push @classes, $optional_classes{$type}{$attr};
  87     }
  88   }
  89
  90   # delete all undefined values
  91   my @delete_keys = grep { !defined $attributes->{$_} } keys %$attributes;
  92   delete $attributes->{$_} for @delete_keys;
  93
  94   @classes;
  95 }
  96
  97 sub _set_id_attribute {
  98   my ($attributes, $name, $unique) = @_;
  99
 100   if (!delete($attributes->{no_id}) && !$attributes->{id}) {
 101     $attributes->{id}  = name_to_id($name);
 102     $attributes->{id} .= '_' . $attributes->{value} if $unique;
 103   }
 104
 105   %{ $attributes };
 106 }
 107
 108 { # This will give you an id for identifying html tags and such.
 109   # It's guaranteed to be unique unless you exceed 10 mio calls per request.
 110   # Do not use these id's to store information across requests.
 111 my $_id_sequence = int rand 1e7;
 112 sub _id {
 113   return ( $_id_sequence = ($_id_sequence + 1) % 1e7 );
 114 }
 115 }
 116
 117 sub name_to_id {
 118   my ($name) = @_;
 119
 120   if (!$name) {
 121     return "id_" . _id();
 122   }
 123
 124   $name =~ s/\[\+?\]/ _id() /ge; # give constructs with [] or [+] unique ids
 125   $name =~ s/[^\w_]/_/g;
 126   $name =~ s/_+/_/g;
 127
 128   return $name;
 129 }
 130
 131 sub button_tag {
 132   my ($onclick, $value, %attributes) = @_;
 133
 134   _set_id_attribute(\%attributes, $attributes{name}) if $attributes{name};
 135   _confirm_to_onclick(\%attributes, \$onclick);
 136
 137   my @button_classes = _extract_attribute_classes(\%attributes, "button");
 138   my @icon_classes   = _extract_attribute_classes(\%attributes, "icon", "icon");
 139
 140   $attributes{class} = [
 141     grep { $_ } $attributes{class}, WAVES_EFFECT, WAVES_LIGHT, BUTTON, @button_classes
 142   ];
 143
 144   if ($attributes{icon}) {
 145     $value = icon(delete $attributes{icon}, class => \@icon_classes)
 146            . $value;
 147   }
 148
 149   html_tag('a', $value, %attributes, onclick => $onclick);
 150 }
 151
 152 sub submit_tag {
 153   my ($name, $value, %attributes) = @_;
 154
 155   _set_id_attribute(\%attributes, $attributes{name}) if $attributes{name};
 156   _confirm_to_onclick(\%attributes, \($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('button', $value, type => 'submit',  %attributes);
 171 }
 172
 173
 174 sub icon {
 175   my ($name, %attributes) = @_;
 176
 177   my @icon_classes = _extract_attribute_classes(\%attributes, "icon");
 178
 179   html_tag('i', $name, class => [ grep { $_ } MATERIAL_ICONS, @icon_classes, delete $attributes{class} ], %attributes);
 180 }
 181
 182
 183 sub input_tag {
 184   my ($name, $value, %attributes) = @_;
 185
 186   _set_id_attribute(\%attributes, $attributes{name});
 187
 188   my $class = delete %attributes{class};
 189   my $icon  = $attributes{icon}
 190     ? icon(delete $attributes{icon}, class => 'prefix')
 191     : '';
 192
 193   my $label = $attributes{label}
 194     ? html_tag('label', delete $attributes{label}, for => $attributes{id})
 195     : '';
 196
 197   $attributes{type} //= 'text';
 198
 199   html_tag('div',
 200     $icon .
 201     html_tag('input', undef, value => $value, %attributes, name => $name) .
 202     $label,
 203     class => [ grep $_, $class, INPUT_FIELD ],
 204   );
 205 }
 206
 207
 208 }
 209
 210
 211 1;
 212 __END__
 213
 214 =pod
 215
 216 =encoding utf8
 217
 218 =head1 NAME
 219
 220 SL::Presenter::MaterialComponents - MaterialCSS Component wrapper
 221
 222 =head1 SYNOPSIS
 223
 224
 225 =head1 DESCRIPTION
 226
 227 =head1 BUGS
 228
 229 Nothing here yet.
 230
 231 =head1 AUTHOR
 232
 233 Sven Schöling E<lt>s.schoeling@googlemail.comE<gt>
 234
 235 =cut