CSS::DOM::Style - CSS style declaration class for CSS::DOM

  use CSS::DOM::Style;

  $style = CSS::DOM::Style::parse(' text-decoration: none ');

  $style->cssText; # returns 'text-decoration: none'
  $style->cssText('color: blue'); # replace contents

  $style->getPropertyValue('color'); # 'blue'
  $style->color;                     # same
  $style->setProperty(color=>'green'); # change it
  $style->color('green');              # same

package CSS::DOM::Style;

$VERSION = '0.14';

use warnings; no warnings qw' utf8';
use strict;

use CSS::DOM::Exception 'SYNTAX_ERR';
use CSS::DOM::Util qw 'escape_ident unescape';
use Scalar::Util 'weaken';

# ~~~ use overload fallback => 1, '@{}' => 

# Internal object structure
#
# Each style object is a hash ref:
# {
#    owner       => $owner_rule,
#    parser      => $property_parser,
#    mod_handler => sub { ... },  # undef initially
#    names       => [...],
#    props       => {...},
#    pri         => {...},  # property priorities
# }
#
# The value of an element in the props hash can be one of three things
#  1) a CSSValue object
#  2) an array ref that is a blueprint for a CSSValue object:
#     [ $css_code, $class, @constructor_args]
#  3) a string of css code
# Item (3) is only used when there is no property parser.

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

sub new {
	my($class) = shift;

	my $self = bless {}, $class;
	if(@_ == 1) {
		$self->{owner} = shift;
	}
	else {
		my %args = @_;
		$self->{owner} = delete $args{owner};
		$self->{parser}
		 = delete $args{property_parser};
	}
	{
		$self->{parser} ||= (
		    ($self->{owner} || next)->parentStyleSheet || next
		   )->property_parser;
	}
	weaken $self->{owner};
	return $self
}

sub cssText {
	my $self = shift;
	my $out;
	if (defined wantarray) {
		$out = join "; ", map {
			my $pri = $self->getPropertyPriority($_);
			"$_: ".$self->getPropertyValue($_)." !"x!!$pri
				. escape_ident($pri)
		} @{$$self{names}};
	}
	if(@_) {
		my $css = shift;
		!defined $css || !length $css and
			@$self{'props','names'} = (), return $out;

		require CSS::DOM::Parser;
		my $new =CSS::DOM::Parser::parse_style_declaration(
		 $css, property_parser => $$self{parser}
		);

		@$self{'props','names'} = @$new{'props','names'};
		_m($self);
	}
	return $out;
}

sub getPropertyValue { # ~~~ Later I plan to make this return lists of
                       #     scalars in list context (for list properties).
	my $self = shift;
	my $props = $self->{props} || return '';
	my $name = lc$_[0];

	if(my $spec = $self->{parser}) { serialise: {
		if(my $p = $spec->get_property($name)) {
		 if(exists $p->{serialise} and my $s = $p->{serialise}) {
		   my @p = $spec->subproperty_names($name);
		   my %p;
		   for(@p) {
		    my $v = $self->getPropertyValue($_) ;
		    length $v or last serialise;
		    $p{$_}
		     = $spec->get_property($_)->{default} eq $v ?'':$v;
		   }
		   return $s->(\%p);
		 }
		}
	}}

	exists $props->{$name}
		or return return '';
	my $val = $props->{$name};
	return ref $val eq 'ARRAY' ? $$val[0]
	     : !ref $val           ? $val
	     :                       $val->cssText;
}

sub getPropertyCSSValue {
	my $self = shift;
	$self->{parser} or return;
	exists +(my $props = $self->{props} || return)->{
	  my $name = lc$_[0]
	}	or return return;
	my $valref = \$props->{$name};
	return ref $$valref eq 'ARRAY'
		? scalar (
			$$$valref[1]->can('new')
			 || do {
			     (my $pack = $$$valref[1]) =~ s e::e/egg;
			     require "$pack.pm";
			    },
			$$valref =
			  $$$valref[1]->new(
			   owner => $self, property => $name,
			   @$$valref[2..$#$$valref],
			  )
		) : $$valref;
}

sub removeProperty {
	my $self = shift;
	my $name = lc shift;

	# Get the value so we can return it
	my $val;
	$val = $self->getPropertyValue($name)
	 if defined wantarray;

	# Get names of subprops if we are dealing with a shorthand prop
	my @to_delete;
	if(my $spec = $self->{parser}) {
		@to_delete = $spec->subproperty_names($name);
	}
	@to_delete or @to_delete = $name;

	# Delete the properties
	for my $name(@to_delete) {
		delete +($self->{props} || return $val)->{$name};
		@{$$self{names}} = grep $_ ne $name,
			@{$$self{names} || return $val};
	}

	$val;
}

sub getPropertyPriority {
	return ${shift->{pri}||return ''}{lc shift} || ''
}

sub setProperty {
	my ($self, $name, $value, $priority) = @_;

	# short-circuit for the common case
	length $value or $self->removeProperty($name),return;

	require CSS'DOM'Parser;
	my @tokens = eval { CSS'DOM'Parser'tokenise_value($value); }
		or die CSS::DOM'Exception->new( SYNTAX_ERR, $@);

	# check for whitespace/comment assignment
	$tokens[0] =~ /^s+\z/ and $self->removeProperty($name),return;

	my $props = $$self{props} ||= {};
	my $pri = $$self{pri} ||= {};

	my $val;
	if(my $spec = $self->{parser}) {
		my(@args) = $spec->match($name, @tokens)
			or return;
		if(@args == 1) { # shorthand
			while(my($k,$v) = each %{ $args[0] }) {
				$self->removeProperty($k), next
				 if $v eq "";
				exists $$props{$k=lc$k}
				 or push @{$$self{names}}, $k;
				$$props{$k} = $v;
				$$pri{$k} = $priority;
			}
			return;
		}
		else {
			$val = \@args;
		}
	}

	exists $$props{$name=lc$name} or push @{$$self{names}}, $name;
	$$props{$name} = $val || join "", @{ $tokens[1] };
	$$pri{$name} = $priority;

	_m($self);
	return
}

sub item {
	my $ret = shift->{names}[shift];
	return defined $ret ? $ret : ''
}

sub parentRule {
	shift->{owner}
}

sub _set_property_tokens { # private
	my ($self,$name,$types,$tokens) = @_;

	# Parse out the priority first
	my $priority;
	if($types =~ /(s?(ds?))i\z/ and $tokens->[$-[2]] eq '!') {
		$types =~ s///;
		$priority = unescape pop @$tokens;
		pop @$tokens for 1..length $1;
	} else {
		$priority = '';
	}

	# Get the prop & priority hashes
	my $props = $$self{props} ||= {};
	my $pri = $$self{pri} ||={};

	# See if we need to parse the value
	my $val;
	if(my $spec = $self->{parser}) {
		my(@args) = $spec->match($name,$types,$tokens)
			or return;
		if(@args == 1) {
			while(my($k,$v) = each %{ $args[0] }) {
				$self->removeProperty($k), next
				 if $v eq "";
				exists $$props{$k=lc$k}
				 or push @{$$self{names}}, $k;
				$$props{$k} = $v;
				$$pri{$k} = $priority;
			}
			return;
		}
		else {
			$val = \@args;
		}
	}
	else { $val = join "", @$tokens }

	# Assign the value & priority
	exists $$props{$name=lc$name} or push @{$$self{names}}, $name;
	$$props{$name} = $val;
	$$pri{$name} = $priority;
}


{ my $prop_re = qr/[a-z]+(?:[A-Z][a-z]+)*/;
sub can {
	SUPER::can { shift } @_ or
		$_[0] =~ /^$prop_re\z/o ? \&{+shift} : undef;
}
sub AUTOLOAD {
	my $self = shift;
	if(our $AUTOLOAD =~ /(?<=:)($prop_re)\z/o) {
		(my $prop = $1) =~ s/([A-Z])/-\l$1/g;
		my $val;
		defined wantarray
			and $val = $self->getPropertyValue($prop);
		@_ and $self->setProperty($prop, shift);
		return $val;
	} else {
		die "Undefined subroutine $AUTOLOAD called at ",
			join(" line ", (caller)[1,2]), ".\n";
	}
}
sub DESTROY{}
}
*cssFloat = \&float;

sub modification_handler {
	my $old = (my $self = shift)->{mod_handler};
	$self->{mod_handler} = shift if @_;
	$old;
}

sub _m#odified
{
	&{$_[0]->{mod_handler} or return}($_[0]);
}

sub property_parser { shift->{parser} }

sub length { # We put this one last to avoid having to say CORE::length
             # elsewhere.
	scalar @{shift->{names}||return 0}
}



                              !()__END__()!