File Coverage

blib/lib/POE/XUL/Style.pm

Criterion	Covered	Total	%
statement	79	85	92.9
branch	29	38	76.3
condition	9	15	60.0
subroutine	15	15	100.0
pod	0	5	0.0
total	132	158	83.5

package POE::XUL::Style;
# $Id$
# Copyright Philip Gwyn 2008-2010.  All rights reserved.

use strict;
use warnings;

use Scalar::Util qw( refaddr );

use Carp;

use overload '""' => sub { $_[0]->as_string },
             '+'  => sub { refaddr $_[0] },
             'bool' => sub { 1 },
             fallback => 1;

use constant DEBUG => 0;

our $VERSION = '0.0601';

my %EQUIV = qw(
    border-top border
    border-left border
    border-bottom border
    border-right border
    overflow-x overflow
    overflow-y overflow
    -moz-outline outline
);

my %SUBSET = (          # property ... offsets
    'margin-top'    => [ 'margin', 0, 0, 0, 0 ],
    'margin-right'  => [ 'margin', 0, 1, 1, 1 ],
    'margin-bottom' => [ 'margin', 0, 0, 2, 2 ],
    'margin-left'   => [ 'margin', 0, 1, 1, 3 ],
    'padding-top'    => [ 'padding', 0, 0, 0, 0 ],
    'padding-right'  => [ 'padding', 0, 1, 1, 1 ],
    'padding-bottom' => [ 'padding', 0, 0, 2, 2 ],
    'padding-left'   => [ 'padding', 0, 1, 1, 3 ],
    'border-width' => [ 'border', 0, 0, 0 ],
    'border-style' => [ 'border', 1, 1, 1 ],
    'border-color' => [ 'border', 2, 2, 2 ],
    'border-top-width' => [ 'border-top', 0, 0, 0 ],
    'border-top-style' => [ 'border-top', 1, 1, 1 ],
    'border-top-color' => [ 'border-top', 2, 2, 2 ],
    'border-right-width' => [ 'border-right', 0, 0, 0 ],
    'border-right-style' => [ 'border-right', 1, 1, 1 ],
    'border-right-color' => [ 'border-right', 2, 2, 2 ],
    'border-bottom-width' => [ 'border-bottom', 0, 0, 0 ],
    'border-bottom-style' => [ 'border-bottom', 1, 1, 1 ],
    'border-bottom-color' => [ 'border-bottom', 2, 2, 2 ],
    'border-left-width' => [ 'border-left', 0, 0, 0 ],
    'border-left-style' => [ 'border-left', 1, 1, 1 ],
    'border-left-color' => [ 'border-left', 2, 2, 2 ],
    'outline-width' => [ 'outline', 0, 0, 0 ],
    'outline-style' => [ 'outline', 1, 1, 1 ],
    'outline-color' => [ 'outline', 2, 2, 2 ],
    '-moz-outline-width' => [ '-moz-outline', 0, 0, 0 ],
    '-moz-outline-style' => [ '-moz-outline', 1, 1, 1 ],
    '-moz-outline-color' => [ '-moz-outline', 2, 2, 2 ],
    'list-style-type'     => [ 'list-style', 0, 0, 0 ],
    'list-style-position' => [ 'list-style', 1, 1, 1 ],
    'list-style-image'    => [ 'list-style', 2, 2, 2 ],
    # http://developer.mozilla.org/en/docs/CSS:-moz-border-radius says:
    # "If fewer than 4 values are given, the list of values is repeated
    # to fill the remaining values."
    # I take this to mean:
    # 1       -> tl=1 tr=1 br=1 bl=1
    # 1 2     -> tl=1 tr=2 br=1 bl=2
    # 1 2 3   -> tl=1 tr=2 br=3 bl=1
    '-moz-border-radius-topleft'     => [ '-moz-border-radius', 0, 0, 0, 0 ],
    '-moz-border-radius-topright'    => [ '-moz-border-radius', 0, 1, 1, 1 ],
    '-moz-border-radius-bottomright' => [ '-moz-border-radius', 0, 0, 2, 2 ],
    '-moz-border-radius-bottomleft'  => [ '-moz-border-radius', 0, 1, 0, 3 ],
);

##############################################################
sub new
{
    my( $package, $init ) = @_;
    my $self = bless { properties => {}, text => [] }, $package;
    $self->parse( $init ) if $init;
    return $self;
}

##############################################################
sub as_string
{
    my( $self ) = @_;
    return join '', @{ $self->{text} };
}

##############################################################
sub parse
{
    my( $self, $string ) = @_;
    return unless defined $string;
    # TODO : add ; to last property text
    while( $string ) {
        # line starts with a comment
        if( $string =~ s,^(\s*/\*[^*]*\*+([^/*][^*]*\*+)*/\s*),,s ) {
            push @{ $self->{text} }, $1;
        }
        # line start with whitespace
        elsif( $string =~ s,^(\s+),,s ) {
            my $ws = $1;
            if( @{ $self->{text} } and  $self->{text}[-1] =~ /\s+$/ ) {
                $self->{text}[-1] .= $ws;
            }
            else {
                push @{ $self->{text} }, $ws;
            }
        }
        # property: value
        # Note this fails for property: "some; value"; please DON'T DO THAT
        elsif( $string =~ s,^((-?[_a-z][-_a-zA-Z]*)\s*:\s*(.*?)\s*(\Z|;\s*)),,is ) {
            push @{ $self->{text} }, $1;
            $self->{prop}{lc $2} = {
                                  # name => lc( $2 ),
                                  text=>\$self->{text}[-1],
                                  value => $3
                                };
        }
    }
}

##############################################################
sub get
{
    my( $self, $key ) = @_;
    $key = lc $key;
    my $rv;
    if( $self->{prop}{ $key } ) {
        $rv = $self->{prop}{ $key }{value};
    }
    elsif( $EQUIV{$key} and $self->{prop}{ $EQUIV{$key} } ) {
        $rv = $self->{prop}{ $EQUIV{$key} }{value};
    }
    elsif( $SUBSET{ $key } ) {
        my $subset = $SUBSET{$key};
        my $value = $self->get( $subset->[0] );
        if( $value ) {
            my @values = split ' ', $value, $#$subset;
            my $n = 0+@values;
            $rv = $values[ $subset->[$n] ] if $n > 0;
        }
    }
    $rv = '' unless defined $rv;
    return $rv;
}


##############################################################
sub set
{
    my( $self, $key, $value ) = @_;
    $key = lc $key;
    my $prop = $self->{prop}{ $key };
    $value =~ s/;\s*$//;
    unless( $prop ) {
        # special case...
        return if !$value and $key eq 'display';

        $self->{text}[-1] .= ";"
                if @{$self->{text}} and $self->{text}[-1] !~ m([;/]\s*$)s;
        push @{ $self->{text} }, "$key: $value;\n";
        $self->{prop}{ $key } = {  value => $value,
                                   # name => $key,
                                   text => \$self->{text}[-1]
                                };
    }
    else {
        # special case...
        if( !$value and $key eq 'display' ) {
            ${ $prop->{text} } = '';
            delete $self->{prop}{ lc $key };
        }
        else {
            ${ $prop->{text} } =~ s/\Q$prop->{value}/$value/;
            $prop->{value} = $value;
        }
    }
    $POE::XUL::Node::CM->after_style_change( $self, $key, $value )
            if $POE::XUL::Node::CM;
    return;
}

##############################################################
sub AUTOLOAD
{
    my( $self, $value ) = @_;
    my $key = our $AUTOLOAD;
    return if $key =~ /DESTROY$/;
	$key =~ s/^.*:://;

    $key =~ s/([A-Z])/-\L$1/g;
    if( 1 == @_ ) {
        return $self->get( $key );
    }
    else {
        return $self->set( $key, $value );
    }

}

1;

__END__