lib/CSS/Declare.pm

   1 package CSS::Declare;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Perl6::Gather;
   7
   8 my $IN_SCOPE = 0;
   9
  10 sub import {
  11   die "Can't import CSS::Declare into a scope when already compiling one that uses it"
  12     if $IN_SCOPE;
  13   my ($class, @args) = @_;
  14   my $opts = shift(@args) if ref($args[0]) eq 'HASH';
  15   my $target = $class->_find_target(0, $opts);
  16   my $unex = $class->_export_tags_into($target);
  17   $class->_install_unexporter($unex);
  18   $IN_SCOPE = 1;
  19 }
  20
  21 sub _find_target {
  22   my ($class, $extra_levels, $opts) = @_;
  23   return $opts->{into} if defined($opts->{into});
  24   my $level = ($opts->{into_level} || 1) + $extra_levels;
  25   return (caller($level))[0];
  26 }
  27
  28 my @properties = qw{
  29 accelerator
  30 azimuth
  31 background
  32 background_attachment
  33 background_color
  34 background_image
  35 background_position
  36 background_position_x
  37 background_position_y
  38 background_repeat
  39 behavior
  40 border
  41 border_bottom
  42 border_bottom_color
  43 border_bottom_style
  44 border_bottom_width
  45 border_collapse
  46 border_color
  47 border_left
  48 border_left_color
  49 border_left_style
  50 border_left_width
  51 border_right
  52 border_right_color
  53 border_right_style
  54 border_right_width
  55 border_spacing
  56 border_style
  57 border_top
  58 border_top_color
  59 border_top_style
  60 border_top_width
  61 border_width
  62 bottom
  63 caption_side
  64 clear
  65 clip
  66 color
  67 content
  68 counter_increment
  69 counter_reset
  70 cue
  71 cue_after
  72 cue_before
  73 cursor
  74 direction
  75 display
  76 elevation
  77 empty_cells
  78 filter
  79 float
  80 font
  81 font_family
  82 font_size
  83 font_size_adjust
  84 font_stretch
  85 font_style
  86 font_variant
  87 font_weight
  88 height
  89 ime_mode
  90 include_source
  91 layer_background_color
  92 layer_background_image
  93 layout_flow
  94 layout_grid
  95 layout_grid_char
  96 layout_grid_char_spacing
  97 layout_grid_line
  98 layout_grid_mode
  99 layout_grid_type
 100 left
 101 letter_spacing
 102 line_break
 103 line_height
 104 list_style
 105 list_style_image
 106 list_style_position
 107 list_style_type
 108 margin
 109 margin_bottom
 110 margin_left
 111 margin_right
 112 margin_top
 113 marker_offset
 114 marks
 115 max_height
 116 max_width
 117 min_height
 118 min_width
 119 orphans
 120 outline
 121 outline_color
 122 outline_style
 123 outline_width
 124 overflow
 125 overflow_X
 126 overflow_Y
 127 padding
 128 padding_bottom
 129 padding_left
 130 padding_right
 131 padding_top
 132 page
 133 page_break_after
 134 page_break_before
 135 page_break_inside
 136 pause
 137 pause_after
 138 pause_before
 139 pitch
 140 pitch_range
 141 play_during
 142 position
 143 quotes
 144 _replace
 145 richness
 146 right
 147 ruby_align
 148 ruby_overhang
 149 ruby_position
 150 size
 151 speak
 152 speak_header
 153 speak_numeral
 154 speak_punctuation
 155 speech_rate
 156 stress
 157 scrollbar_arrow_color
 158 scrollbar_base_color
 159 scrollbar_dark_shadow_color
 160 scrollbar_face_color
 161 scrollbar_highlight_color
 162 scrollbar_shadow_color
 163 scrollbar_3d_light_color
 164 scrollbar_track_color
 165 table_layout
 166 text_align
 167 text_align_last
 168 text_decoration
 169 text_indent
 170 text_justify
 171 text_overflow
 172 text_shadow
 173 text_transform
 174 text_autospace
 175 text_kashida_space
 176 text_underline_position
 177 top
 178 unicode_bidi
 179 vertical_align
 180 visibility
 181 voice_family
 182 volume
 183 white_space
 184 widows
 185 width
 186 word_break
 187 word_spacing
 188 word_wrap
 189 writing_mode
 190 z_index
 191 zoom
 192 };
 193
 194 sub _export_tags_into {
 195   my ($class, $into) = @_;
 196    for my $property (@properties) {
 197       my $property_name = $property;
 198       $property_name =~ tr/_/-/;
 199       no strict 'refs';
 200       *{"$into\::$property"} = sub ($) { return ($property_name => $_[0]) };
 201    }
 202   return sub {
 203     foreach my $property (@properties) {
 204       no strict 'refs';
 205       delete ${"${into}::"}{$property}
 206     }
 207     $IN_SCOPE = 0;
 208   };
 209 }
 210
 211 sub _install_unexporter {
 212   my ($class, $unex) = @_;
 213   $^H |= 0x120000; # localize %^H
 214   $^H{'CSS::Declare::Unex'} = bless($unex, 'CSS::Declare::Unex');
 215 }
 216
 217 sub to_css_string {
 218    my @css = @_;
 219    return join q{ }, gather {
 220       while (my ($selector, $declarations) = splice(@css, 0, 2)) {
 221          take "$selector "._generate_declarations($declarations)
 222       }
 223    };
 224 }
 225
 226 sub _generate_declarations {
 227    my $declarations = shift;
 228
 229    return '{'.join(q{;}, gather {
 230       while (my ($property, $value) = splice(@{$declarations}, 0, 2)) {
 231          take "$property:$value"
 232       }
 233    }).'}';
 234 }
 235
 236 package CSS::Declare::Unex;
 237
 238 sub DESTROY { local $@; eval { $_[0]->(); 1 } || warn "ARGH: $@" }
 239
 240 1;