view release on metacpan or  search on metacpan

lib/CSS/Adaptor/Whitelist.pm  view on Meta::CPAN

package CSS::Adaptor::Whitelist;

use strict;
use CSS::Adaptor;
use parent 'CSS::Adaptor';

our $VERSION = '0.006';

sub log {
    my ($self, $msg) = @_;
    no strict 'refs';
    push @CSS::Adaptor::Whitelist::message_log, {
        timestamp => time,
        message => $msg,
    };
}

sub list2hash {
    return { map { $_ => 1 } @_ }
}

# this evaulates a string against a list of regular expressions
# like for the font or background properties
sub space_sep_res {
    my ($str, @res) = @_;
    while (@res) {
        my $re1 = shift @res;
        if ($str =~ /^$re1(.*)/) {
            my $rest = $1;
            if (length($rest) == 0) {
                return 1
            }
            elsif ($rest =~ s/^\s+//) {
                return space_sep_res($rest, @res)
            }
        }
    }
    return 0
}

# general
my $re_zero_to_one = qr/[01]\.?|0?\.\d+/;
my $re_percent = qr/(?: \d{1,2} \.? | \d{0,2} \. \d+ ) \%/x;
my $re_frac = qr/ \d* \. \d+ | \d+ \.? /x;
my $re_dim = qr/ $re_percent | (?:$re_frac) (?:p[ctx]|in|[cem]m|ex) \b | 0 \b /x;
my $re_ndim = qr/(?:-?$re_dim)/;
my $re_color_name = qr/(?i-xsm:\b(?:A(?:qua(?:marine)?|(?:liceBlu|ntiqueWhit|zur)e)|B(?:l(?:a(?:ck|nchedAlmond)|ue(?:Violet)?)|(?:eig|isqu)e|rown|urlyWood)|C(?:h(?:artreus|ocolat)e|or(?:n(?:flowerBlue|silk)|al)|adetBlue|(?:rimso|ya)n)|D(?:ark(?:G(?:r...
my $re_color = qr/(?:
      transparent \b
    | $re_color_name        # Blue
    | \#[\da-fA-F]{6} \b    # #FF00FF
    | \#[\da-fA-F]{3} \b    # #F0F
    | rgb\(  # rgb(255,0,255), rgb(255,0,255,0.3)
        (?: \d{1,3} | $re_percent ),
        (?: \d{1,3} | $re_percent ),
        (?: \d{1,3} | $re_percent )
        (?: , (?:$re_zero_to_one | $re_percent) )?
      \)
)/x;
my $re_url = qr{url\((?:http://[-\w+.]+/[-/\w.?%#]+)\)};
sub set_url_re {
    my ($new_re) = @_;
    if (ref($new_re) ne 'Regexp') {
        die 'set_url_re requires a compiled regular expression, e.g. qr/url(http:.*?)/'
    }
    else {
        $re_url = $new_re;
    }
}

# background
my $re_image = qr/(?:
      none \b
    | $re_url
)/x;
my $re_xy_pos = qr/(?:
    (?: left | center | right | $re_ndim ) \b
    (?: \s+
        (?: top | center | bottom | $re_ndim ) \b
    )?
)/x;
my $re_bg_attach = qr/(?:scroll\b|fixed\b)/;
my $re_bg_repeat = qr/(?:repeat(?:-[xy])?\b|no-repeat\b)/;

# border
my $re_border_width = qr/(?: thin\b | medium\b | thick\b | $re_dim )/x;
my $re_border_style = qr/(?: (?:none|hidden|dotted|dashed|solid|double|groove|ridge|inset|outset) \b )/x;
sub ck_border {
    space_sep_res(shift, $re_border_width, $re_border_style, $re_color)
}
my $re_border_radius = qr/(?: $re_dim ( \s+ $re_dim )? )/x;

# margin, padding
my $re_margin = qr/(?: auto \b | $re_ndim )/x;
my $re_margin_all = qr/(?: $re_margin ( \s+ $re_margin ){0,3} )/x;
my $re_padding_all = qr/(?: $re_ndim ( \s+ $re_ndim ){0,3} )/x;

# font
my $re_font_family = qr/(?: [-a-zA-Z0-9 ,"']+ \b )/x;  # maybe too generous, should we list possible families?
my $re_font_size = qr/(?: (?:x?x-)?(?:small|large)\b | small(?:er)? \b | larger? \b | medium \b | $re_dim )/x;
my $re_font_style = qr/(?: normal \b | oblique \b | italic \b )/x;
my $re_font_variant = qr/(?: normal \b | small-caps \b )/x;
my $re_font_weight = qr/(?: (?: normal | lighter | bold(?:er)? | \d{3} ) \b )/x;

# list style
my $re_list_style_position = qr/(?: (?:in|out)side \b )/x;
my $re_list_style_type = qr/(?: (?:
      none | circle | disc | square | armenian
    | decimal(?:-leading-zero)? | georgian | lower-greek | (?:lower|upper)-(?:alpha|latin|roman)