view release on metacpan or  search on metacpan

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

package CSS::DOM::Value;

$VERSION = '0.17';

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

use Carp;
use CSS::DOM::Constants;
use CSS'DOM'Exception 'NO_MODIFICATION_ALLOWED_ERR';
use Exporter 5.57 'import';
use Scalar'Util < weaken reftype >;

use constant 1.03 our $_const = {
    type => 0,
    valu => 1,
    ownr => 2,
    prop => 3,
};
{ no strict; delete @{__PACKAGE__.'::'}{_const => keys %{our $_const}} }

*EXPORT_OK = $CSS::DOM::Constants::EXPORT_TAGS{value};
our %EXPORT_TAGS = ( all => \our @EXPORT_OK );

sub new {
	my $self = bless[], shift;
	my %args = @_;
	my $type = $self->[type] = $args{type};
	$type == CSS_CUSTOM
	? !exists $args{value} && croak
	   'new CSS::DOM::Value(type => CSS_CUSTOM) requires a value'
	: $type == CSS_INHERIT
		|| croak "Type must be CSS_CUSTOM or CSS_INHERIT";

	@$self[valu,ownr,prop] = @args{< value owner property >};
	weaken $$self[ownr];

	$self;
}

sub cssValueType { shift->[type] }

sub cssText {
	my $self = shift;
	my $old = $self->[type] == CSS_CUSTOM
		? $self->[valu] : 'inherit'
	 if defined wantarray;
	if(@_) {
		die new CSS'DOM'Exception
		  NO_MODIFICATION_ALLOWED_ERR,
		 "Unowned value objects cannot be modified"
		   unless my $owner = $self->[ownr];
		die new CSS'DOM'Exception
		  NO_MODIFICATION_ALLOWED_ERR,
		 "CSS::DOM::Value objects that do not know to which "
		 ."property they belong cannot be modified"
		   unless my $prop = $self->[prop];

		if(
		 my @arsg
		  = $owner->property_parser->match($prop, $_[0])
		) {
			_apply_args_to_self($self,$owner,$prop,@arsg);
		}

		if(my $mh = $owner->modification_handler) {
			&$mh();
		}
	}
	$old
}

sub _apply_args_to_self {
  my($self,$owner,$prop,@arsg) = @_;
 _load_if_necessary($arsg[1]);
  my $new = $arsg[1]->new(
   owner => $owner, property => $prop, @arsg[2...$#arsg]
  );
  reftype $self eq "HASH"
   ?  %$self = %$new
   : (@$self = @$new);
  bless $self, ref $new unless ref $new eq ref $self;
}

sub _load_if_necessary {
 $_[0]->can('new')
  || do {
      (my $pack = $_[0]) =~ s e::e/egg;
      require "$pack.pm";
     };
}

                              !()__END__()!

=head1 NAME