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
  30 use constant WAVES_EFFECT    => 'waves-effect';
  31 use constant WAVES_LIGHT     => 'waves-light';
  32
  33
  34 my %optional_classes = (
  35   button => {
  36     disabled => DISABLED,
  37     flat     => BUTTON_FLAT,
  38     floating => BUTTON_FLOATING,
  39     large    => BUTTON_LARGE,
  40     small    => BUTTON_SMALL,
  41   },
  42   icon => {
  43     left   => LEFT,
  44     right  => RIGHT,
  45     large  => LARGE,
  46     medium => MEDIUM,
  47     small  => SMALL,
  48     tiny   => TINY,
  49   },
  50 );
  51
  52 use Carp;
  53
  54 sub _confirm_js {
  55   'if (!confirm("'. _J($_[0]) .'")) return false;'
  56 }
  57
  58 sub _confirm_to_onclick {
  59   my ($attributes, $onclick) = @_;
  60
  61   if ($attributes->{confirm}) {
  62     $$onclick //= '';
  63     $$onclick = _confirm_js(delete($attributes->{confirm})) . $attributes->{onlick};
  64   }
  65 }
  66
  67 # used to extract material properties that need to be translated to classes
  68 # supports prefixing for delegation
  69 # returns a list of classes, mutates the attributes
  70 sub _extract_attribute_classes {
  71   my ($attributes, $type, $prefix) = @_;
  72
  73   my @classes;
  74   my $attr;
  75   for my $key (keys %$attributes) {
  76     if ($prefix) {
  77       next unless $key =~ /^${prefix}_(.*)/;
  78       $attr = $1;
  79     } else {
  80       $attr = $key;
  81     }
  82
  83     if ($optional_classes{$type}{$attr}) {
  84       $attributes->{$key} = undef;
  85       push @classes, $optional_classes{$type}{$attr};
  86     }
  87   }
  88
  89   # delete all undefined values
  90   my @delete_keys = grep { !defined $attributes->{$_} } keys %$attributes;
  91   delete $attributes->{$_} for @delete_keys;
  92
  93   @classes;
  94 }
  95
  96 sub button_tag {
  97   my ($onclick, $value, %attributes) = @_;
  98
  99   _set_id_attribute(\%attributes, $attributes{name}) if $attributes{name};
 100   _confirm_to_onclick(\%attributes, \$onclick);
 101
 102   my @button_classes = _extract_attribute_classes(\%attributes, "button");
 103   my @icon_classes   = _extract_attribute_classes(\%attributes, "icon", "icon");
 104
 105   $attributes{class} = [
 106     grep { $_ } $attributes{class}, WAVES_EFFECT, WAVES_LIGHT, BUTTON, @button_classes
 107   ];
 108
 109   if ($attributes{icon}) {
 110     $value = icon(delete $attributes{icon}, class => \@icon_classes)
 111            . $value;
 112   }
 113
 114   html_tag('a', $value, %attributes, onclick => $onclick);
 115 }
 116
 117 sub submit_tag {
 118   my ($name, $value, %attributes) = @_;
 119
 120   _set_id_attribute(\%attributes, $attributes{name}) if $attributes{name};
 121   _confirm_to_onclick(\%attributes, \($attributes{onclick} //= ''));
 122
 123   my @button_classes = _extract_attribute_classes(\%attributes, "button");
 124   my @icon_classes   = _extract_attribute_classes(\%attributes, "icon", "icon");
 125
 126   $attributes{class} = [
 127     grep { $_ } $attributes{class}, WAVES_EFFECT, WAVES_LIGHT, BUTTON, @button_classes
 128   ];
 129
 130   if ($attributes{icon}) {
 131     $value = icon(delete $attributes{icon}, class => \@icon_classes)
 132            . $value;
 133   }
 134
 135   html_tag('button', $value, type => 'submit',  %attributes);
 136 }
 137
 138
 139 sub icon {
 140   my ($name, %attributes) = @_;
 141
 142   my @icon_classes = _extract_attribute_classes(\%attributes, "icon");
 143
 144   html_tag('i', $name, class => [ grep { $_ } MATERIAL_ICONS, @icon_classes, delete $attributes{class} ], %attributes);
 145 }
 146
 147
 148 sub input_tag {
 149   my ($name, $value, %attributes) = @_;
 150
 151   # todo icons
 152   # todo label/active
 153   # todo validate
 154
 155   html_tag('input', $name, $value, %attributes) . html_tag('label', for => $attributes{id}, $name);
 156 }
 157
 158
 159 1;
 160 __END__
 161
 162 =pod
 163
 164 =encoding utf8
 165
 166 =head1 NAME
 167
 168 SL::Presenter::MaterialComponents - MaterialCSS Component wrapper
 169
 170 =head1 SYNOPSIS
 171
 172
 173 =head1 DESCRIPTION
 174
 175 =head1 BUGS
 176
 177 Nothing here yet.
 178
 179 =head1 AUTHOR
 180
 181 Sven Schöling E<lt>s.schoeling@googlemail.comE<gt>
 182
 183 =cut