From: Arthur Axel 'fREW' Schmidt Date: Sat, 5 Dec 2009 09:35:10 +0000 (-0600) Subject: Merge branch 'css_declare' X-Git-Tag: v0.003~21 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=70b55a60a1add5a96aa09711648b57ef8e3c4c07;hp=bf8b2de8feaede508df35b7741f3a0afe68e5c26;p=catagits%2FWeb-Simple.git Merge branch 'css_declare' --- diff --git a/Makefile.PL b/Makefile.PL index 30db0fc..b8a521e 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -3,5 +3,6 @@ use warnings FATAL => 'all'; use inc::Module::Install 0.91; all_from 'lib/Web/Simple.pm'; +requires 'Perl6::Gather'; WriteAll; diff --git a/lib/CSS/Declare.pm b/lib/CSS/Declare.pm new file mode 100644 index 0000000..48b14ce --- /dev/null +++ b/lib/CSS/Declare.pm @@ -0,0 +1,240 @@ +package CSS::Declare; + +use strict; +use warnings; + +use Perl6::Gather; + +my $IN_SCOPE = 0; + +sub import { + die "Can't import CSS::Declare into a scope when already compiling one that uses it" + if $IN_SCOPE; + my ($class, @args) = @_; + my $opts = shift(@args) if ref($args[0]) eq 'HASH'; + my $target = $class->_find_target(0, $opts); + my $unex = $class->_export_tags_into($target); + $class->_install_unexporter($unex); + $IN_SCOPE = 1; +} + +sub _find_target { + my ($class, $extra_levels, $opts) = @_; + return $opts->{into} if defined($opts->{into}); + my $level = ($opts->{into_level} || 1) + $extra_levels; + return (caller($level))[0]; +} + +my @properties = qw{ +accelerator +azimuth +background +background_attachment +background_color +background_image +background_position +background_position_x +background_position_y +background_repeat +behavior +border +border_bottom +border_bottom_color +border_bottom_style +border_bottom_width +border_collapse +border_color +border_left +border_left_color +border_left_style +border_left_width +border_right +border_right_color +border_right_style +border_right_width +border_spacing +border_style +border_top +border_top_color +border_top_style +border_top_width +border_width +bottom +caption_side +clear +clip +color +content +counter_increment +counter_reset +cue +cue_after +cue_before +cursor +direction +display +elevation +empty_cells +filter +float +font +font_family +font_size +font_size_adjust +font_stretch +font_style +font_variant +font_weight +height +ime_mode +include_source +layer_background_color +layer_background_image +layout_flow +layout_grid +layout_grid_char +layout_grid_char_spacing +layout_grid_line +layout_grid_mode +layout_grid_type +left +letter_spacing +line_break +line_height +list_style +list_style_image +list_style_position +list_style_type +margin +margin_bottom +margin_left +margin_right +margin_top +marker_offset +marks +max_height +max_width +min_height +min_width +orphans +outline +outline_color +outline_style +outline_width +overflow +overflow_X +overflow_Y +padding +padding_bottom +padding_left +padding_right +padding_top +page +page_break_after +page_break_before +page_break_inside +pause +pause_after +pause_before +pitch +pitch_range +play_during +position +quotes +_replace +richness +right +ruby_align +ruby_overhang +ruby_position +size +speak +speak_header +speak_numeral +speak_punctuation +speech_rate +stress +scrollbar_arrow_color +scrollbar_base_color +scrollbar_dark_shadow_color +scrollbar_face_color +scrollbar_highlight_color +scrollbar_shadow_color +scrollbar_3d_light_color +scrollbar_track_color +table_layout +text_align +text_align_last +text_decoration +text_indent +text_justify +text_overflow +text_shadow +text_transform +text_autospace +text_kashida_space +text_underline_position +top +unicode_bidi +vertical_align +visibility +voice_family +volume +white_space +widows +width +word_break +word_spacing +word_wrap +writing_mode +z_index +zoom +}; + +sub _export_tags_into { + my ($class, $into) = @_; + for my $property (@properties) { + my $property_name = $property; + $property_name =~ tr/_/-/; + no strict 'refs'; + *{"$into\::$property"} = sub ($) { return ($property_name => $_[0]) }; + } + return sub { + foreach my $property (@properties) { + no strict 'refs'; + delete ${"${into}::"}{$property} + } + $IN_SCOPE = 0; + }; +} + +sub _install_unexporter { + my ($class, $unex) = @_; + $^H |= 0x120000; # localize %^H + $^H{'CSS::Declare::Unex'} = bless($unex, 'CSS::Declare::Unex'); +} + +sub to_css_string { + my @css = @_; + return join q{ }, gather { + while (my ($selector, $declarations) = splice(@css, 0, 2)) { + take "$selector "._generate_declarations($declarations) + } + }; +} + +sub _generate_declarations { + my $declarations = shift; + + return '{'.join(q{;}, gather { + while (my ($property, $value) = splice(@{$declarations}, 0, 2)) { + take "$property:$value" + } + }).'}'; +} + +package CSS::Declare::Unex; + +sub DESTROY { local $@; eval { $_[0]->(); 1 } || warn "ARGH: $@" } + +1; diff --git a/lib/HTML/Tags.pm b/lib/HTML/Tags.pm index de71d2c..fabaab5 100644 --- a/lib/HTML/Tags.pm +++ b/lib/HTML/Tags.pm @@ -5,19 +5,109 @@ use warnings FATAL => 'all'; use XML::Tags (); my @HTML_TAGS = qw( - h1 h2 h3 h4 h5 h6 p br hr ol ul li dl dt dd menu code var strong em tt - u i b blockquote pre img a address cite samp dfn html head base body - link nextid title meta kbd start_html end_html input select option - comment charset escapehtml div table caption th td tr tr sup sub - strike applet param nobr embed basefont style span layer ilayer font - frameset frame script small big area map abbr acronym bdo col colgroup - del fieldset iframe ins label legend noframes noscript object optgroup - q thead tbody tfoot blink fontsize center textfield textarea filefield - password_field hidden checkbox checkbox_group submit reset defaults - radio_group popup_menu button autoescape scrolling_list image_button - start_form end_form startform endform start_multipart_form - end_multipart_form isindex tmpfilename uploadinfo url_encoded - multipart form canvas +a +abbr +address +area +article +aside +audio +b +base +bb +bdo +blockquote +body +br +button +canvas +caption +cite +code +col +colgroup +command +datagrid +datalist +dd +del +details +dialog +dfn +div +dl +dt +em +embed +eventsource +fieldset +figure +footer +form +h1 +h2 +h3 +h4 +h5 +h6 +head +header +hr +html +i +iframe +img +input +ins +kbd +label +legend +li +link +mark +map +menu +meta +meter +nav +noscript +object +ol +optgroup +option +output +p +param +pre +progress +q +ruby +rp +rt +samp +script +section +select +small +source +span +strong +style +sub +sup +table +tbody +td +textarea +tfoot +th +thead +time +title +tr +ul +var +video ); sub import { diff --git a/t/css_declare.t b/t/css_declare.t new file mode 100644 index 0000000..f681508 --- /dev/null +++ b/t/css_declare.t @@ -0,0 +1,23 @@ +use strict; use warnings FATAL => 'all'; +use Test::More qw(no_plan); + +{ + + package Foo; + sub foo { + use CSS::Declare; + return ( + '*' => [ color 'red' ], + 'tr, td' => [ margin '1px' ], + ); + } +} + +is( + CSS::Declare::to_css_string(Foo::foo()), + '* {color:red} tr, td {margin:1px}', + 'Basic CSS::Declare usage' +); + +ok(!Foo->can('color'), 'Death on use of unimported tag'); +