The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Template::Flute::Style::CSS;

use strict;
use warnings;

use CSS::Tiny;

use Template::Flute::Utils;

# names for the sides of a box, as in border-top, border-right, ...
use constant SIDE_NAMES => qw/top right bottom left/;

# default font size - used for the calucation of 1em
use constant FONT_SIZE => '12';

our $VERSION = '0.0081';

# block elements
my %block_elements = (address => 1,
		      blockquote => 1,
		      div => 1,
		      dl => 1,
		      fieldset => 1,
		      form => 1,
		      h1 => 1,
		      h2 => 1,
		      h3 => 1,
		      h4 => 1,
		      h5 => 1,
		      h6 => 1,
		      noscript => 1,
		      ol => 1,
		      p => 1,
		      pre => 1,
		      table => 1,
		      ul => 1);

=head1 NAME

Template::Flute::Style::CSS - CSS parser class for Template::Flute

=head1 VERSION

Version 0.0081

=head1 CONSTRUCTOR

=head2 new

Create Template::Flute::Style::CSS object with the following parameters:

=over 4

=item template

L<Template::Flute::HTML> object.

=item prepend_directory

Directory which is prepended to the CSS path when the
template doesn't reside in a file.

=back

=cut

sub new {
	my ($proto, @args) = @_;
	my ($class, $self);

	$class = ref($proto) || $proto;
	$self = {@args};

	bless ($self, $class);

	if ($self->{template}) {
		$self->{css} = $self->_initialize();
	}

	return $self;
}

sub _initialize {
	my ($self) = @_;
	my (@ret, $css_file, $css);

	# create CSS::Tiny object
	$css = new CSS::Tiny;

	# search for external stylesheets
	for my $ext ($self->{template}->root()->get_xpath(qq{//link})) {
		if ($ext->att('rel') eq 'stylesheet'
			&& $ext->att('type') eq 'text/css') {
			if ($self->{template}->file) {
				$css_file = Template::Flute::Utils::derive_filename
					($self->{template}->file, $ext->att('href'), 1);
			}
			elsif ($self->{prepend_directory}) {
				$css_file = join('/', $self->{prepend_directory},
								 $ext->att('href'));
			}
			else {
				$css_file = $ext->att('href');
			}
			
			unless ($css->read($css_file)) {
				die "Failed to parse CSS file $css_file: " . $css->errstr() . "\n";
			}
		}
	}
	
	# search for inline stylesheets
	push (@ret, $self->{template}->root()->get_xpath(qq{//style}));
	
	for (@ret) {
		unless ($css->read_string($_->text())) {
			die "Failed to parse inline CSS: " . $css->errstr() . "\n";
		}
	}
	
	return $css;
}

=head1 METHODS

=head2 properties

Builds CSS properties based on the following parameters:

=over 4

=item selector

CSS selector.

=item class

CSS class.

=item id

CSS id.

=item tag

HTML tag.

=item inherit

CSS properties to inherit from.

=back

=cut

sub properties {
	my ($self, %parms) = @_;
	my (@ids, @classes, @tags, $props);

	# inherit from parent element
	if (exists $parms{inherit}) {
		$props = $self->inherit($parms{inherit});
	}
	
	# defaults
    unless (exists $props->{color}) {
        $props->{color} = 'black';
    }
    
    unless (exists $props->{font}->{size}) {
        $props->{font}->{size} = FONT_SIZE;
    }

	if (defined $parms{tag} && $parms{tag} =~ /\S/) {
		@tags = split(/\s+/, $parms{tag});

		if (@tags) {
		    for my $tag (@tags) {
			$self->_build_properties($props, $tag);

			if (($parms{tag} eq 'strong' || $parms{tag} eq 'b')
			    && ! exists $props->{font}->{weight}) {
			    $props->{font}->{weight} = 'bold';
			}
		}

            if ($parms{tag} eq 'p') {
                # add automagic margin of 1em
                for (qw/top bottom/) {
                    unless ($props->{margin}->{$_}) {
                        $props->{margin}->{$_} = $props->{font}->{size};

                        if ($props->{font}->{size} =~ /^[0-9.]+$/) {
                            $props->{margin}->{$_} .= 'pt';
                        }
                    }
                }
            }
            
		    if (! $props->{display} && exists $block_elements{$tags[0]} ) {
			$props->{display} = 'block';
		    }	
		}
	}
	
	if (defined $parms{id} && $parms{id} =~ /\S/) {
		@ids = split(/\s+/, $parms{id});

		for my $id (@ids) {
			$self->_build_properties($props, "#$id");
		}
	}

	if (defined $parms{class} && $parms{class} =~ /\S/) {
		@classes = split(/\s+/, $parms{class});

		for my $class (@classes) {
			$self->_build_properties($props, ".$class");
			for (@tags) {
				$self->_build_properties($props, "$_.$class");
			}
		}
	}

	if (defined $parms{selector} && $parms{selector} =~ /\S/) {
		$self->_build_properties($props, $parms{selector});
	}

	$props->{display} ||= 'inline';

	$self->_expand_properties($props);

	return $props;
}

=head2 descendant_properties

Builds descendant CSS properties based on the following parameters:

=over 4

=item parent

Parent properties.

=item class

CSS class.

=item id

CSS id.

=item tag

HTML tag.

=back

=cut

sub descendant_properties {
	my ($self, %parms) = @_;
	my (@ids, @classes, @selectors, $regex, $sel, @tags, %selmap);

	if (ref($parms{parent}) eq 'HASH') {
		%selmap = %{$parms{parent}};
	}

	if (defined $parms{id} && $parms{id} =~ /\S/) {
		@ids = split(/\s+/, $parms{id});

		for my $id (@ids) {
			$regex = qr{^#$id\s+};
			@selectors = $self->_grep_properties($regex);

			for (@selectors) {
				$sel = substr($_, length($id) + 2);
				$selmap{$sel} = $_;
			}
		}
	}
	
	if (defined $parms{class} && $parms{class} =~ /\S/) {
		@classes = split(/\s+/, $parms{class});

		for my $class (@classes) {
			$regex = qr{^.$class\s+};
			@selectors = $self->_grep_properties($regex);

			for (@selectors) {
				$sel = substr($_, length($class) + 2);
				$selmap{$sel} = $_;
			}
		}
	}
	elsif (defined $parms{tag} && $parms{tag} =~ /\S/) {
		@tags = split(/\s+/, $parms{tag});
			
		for my $tag (@tags) {
			$regex = qr{^$tag\s+};
			@selectors = $self->_grep_properties($regex);
			
			for (@selectors) {
				$sel = substr($_, length($tag) + 1);
				$selmap{$sel} = $_;
			}
		}
	}
	
	return \%selmap;
}

sub _grep_properties {
	my ($self, $sel_regex) = @_;
	my (@selectors);

	@selectors = grep {/$sel_regex/} keys %{$self->{css}};

	return @selectors;
}

sub _build_properties {
	my ($self, $propref, $sel) = @_;
	my ($props_css, $sides);
	my (@specs, $value);
	
	$props_css = $self->{css}->{$sel};

	# background: all possible values in arbitrary order
	# attachment,color,image,position,repeat

	if ($value = $props_css->{background}) {
		@specs = split(/\s+/, $value);

		for (@specs) {
			# attachment
			if (/^(fixed|scroll)$/) {
				$propref->{background}->{attachment} = $1;
				next;
			}
			# color (switch later to one of Graphics::ColorNames modules)
			if (/^(\#[0-9a-f]{3,6})$/) {
				$propref->{background}->{color} = $1;
				next;
			}

		}
	}

	for (qw/attachment color image position repeat/) {
		if ($value = $props_css->{"background-$_"}) {
			$propref->{background}->{$_} = $value;
		}
	}
	
	# border
	if ($value = $props_css->{border}) {
		my ($width, $style, $color) = split(/\s+/, $value);
	
		$propref->{border}->{all} = {width => $width,
			style => $style,
			color => $color};
	}
	
	# border-width, border-style, border-color
	for my $p (qw/width style color/) {
		if ($value = $props_css->{"border-$p"}) {
			$sides = $self->_by_sides($value);

			$propref->{border}->{all}->{$p} = $sides->{all};
			
			for (SIDE_NAMES) {
				$propref->{border}->{$_}->{$p} = $sides->{$_} || $sides->{all};
			}
		}
	}
	
	# border sides		
	for my $s (qw/top bottom left right/) {
		if ($value = $props_css->{"border-$s"}) {
			my ($width, $style, $color) = split(/\s+/, $value);

			$propref->{border}->{$s} = {width => $width,
				style => $style,
				color => $color};
		}

		for my $p (qw/width style color/) {
			if ($value = $props_css->{"border-$s-$p"}) {
				$propref->{border}->{$s}->{$p} = $value;
			}
		}
	}

	# clear
	if ($props_css->{clear}) {
		$propref->{clear} = $props_css->{clear};
	}
	elsif (! $propref->{clear}) {
		$propref->{clear} = 'none';
	}
	
	# color
	if ($props_css->{color}) {
		$propref->{color} = $props_css->{color};
	}

	# display
	if ($props_css->{display}) {
	    $propref->{display} = $props_css->{display};
	}

	# float
	if ($props_css->{float}) {
		$propref->{float} = $props_css->{float};
	}
	elsif (! $propref->{float}) {
		$propref->{float} = 'none';
	}
	
	# font
	if ($props_css->{'font-size'}) {
		$propref->{font}->{size} = $props_css->{'font-size'};
	}
	if ($props_css->{'font-family'}) {
	    $propref->{font}->{family} = ucfirst(lc($props_css->{'font-family'}));
	}
	if ($props_css->{'font-style'}) {
	    $propref->{font}->{style} = ucfirst(lc($props_css->{'font-style'}));
	}
	if ($props_css->{'font-weight'}) {
		$propref->{font}->{weight} = $props_css->{'font-weight'};
	}

	# height
	if ($props_css->{'height'}) {
		$propref->{height} = $props_css->{height};
	}

    # min-height
	if ($props_css->{'min-height'}) {
		$propref->{min_height} = $props_css->{'min-height'};
	}
    
	# line-height
	if ($props_css->{'line-height'}) {
		$propref->{'line_height'} = $props_css->{'line-height'};
	}

	# list-style
	if ($props_css->{'list-style'}) {
		$propref->{'list_style'} = $props_css->{'list-style'};
	}
	
	# margin
	if (exists $props_css->{'margin'}) {
		$sides = $self->_by_sides($props_css->{'margin'});

		for (SIDE_NAMES) {
			$propref->{margin}->{$_} = $sides->{$_} || $sides->{all};
		}
	}

	# margin sides
	for (SIDE_NAMES) {
		if (exists $props_css->{"margin-$_"}
			&& $props_css->{"margin-$_"} =~ /\S/) {
			$propref->{margin}->{$_} = $props_css->{"margin-$_"};
		}
	}
	
	# padding
	if ($props_css->{'padding'}) {
		$sides = $self->_by_sides($props_css->{'padding'});

		for (SIDE_NAMES) {
			$propref->{padding}->{$_} = $sides->{$_} || $sides->{all};
		}
	}

	# padding sides
	for (SIDE_NAMES) {
		if (exists $props_css->{"padding-$_"}
			&& $props_css->{"padding-$_"} =~ /\S/) {
			$propref->{padding}->{$_} = $props_css->{"padding-$_"};
		}
	}

	# text
	if ($props_css->{'text-align'}) {
		$propref->{text}->{align} = $props_css->{'text-align'};
	}
	if ($props_css->{'text-decoration'}) {
		$propref->{text}->{decoration} = $props_css->{'text-decoration'};
	}
	if ($props_css->{'text-transform'}) {
		$propref->{text}->{transform} = $props_css->{'text-transform'};
	}
	
	# transform
	for (qw/transform -webkit-transform -moz-transform -o-transform -ms-transform/) {
	    my ($prop_value, @frags);

            if ($prop_value = $props_css->{$_}) {
		@frags = split(/\s+/, $prop_value);

		for my $value (@frags) {
		    if ($value =~ s/^\s*rotate\(((-?)\d+(\.\d+)?)\s*deg\)\s*$/$1/) {
			if ($2) {
			    # negative angle
			    $propref->{rotate} = 360 + $value;
			}
			else {
			    $propref->{rotate} = $value;
			}
		    }
		    elsif ($value =~ /translate([xy])?\((.*?)(,(.*?))?\)/i) {
			if (lc($1) eq 'x') {
			    # translateX value
			    $propref->{translate}->{x} = $2;
			}
			elsif (lc($1) eq 'y') {
			    # translateY value
			    $propref->{translate}->{y} = $2;
			}
			else {
			    # translate value (x and optionally y)
			    $propref->{translate}->{x} = $2;
			    
			    if ($4) {
				$propref->{translate}->{y} = $4;
			    }
			}
		    }
		}

		last;
            }
        }

	# vertical-align
	if ($props_css->{'vertical-align'}) {
	    $propref->{vertical_align} = $props_css->{'vertical-align'};
	}

	# width
	if ($props_css->{'width'}) {
		$propref->{width} = $props_css->{width};
	}

    # min-width
    if ($props_css->{'min-width'}) {
        $propref->{min_width} = $props_css->{'min-width'};
    }
    
	return $propref;
}

sub _expand_properties {
    my ($self, $props) = @_;

    # border sides		
    for my $s (SIDE_NAMES) {
	for my $p (qw/width style color/) {
	    next if exists $props->{border}->{$s}->{$p};
	    $props->{border}->{$s}->{$p} =  $props->{border}->{all}->{$p};    
	}
    }
}

sub inherit {
	my ($self, $inherit) = @_;
	my (%props);

	# font
	if ($inherit->{font}) {
		%{$props{font}} = %{$inherit->{font}};
	}

	# line height
	if ($inherit->{line_height}) {
		$props{line_height} = $inherit->{line_height};
	}

	# text
	if ($inherit->{text}) {
		$props{text} = $inherit->{text};
	}
	
	return \%props;
}

# helper functions

sub _by_sides {
	my ($self, $value) = @_;
	my (@specs, %sides);

	@specs = split(/\s+/, $value);

	if (@specs == 1) {
		# all sides		
		$sides{all} = $specs[0];
	} elsif (@specs == 2) {
		# top/bottom, left/right
		$sides{top} = $sides{bottom} = $specs[0];
		$sides{left} = $sides{right} = $specs[1];
	} elsif (@specs == 3) {
		# top, left/right, bottom
		$sides{top} = $specs[0];
		$sides{left} = $sides{right} = $specs[1];
		$sides{bottom} = $specs[2];
	} elsif (@specs == 4) {
		# top, right, bottom, left
		$sides{top} = $specs[0];
		$sides{right} = $specs[1];
		$sides{bottom} = $specs[2];
		$sides{left} = $specs[3];
	}

	return \%sides;

}

=head1 AUTHOR

Stefan Hornburg (Racke), <racke@linuxia.de>

=head1 BUGS

Please report any bugs or feature requests to C<bug-template-flute-style-css at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Template-Flute-Style-CSS>.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Template::Flute::Style::CSS

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Template-Flute-Style-CSS>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Template-Flute-Style-CSS>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Template-Flute-Style-CSS>

=item * Search CPAN

L<http://search.cpan.org/dist/Template-Flute-Style-CSS/>

=back

=head1 LICENSE AND COPYRIGHT

Copyright 2010-2012 Stefan Hornburg (Racke) <racke@linuxia.de>.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut

1;