view release on metacpan or  search on metacpan

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

package CSS::DOM;

use 5.008002;

$VERSION = '0.17';

use   # to keep CPANTS happy :-)
   strict;
use   # same here
   warnings;

use CSS::DOM::Exception
	'SYNTAX_ERR' ,'HIERARCHY_REQUEST_ERR', 'INDEX_SIZE_ERR';
use CSS::DOM::Constants 'STYLE_RULE';
use Scalar::Util 'weaken';

require CSS::DOM::RuleList;

use constant 1.03 our $_constants = {
	ruls => 0,
	ownr => 1, # owner rule
	node => 2, # owner node
	dsbl => 3,
	hrfe => 4,
	medi => 5,
	fetc => 6, # url fetcher
	prsh => 7, # parent sheet
	prpp => 8, # property parser
};
{ no strict; delete @CSS::DOM::{_constants => keys %{our $_constants}} }


# NON-DOM METHODS

# classy method
sub new {
	my $self = bless[],shift;
	my %args = @_;
	if(defined(my $arg = delete $args{url_fetcher})) {
		$self->[fetc] = $arg;
	}
	$self->[prpp] = delete $args{property_parser};
	$self;
}

# objectionable methods
sub url_fetcher {
	my $old = (my$ self = shift)->[fetc];
	$ self -> [ fetc ] = shift if @ _ ;
	$old
}
sub property_parser { shift->[prpp] }


# FUNCTIONS

sub parse {
	require CSS::DOM::Parser;
	goto &CSS::DOM::Parser::parse;
}

sub compute_style {
	my %args = @_;
	# ~~~ for now we just ignore medium/height/width/ppi. We need to
	#     support those, too.

	require CSS::DOM::Style;
	my $style = new CSS::DOM::Style;

	my $elem = delete $args{element};
	my $pseudo = delete $args{pseudo};
	$pseudo && $pseudo =~ s/^::?//;
	
	# The specificity returned by the style rule is a three-character
	# string representing the number of id, attr, and elem selector

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

		while(@rules) {
			my $r = shift @rules;
			my $type = $r->type;
			if($type == STYLE_RULE) {
				next unless
				  my $specificity = $r->_selector_matches(
				    $elem, $pseudo
				  );
				my $sty = $r->style;
				for(0..$sty->length-1) {
					my $p = $sty->item($_);
					my $spec = (
					 $sty->getPropertyPriority($p)
					  =~
					 /^important\z/i
					 ? $i : $n
					) . "\0$specificity";
					no warnings 'uninitialized';
					$spec ge $specificity{$p} and
					  $style->setProperty(
					   $p, $sty->getPropertyValue($p)
					  ),
					  $specificity{$p} = $spec;
				}
			}
		}
	}
	
	my $sty = $elem->style;
	for(0..$sty->length-1) {
					my $p = $sty->item($_);
					my $spec = (
					 $sty->getPropertyPriority($p)
					  =~
					 /^important\z/i
					 ? "\4" : "\3"
					) . "\1\0\0\0";
					no warnings 'uninitialized';
					$spec ge $specificity{$p} and
					  $style->setProperty(
					   $p, $sty->getPropertyValue($p)
					  ),
					  $specificity{$p} = $spec;
	}

	return $style;
}


# DOM STUFF:

# StyleSheet interface:

sub type { 'text/css' }
sub disabled {
	my $old = (my $self = shift) ->[dsbl];
	@_ and $self->[dsbl] = shift;
	$old
};
sub ownerNode { defined $_[0][node]?$_[0][node]:() }
sub set_ownerNode { weaken($_[0]->[node] = $_[1]) }
sub parentStyleSheet { shift->[prsh]||() }
sub _set_parentStyleSheet { weaken($_[0]->[prsh] = $_[1]) }
sub href { shift->[hrfe] }
sub set_href { $_[0]->[hrfe] = $_[1] }
sub title { no warnings 'uninitialized';
           ''.(shift->ownerNode || return)->attr('title') }

# If you find a bug in here, Media.pm’s method probably also needs fixing.
sub media {
	wantarray ? @{$_[0]->[medi]||return} :
		($_[0]->[medi] ||= (
			require CSS::DOM::MediaList,
			CSS::DOM::MediaList->new
		))
}


# CSSStyleSheet interface:

sub ownerRule {
	shift->[ownr] || ()
}
sub _set_ownerRule {
	weaken($_[0]->[ownr] = $_[1]);
}

# If you find a bug in the following three methods, Media.pm’s methods
# probably also need fixing.
sub cssRules { 
	wantarray
		? @{shift->[ruls]||return}
		: (shift->[ruls]||=new CSS::DOM::RuleList);
}

sub insertRule { # This is supposed to raise an HIERARCHY_REQUEST_ERR if
                 # the rule cannot be inserted at the specified  index;
                 # e.g.,  if an  @import  rule is inserted after a stan-
                 # dard rule. But we don’t do that, in order to maintain
                 # future compatibility.
	my ($self, $rule_string, $index) = @_;
	
	require CSS::DOM::Parser;
	my ($at,$rule);
	{
		local *@;
		$rule = CSS::DOM::Parser::parse_statement(
		 $rule_string,$self
		);
		$at = $@
	}
	$at and die new CSS::DOM::Exception SYNTAX_ERR, $at;

#	$rule->_set_parentStyleSheet($self);

	my $list = $self->cssRules; # cssRules takes care of ||=
	splice @$list, $index, 0, $rule;

	$index < 0        ? $#$list + $index :
	$index <= $#$list ? $index           :
	                    $#$list
}

sub deleteRule {
	my ($self,$index) = @_;
	my $list = $self->[ruls];
	$index > $#$list and die CSS::DOM::Exception->new(
		INDEX_SIZE_ERR,
		"The index passed to deleteRule ($index) is too large"
	);
	splice @$list, $index, 1;
	return # nothing;
}



my %features = (
	stylesheets => { '2.0' => 1 },
#	css => { '2.0' => 1 },
	css2 => { '2.0' => 1 },
);

sub hasFeature {
	my($feature,$v) = (lc $_[1], $_[2]);
	exists $features{$feature} and