view release on metacpan or  search on metacpan

SAC.pm  view on Meta::CPAN

###
# CSS::SAC - a SAC implementation for Perl
# Robin Berjon <robin@knowscape.com>
# 17/08/2001 - bugfixes...
# 23/04/2001 - more enhancements
# 19/03/2001 - second version, various suggestions and enhancements
# 24/02/2001 - prototype mark I of the new model
###

package CSS::SAC;
use strict;
use vars qw(
            $VERSION
            $RE_STRING
            $RE_NAME
            $RE_IDENT
            $RE_RANGE
            $RE_NUM
            %DIM_MAP
            %FUNC_MAP
           );
$VERSION = '0.08';

use CSS::SAC::ConditionFactory  qw();
use CSS::SAC::SelectorFactory   qw();
use CSS::SAC::LexicalUnit       qw(:constants);
use CSS::SAC::Selector::Sibling qw(:constants);
use CSS::SAC::SelectorList      qw();

use Text::Balanced              qw();

use constant DEBUG => 0;

#---------------------------------------------------------------------#
# build a few useful regexen and maps
#---------------------------------------------------------------------#

# matches a quoted string
$RE_STRING = Text::Balanced::gen_delimited_pat(q{'"}); #"
$RE_STRING = qr/$RE_STRING/s;

# matches a name token
$RE_NAME = qr/
             (?:(?:\\(?:(?:[a-fA-F0-9]{1,6}[\t\x20])|[\x32-\xff]))|[a-zA-Z\x80-\xff0-9-])+
             /xs;

# matches a valid CSS ident (this may be wrong, needs testing)
$RE_IDENT = qr/
             (?:(?:\\(?:(?:[a-fA-F0-9]{1,6}[\t\x20])|[ \x32-\xff]))|[a-zA-Z\x80-\xff])
             (?:(?:\\(?:(?:[a-fA-F0-9]{1,6}[\t\x20])|[ \x32-\xff]))|[a-zA-Z\x80-\xff0-9_-])*
             /xs;

# matches a unicode range
$RE_RANGE = qr/(?:
                (?:U\+)
                (?:
                  (?:[0-9a-fA-F]{1,6}-[0-9a-fA-F]{1,6})
                  |
                  (?:\?{1,6})
                  |
                  (?:[0-9a-fA-F](?:
                  (?:\?{0,5}|[0-9a-fA-F])(?:
                  (?:\?{0,4}|[0-9a-fA-F])(?:
                  (?:\?{0,3}|[0-9a-fA-F])(?:
                  (?:\?{0,2}|[0-9a-fA-F])(?:
                  (?:\?{0,1}|[0-9a-fA-F])))))))
                )
               )
              /xs;


# matches a number
$RE_NUM = qr/(?:(?:[0-9]*\.[0-9]+)|(?:[0-9]+))/;


# maps a length or assoc value to it's constant
%DIM_MAP = (
            em      => EM,
            ex      => EX,
            px      => PIXEL,
            cm      => CENTIMETER,
            mm      => MILLIMETER,
            in      => INCH,
            pt      => POINT,
            pc      => PICA,
            deg     => DEGREE,
            rad     => RADIAN,
            grad    => GRADIAN,
            ms      => MILLISECOND,
            s       => SECOND,
            hz      => HERTZ,
            khz     => KILOHERTZ,
            '%'     => PERCENTAGE,
           );

# maps a length or assoc value to it's constant
%FUNC_MAP = (
            attr        => ATTR,
            counter     => COUNTER_FUNCTION,
            counters    => COUNTERS_FUNCTION,
            rect        => RECT_FUNCTION,
            url         => URI,
            rgb         => RGBCOLOR,
           );

#---------------------------------------------------------------------#


#---------------------------------------------------------------------#
# build the fields for an array based object
#---------------------------------------------------------------------#
use Class::ArrayObjects define => {
                                   fields => [qw(

SAC.pm  view on Meta::CPAN

        $sac->parse_comments($css);

        # exit conditions
        if (! length($$css) or $$css =~ m/^\s*(?:;|!)/ or ($att and $$css =~ s/^\s*(?:\))//)) {
            last;
        }

        # ops
        elsif ($$css =~ s{^\s*(,|/)\s*}{}) {
            $value = $1;
            if ($value eq ',') {
                $type = OPERATOR_COMMA;
                $text = 'comma';
            }
            else {
                $type = OPERATOR_SLASH;
                $text = 'slash';
            }
        }

        # special case empty op
        elsif ($$css =~ s{^\s+}{}) {
            next;
        }

        # inherit
        elsif ($$css =~ s/^inherit//) {
            $type = INHERIT;
            $text = 'inherit';
            $value = undef;
        }

        # lengths and assoc
        elsif ($$css =~ s/^((?:\+|-)?$RE_NUM)
                           (em|ex|px|cm|mm|in|pt|pc|deg|rad|grad|ms|s|hz|khz|%)
                         //xi) {
            $value = $1;
            $text = lc $2;
            $type = $DIM_MAP{$text};
        }

        # dimension
        elsif ($$css =~ s/^((?:\+|-)?$RE_NUM)($RE_IDENT)//) {
            $value = $1;
            $text = lc $2;
            $type = DIMENSION;
        }

        # number
        elsif ($$css =~ s/^((?:\+|-)?$RE_NUM)//) {
            $value = $1;
            $text = 'number';
            if ($value =~ m/\./) {
                $type = REAL;
            }
            else {
                $type = INTEGER;
            }
        }

        # unicode range
        elsif ($$css =~ s/^($RE_RANGE)//) {
            $value = $1;
            $text = 'unicode-range';
            $type = UNICODERANGE;
        }

        # hex rgb
        elsif ($$css =~ s/^#([0-9a-fA-F]{6}|[0-9a-fA-F]{3})//) {
            $value = $1;
            $text = '#';
            $type = RGBCOLOR;
        }

        # functions
#        elsif (
#                ($value,$$css,$text) = Text::Balanced::extract_bracketed($$css,q/()'"/,qr/$RE_IDENT/)
#                and
#                length $text
#              ) {
        elsif ($$css =~ s/^($RE_IDENT)\(//) {

            # cleanup the func and args
#            $text = lc $text;
#            $value =~ s/^\(\s*//;
#            $value =~ s/\s*\)$//;
#            $value =~ s/^(?:"|')//; #"
#            $value =~ s/(?:"|')$//; #"
            $text = lc $1;
            $value = $sac->parse_property_value($css, 1);

            # get the appropriate type
            if ($FUNC_MAP{$text}) {
                $type = $FUNC_MAP{$text};
            }
            else {
                $type = FUNCTION;
            }
        }

        # ident
        elsif ($$css =~ s/^($RE_IDENT)//) {
            $value = $1;
            $text = 'ident';
            $type = IDENT;
        }

        # string
        elsif ($$css =~ s/^($RE_STRING)//) {
            $value = $1;
            $value =~ s/^(?:"|')//; #"
            $value =~ s/(?:"|')$//; #"
            $text = 'string';
            $type = STRING_VALUE;
        }

        # error
        else {
            return [];
        }

        # add a lu
        push @lus, CSS::SAC::LexicalUnit->new($type,$text,$value);
    }