File Coverage

blib/lib/Graphics/Primitive/CSS.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

package Graphics::Primitive::CSS;
use Moose;

our $VERSION = '0.02';

use Carp qw(carp);
use Check::ISA;
use CSS::DOM;
use Graphics::Color::RGB;

has 'styles' => (
    is => 'ro',
    isa => 'Str',
    required => 1,
);

has 'css_dom' => (
    is => 'ro',
    isa => 'CSS::DOM',
    lazy => 1,
    default => sub { my $self = shift; CSS::DOM::parse($self->styles) }
);

sub apply {
    my ($self, $doc) = @_;

    my @rules = $self->css_dom->cssRules;

    foreach my $rule (@rules) {
        my $selector = $rule->selectorText;

        for(0..($rule->style->length - 1)) {

            my $prop = $rule->style->item($_);
            my $val = $rule->style->getPropertyValue($prop);

            my $comps;
            if($selector =~ /^\.(.*)/) {
                # Handle classes
                my $class = $1;
                $comps = $doc->find(sub {
                    my ($comp, $const) = @_;
                    return 0 unless defined($comp->class);
                    return $comp->class eq $class;
                });
            } elsif($selector =~ /#(.*)/) {
                # Handle names
                my $name = $1;
                $comps = $doc->find(sub {
                    my ($comp, $const) = @_;
                    return 0 unless defined($comp->name);
                    return $comp->name eq $name;
                });
            } elsif($selector =~ 'textbox') {
                # Handle "elements"
                $comps = $doc->find(sub {
                    my ($comp, $const) = @_;

                    return obj($comp, 'Graphics::Primitive::TextBox');
                });
            }

            return 1 unless defined($comps) && $comps->component_count;

            if($prop eq 'background-color') {

                my $color = $self->_process_color($val);
                next unless defined($color);

                $comps->each(sub {
                     my ($comp, $const) = @_;
                     $comp->background_color($color);
                });

            } elsif($prop eq 'border-bottom-color') {

                my $color = $self->_process_color($val);
                next unless defined($color);

                $comps->each(sub {
                     my ($comp, $const) = @_;
                     $comp->border->bottom->color($color);
                });

            } elsif($prop eq 'border-bottom-width') {

                if($val =~ /(\d+)px/) {
                    $comps->each(sub {
                         my ($comp, $const) = @_; $comp->border->bottom->width($1);
                    });
                }
            } elsif($prop eq 'border-color') {

                my $color = $self->_process_color($val);
                next unless defined($color);

                $comps->each(sub {
                     my ($comp, $const) = @_;
                     $comp->border->color($color);
                });

            } elsif($prop eq 'border-left-color') {

                my $color = $self->_process_color($val);
                next unless defined($color);

                $comps->each(sub {
                     my ($comp, $const) = @_;
                     $comp->border->left->color($color);
                });

            } elsif($prop eq 'border-left-width') {

                if($val =~ /(\d+)px/) {
                    $comps->each(sub {
                         my ($comp, $const) = @_; $comp->border->left->width($1);
                    });
                }
            } elsif($prop eq 'border-right-color') {

                my $color = $self->_process_color($val);
                next unless defined($color);

                $comps->each(sub {
                     my ($comp, $const) = @_;
                     $comp->border->right->color($color);
                });

            } elsif($prop eq 'border-right-width') {

                if($val =~ /(\d+)px/) {
                    $comps->each(sub {
                         my ($comp, $const) = @_; $comp->border->right->width($1);
                    });
                }

            } elsif($prop eq 'border-top-color') {

                my $color = $self->_process_color($val);
                next unless defined($color);

                $comps->each(sub {
                     my ($comp, $const) = @_;
                     $comp->border->top->color($color);
                });

            } elsif($prop eq 'border-top-width') {

                if($val =~ /(\d+)px/) {
                    $comps->each(sub {
                         my ($comp, $const) = @_; $comp->border->top->width($1);
                    });
                }

            } elsif($prop eq 'border-width') {
                my ($top, $right, $bottom, $left);
                if($val =~ /^(\d+)px$/) {
                    $top = $1; $bottom = $1;
                    $right = $1; $left = $1;

                } elsif($val =~ /^(\d+)px (\d+)px$/) {
                    $top = $1; $bottom = $1;
                    $right = $2; $left = $2;

                } elsif($val =~ /^(\d+)px (\d+)px (\d+)px (\d+)px$/) {
                    $top = $1; $right = $2;
                    $bottom = $3; $left = $4;
                }

                $comps->each(sub {
                     my ($comp, $const) = @_;
                     $comp->border->top->width($top);
                     $comp->border->right->width($right);
                     $comp->border->bottom->width($bottom);
                     $comp->border->left->width($left);
                });

            } elsif($prop eq 'color') {

                my $color = $self->_process_color($val);
                next unless defined($color);

                $comps->each(sub {
                     my ($comp, $const) = @_;
                     $comp->color($color);
                });

            } elsif($prop eq 'font-family') {
                $comps->each(sub {
                     my ($comp, $const) = @_; $comp->font->family($val);
                });

            } elsif($prop eq 'font-size') {
                if($val =~ /(\d+)pt/) {
                    $comps->each(sub {
                         my ($comp, $const) = @_; $comp->font->size($1);
                    });
                } else {
                    carp("Unknown font-size value: '$val'");
                }

            } elsif($prop eq 'font-weight') {
                $comps->each(sub {
                     my ($comp, $const) = @_; $comp->font->weight($val);
                });


            } elsif($prop eq 'margin') {
                my ($top, $right, $bottom, $left);
                if($val =~ /^(\d+)px (\d+)px$/) {
                    $top = $1; $bottom = $1;
                    $right = $2; $left = $2;
                } elsif($val =~ /^(\d+)px (\d+)px (\d+)px (\d+)px$/) {
                    $top = $1; $right = $2;
                    $bottom = $3; $left = $4;
                }

                $comps->each(sub {
                     my ($comp, $const) = @_;
                     $comp->margins->top($top);
                     $comp->margins->right($right);
                     $comp->margins->bottom($bottom);
                     $comp->margins->left($left);
                });
            } elsif($prop eq 'margin-bottom') {
                if($val =~ /(\d+)px/) {
                    $comps->each(sub {
                         my ($comp, $const) = @_; $comp->margins->bottom($1);
                    });
                }
            } elsif($prop eq 'margin-left') {
                if($val =~ /(\d+)px/) {
                    $comps->each(sub {
                         my ($comp, $const) = @_; $comp->margins->left($1);
                    });
                }
            } elsif($prop eq 'margin-right') {
                if($val =~ /(\d+)px/) {
                    $comps->each(sub {
                         my ($comp, $const) = @_; $comp->margins->right($1);
                    });
                }
            } elsif($prop eq 'margin-top') {
                if($val =~ /(\d+)px/) {
                    $comps->each(sub {
                         my ($comp, $const) = @_; $comp->margins->top($1);
                    });
                }

            } elsif($prop eq 'padding') {
                my ($top, $right, $bottom, $left);
                if($val =~ /^(\d+)px (\d+)px$/) {
                    $top = $1; $bottom = $1;
                    $right = $2; $left = $2;
                } elsif($val =~ /^(\d+)px (\d+)px (\d+)px (\d+)px$/) {
                    $top = $1; $right = $2;
                    $bottom = $3; $left = $4;
                }

                $comps->each(sub {
                     my ($comp, $const) = @_;
                     $comp->padding->top($top);
                     $comp->padding->right($right);
                     $comp->padding->bottom($bottom);
                     $comp->padding->left($left);
                });
            } elsif($prop eq 'padding-bottom') {
                if($val =~ /(\d+)px/) {
                    $comps->each(sub {
                         my ($comp, $const) = @_; $comp->padding->bottom($1);
                    });
                }
            } elsif($prop eq 'padding-left') {
                if($val =~ /(\d+)px/) {
                    $comps->each(sub {
                         my ($comp, $const) = @_; $comp->padding->left($1);
                    });
                }
            } elsif($prop eq 'padding-right') {
                if($val =~ /(\d+)px/) {
                    $comps->each(sub {
                         my ($comp, $const) = @_; $comp->padding->right($1);
                    });
                }
            } elsif($prop eq 'padding-top') {
                if($val =~ /(\d+)px/) {
                    $comps->each(sub {
                         my ($comp, $const) = @_; $comp->padding->top($1);
                    });
                }

            } elsif($prop eq 'text-align') {
                $comps->each(sub {
                     my ($comp, $const) = @_; $comp->horizontal_alignment($val);
                });
            } elsif($prop eq 'vertical-align') {
                $comps->each(sub {
                     my ($comp, $const) = @_; $comp->vertical_alignment($val);
                });
            }
        }
    }

    return 1;
}

# Attempt to find a valid color
sub _process_color {
    my ($self, $val) = @_;

    my $color;
    if($val =~ /^#(.*)/) {
        $color = Graphics::Color::RGB->from_hex_string($val);

    # TODO:
    # rgb(255, 0, 0)
    # rgb(100%, 0%, 0%)
    # rgba(255, 0, 0)
    # hsl(0, 100%, 50%)
    # hsla(120, 100%, 50%, 1)
    } else {
        # Going to try and treat it like a color name...
        $color = Graphics::Color::RGB->from_color_library(
            "svg:$val"
        );
    }

    unless(defined($color)) {
        carp("Unable to parse color: '$val'");
    }

    return $color;
}

1;

=head1 NAME

Graphics::Primitive::CSS - Style Graphics::Primitive documents with CSS

=head1 SYNOPSIS

    use Graphics::Primitive::CSS;

    my $styler = Graphics::Primitive::CSS->new(
        style => '
            .foo {
                font-size: 12pt;
                vertical-align: center;
            }
        '
    );

    my $doc = Graphics::Primitive::Container->new;
    my $textbox = Graphics::Primitive::TextBox->new( class => 'foo' );
    $doc->add_component($textbox);

    $styler->apply($doc);

=head1 DESCRIPTION

Graphics::Primitive::CSS allows you to change the various attributes of a
Graphics::Primitive document using CSS.

=head1 SELECTORS

Graphics::Primitive::CSS currently supports a class (.classname), element
(only textbox currently), and 'id' (#name) selector.  It does not support
nested selectors (yet).

=head1 COLORS

Colors can be suppled as an RBG hex triplet (#f0f0f0 and #fff) and W3C
spec name (aliceblue).  Support is intended for rgb, rgba, hsl and hsla.

=head1 PROPERTIES

Graphics::Primitive::CSS supports the following properties in the following
ways.

=over 4

=item background-color, color

Background and foreground color

=item border-color

Color of all borders. B<Note: Only supports a single color value currently.>

=item border-color-top, border-color-right, border-color-bottom, border-color-left

Set the color for various borders

=item border-width-top, border-width-right, border-width-bottom, border-width-left

Set the width for a border (in pixels)

=item font-size, font-family

Size of font as points (e.g. 7pt).  Family name (does not support lists!)

=item margin

2 value (top, left) and 4 value (top, right, bottom, left).  Only pixels
are supported.

=item margin-top, margin-left, margin-bottom, margin-right

=item padding

2 value (top, left) and 4 value (top, right, bottom, left).  Only pixels
are supported.

=item padding-top, padding-left, padding-bottom, padding-right


Only pixels are supported.


=back

=head1 AUTHOR

Cory G Watson, C<< <gphat at cpan.org> >>

=back

=head1 COPYRIGHT & LICENSE

Copyright 2009 Cold Hard Code, LLC, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut