view release on metacpan or  search on metacpan

lib/CSS/DOM/Parser.pm  view on Meta::CPAN

	return $selector, \@selector;	
}}}

# This one takes optional extra args:
#  2) the style decl object to add properties to
#  3..) extra args to pass to the style obj’s constructor if 2 is undef
sub _parse_style_declaration { for (shift) { for my $tokens (shift) {
	# return if there isn’t one
	/^(?:$any_re|$block_re|[\@;]s?)*(?:}s?|\z)/x
	 or return;

	my $style = shift||new CSS::DOM::Style @_;

	{
		if(s/^is?:s?((?:$any_re|$block_re|\@s?)+)//) {
			my ($prop) = splice @$tokens, 0, $-[1];
			my $types = $1;
			my @tokens = splice @$tokens, 0, length $1;
			unless($types =~ /"/) { # ignore invalid strings
				$types =~ s/s\z// and pop @tokens;;
				$style->_set_property_tokens(
					unescape($prop),$types,\@tokens
				);
			}
			s/^;s?// and splice(@$tokens, 0, $+[0]), redo;
		}
		elsif(s/^;s?//) {
			splice @$tokens, 0, $+[0]; redo;
		}
		else {
			# Ignorable declaration
			s/^(?:$any_re|$block_re|\@s?)*//;
			splice @$tokens, 0, $+[0];
			s/^;s?// and splice(@$tokens, 0, $+[0]), redo;
		}
		# else last
	}

	return $style;
}}}

sub _expected {
	my $tokens = pop;
	croak
		"Syntax error: expected $_[0] but found '"
		.join('',@$tokens[
			0..(10<$#$tokens?10 : $#$tokens)
		]) . ($#$tokens > 10 ? '...' : '') . "'";
}

sub _decode { my $at; for(''.shift) {
# ~~~ Some of this is repetitive and could probably be compressed.
	require Encode;
	if(/^(\xef\xbb\xbf(\@charset "(.*?)";))/s) {
		my $enc = $3;
		my $dec = eval{Encode::decode($3, $1, 9)};
		if(defined $dec) {
			$dec =~ /^(\x{feff}?)$2\z/
				and return Encode::decode($enc,
					$1 ? substr $_, 3 : $_);
			$@ = $1?"Invalid BOM for $enc: \\xef\\xbb\\xbf"
		      	    :"\"$enc\" is encoded in ASCII but is not"
			     ." ASCII-based";
		}
	}
	elsif(/^\xef\xbb\xbf/) {
		return Encode::decode_utf8(substr $_,3);
	}
	elsif(/^(\@charset "(.*?)";)/s) {
		my $dec = eval{Encode::decode($2, $1, 9)};
		if(defined $dec) {
			$dec eq $1
				and return Encode::decode($2, $_);
			$@ = "\"$2\" is encoded in ASCII but is not "
				."ASCII-based";
		}
	}
	elsif(
	  /^(\xfe\xff(\0\@\0c\0h\0a\0r\0s\0e\0t\0 \0"((?:\0.)*?)\0"\0;))/s
	) {
		my $enc = Encode::decode('utf16be', $3);
		my $dec = eval{Encode::decode($enc, $1, 9)};
		if(defined $dec) {
			$dec =~ /^(\x{feff}?)\@charset "$enc";\z/
				and return Encode::decode($enc,
					$1 ? substr $_, 2 : $_);
			$@ = $1?"Invalid BOM for $enc: \\xfe\xff"
		      	    :"\"$enc\" is encoded in UCS-2 but is not"
			     ." UCS-2-based";
		}
	}
	elsif(
	  /^(\0\@\0c\0h\0a\0r\0s\0e\0t\0 \0"((?:\0.)*?)\0"\0;)/s
	) {
		my $origenc = my $enc = Encode::decode('utf16be', $2);
		my $dec = eval{Encode::decode($enc, $1, 9)};
		defined $dec or $dec
			= eval{Encode::decode($enc.='-be', $1, 9)};
		if(defined $dec) {
			$dec eq "\@charset \"$origenc\";"
				and return Encode::decode($enc, $_);
			$@ ="\"$origenc\" is encoded in UCS-2 but is not "
				."UCS-2-based";
		}
	}
	elsif(
	  /^(\xff\xfe(\@\0c\0h\0a\0r\0s\0e\0t\0 \0"\0((?:.\0)*?)"\0;\0))/s
	) {
		my $enc = Encode::decode('utf16le', $3);
		my $dec = eval{Encode::decode($enc, $1, 9)};
		if(defined $dec) {
			$dec =~ /^(\x{feff}?)\@charset "$enc";\z/
				and return Encode::decode($enc,
					$1 ? substr $_, 2 : $_);
			$@ = $1?"Invalid BOM for $enc: \\xfe\xff"
		      	    :"\"$enc\" is encoded in UCS-2-LE but is not"
			     ." UCS-2-LE-based";
		}
	}
	elsif(
	  /^(\@\0c\0h\0a\0r\0s\0e\0t\0 \0"\0((?:.\0)*?)"\0;\0)/s
	) {
		my $origenc = my $enc = Encode::decode('utf16le', $2);
		my $dec = eval{Encode::decode($enc, $1, 9)};
		!defined $dec || $dec !~ /^\@/ and $dec
			= eval{Encode::decode($enc.='-le', $1, 9)};
		if(defined $dec) {
			$dec eq "\@charset \"$origenc\";"
				and return Encode::decode($enc, $_);
			$@ ="\"$enc\" is encoded in UCS-2-LE but is not "
				."UCS-2-LE-based";
		}
	}
	elsif(
	  /^(\0\0\xfe\xff(\0{3}\@\0{3}c\0{3}h\0{3}a\0{3}r\0{3}s\0{3}e\0{3}t
	     \0{3}\ \0{3}"((?:\0{3}.)*?)\0{3}"\0{3};))/sx
	) {
		my $enc = Encode::decode('utf32be', $3);
		my $dec = eval{Encode::decode($enc, $1, 9)};
		if(defined $dec) {
			$dec =~ /^(\x{feff}?)\@charset "$enc";\z/
				and return Encode::decode($enc,
					$1 ? substr $_, 2 : $_);
			$@ = $1?"Invalid BOM for $enc: \\xfe\xff"
		      	    :"\"$enc\" is encoded in UTF-32-BE but is not"
			     ." UTF-32-BE-based";
		}
	}
	elsif(
	  /^(\0{3}\@\0{3}c\0{3}h\0{3}a\0{3}r\0{3}s\0{3}e\0{3}t
	     \0{3}\ \0{3}"((?:\0{3}.)*?)\0{3}"\0{3};)/sx
	) {
		my $origenc = my $enc = Encode::decode('utf32be', $2);
		my $dec = eval{Encode::decode($enc, $1, 9)};
		defined $dec or $dec
			= eval{Encode::decode($enc.='-be', $1, 9)};
		if(defined $dec) {
			$dec eq "\@charset \"$origenc\";"
				and return Encode::decode($enc, $_);
			$@ ="\"$enc\" is encoded in UTF-32-BE but is not "
				."UTF-32-BE-based";
		}
	}
	elsif(
	  /^(\xff\xfe\0\0(\@\0{3}c\0{3}h\0{3}a\0{3}r\0{3}s\0{3}e\0{3}t
	     \0{3}\ \0{3}"\0{3}((?:.\0{3})*?)"\0{3};\0{3}))/sx
	) {
		my $enc = Encode::decode('utf32le', $3);
		my $dec = eval{Encode::decode($enc, $1, 9)};
		if(defined $dec) {
			$dec =~ /^(\x{feff}?)\@charset "$enc";\z/
				and return Encode::decode($enc,
					$1 ? substr $_, 2 : $_);
			$@ = $1?"Invalid BOM for $enc: \\xfe\xff"
		      	    :"\"$enc\" is encoded in UTF-32-LE but is not"
			     ." UTF-32-LE-based";
		}
	}
	elsif(
	  /^(\@\0{3}c\0{3}h\0{3}a\0{3}r\0{3}s\0{3}e\0{3}t
	     \0{3}\ \0{3}"\0{3}((?:.\0{3})*?)"\0{3};\0{3})/sx
	) {
		my $origenc = my $enc = Encode::decode('utf32le', $2);
		my $dec = eval{Encode::decode($enc, $1, 9)};
		!defined $dec || $dec !~ /^\@/ and $dec
			= eval{Encode::decode($enc.='-le', $1, 9)};
		if(defined $dec) {
			$dec eq "\@charset \"$origenc\";"
				and return Encode::decode($enc, $_);
			$@ ="\"$enc\" is encoded in UTF-32-LE but is not "
				."UTF-32-LE-based";
		}
	}
	elsif(/^(?:\0\0\xfe\xff|\xff\xfe\0\0)/) {
		return Encode::decode('utf32', $_);
	}
	elsif(/^(?:\xfe\xff|\xff\xfe)/) {
		return Encode::decode('utf16', $_);
	}
	elsif(
	  /^(\|\x83\x88\x81\x99\xa2\x85\xa3\@\x7f(.*?)\x7f\^)/s
	) {
		my $enc = Encode::decode('cp37', $2);
		my $dec = eval{Encode::decode($enc, $1, 9)};
		if(defined $dec) {
			$dec eq "\@charset \"$enc\";"
				and return Encode::decode($enc, $_);
			$@ ="\"$enc\" is encoded in EBCDIC but is not "
				."EBCDIC-based";
		}
	}
	elsif(
	  /^(\xae\x83\x88\x81\x99\xa2\x85\xa3\@\xfc(.*?)\xfc\^)/s
	) {
		my $enc = Encode::decode('cp1026', $2);
		my $dec = eval{Encode::decode($enc, $1, 9)};
		if(defined $dec) {
			$dec eq "\@charset \"$enc\";"
				and return Encode::decode($enc, $_);
			$@ ="\"$enc\" is encoded in IBM1026 but is not "
				."IBM1026-based";
		}
	}
	elsif(
	  /^(\0charset "(.*?)";)/s
	) {
		my $enc = Encode::decode('gsm0338', $2);
		my $dec = eval{Encode::decode($enc, $1, 9)};
		if(defined $dec) {
			$dec eq "\@charset \"$enc\";"
				and return Encode::decode($enc, $_);
			$@ ="\"$enc\" is encoded in GSM 0338 but is not "
				."GSM 0338-based";
		}