File Coverage

blib/lib/Template/Flute/Style/CSS.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Template::Flute::Style::CSS;
2              
3 1     1   30822 use strict;
  1         3  
  1         39  
4 1     1   5 use warnings;
  1         3  
  1         29  
5              
6 1     1   1829 use CSS::Tiny;
  1         3382  
  1         31  
7              
8 1     1   423 use Template::Flute::Utils;
  0            
  0            
9              
10             # names for the sides of a box, as in border-top, border-right, ...
11             use constant SIDE_NAMES => qw/top right bottom left/;
12              
13             # default font size - used for the calucation of 1em
14             use constant FONT_SIZE => '12';
15              
16             our $VERSION = '0.0081';
17              
18             # block elements
19             my %block_elements = (address => 1,
20             blockquote => 1,
21             div => 1,
22             dl => 1,
23             fieldset => 1,
24             form => 1,
25             h1 => 1,
26             h2 => 1,
27             h3 => 1,
28             h4 => 1,
29             h5 => 1,
30             h6 => 1,
31             noscript => 1,
32             ol => 1,
33             p => 1,
34             pre => 1,
35             table => 1,
36             ul => 1);
37              
38             =head1 NAME
39              
40             Template::Flute::Style::CSS - CSS parser class for Template::Flute
41              
42             =head1 VERSION
43              
44             Version 0.0081
45              
46             =head1 CONSTRUCTOR
47              
48             =head2 new
49              
50             Create Template::Flute::Style::CSS object with the following parameters:
51              
52             =over 4
53              
54             =item template
55              
56             L object.
57              
58             =item prepend_directory
59              
60             Directory which is prepended to the CSS path when the
61             template doesn't reside in a file.
62              
63             =back
64              
65             =cut
66              
67             sub new {
68             my ($proto, @args) = @_;
69             my ($class, $self);
70              
71             $class = ref($proto) || $proto;
72             $self = {@args};
73              
74             bless ($self, $class);
75              
76             if ($self->{template}) {
77             $self->{css} = $self->_initialize();
78             }
79              
80             return $self;
81             }
82              
83             sub _initialize {
84             my ($self) = @_;
85             my (@ret, $css_file, $css);
86              
87             # create CSS::Tiny object
88             $css = new CSS::Tiny;
89              
90             # search for external stylesheets
91             for my $ext ($self->{template}->root()->get_xpath(qq{//link})) {
92             if ($ext->att('rel') eq 'stylesheet'
93             && $ext->att('type') eq 'text/css') {
94             if ($self->{template}->file) {
95             $css_file = Template::Flute::Utils::derive_filename
96             ($self->{template}->file, $ext->att('href'), 1);
97             }
98             elsif ($self->{prepend_directory}) {
99             $css_file = join('/', $self->{prepend_directory},
100             $ext->att('href'));
101             }
102             else {
103             $css_file = $ext->att('href');
104             }
105            
106             unless ($css->read($css_file)) {
107             die "Failed to parse CSS file $css_file: " . $css->errstr() . "\n";
108             }
109             }
110             }
111            
112             # search for inline stylesheets
113             push (@ret, $self->{template}->root()->get_xpath(qq{//style}));
114            
115             for (@ret) {
116             unless ($css->read_string($_->text())) {
117             die "Failed to parse inline CSS: " . $css->errstr() . "\n";
118             }
119             }
120            
121             return $css;
122             }
123              
124             =head1 METHODS
125              
126             =head2 properties
127              
128             Builds CSS properties based on the following parameters:
129              
130             =over 4
131              
132             =item selector
133              
134             CSS selector.
135              
136             =item class
137              
138             CSS class.
139              
140             =item id
141              
142             CSS id.
143              
144             =item tag
145              
146             HTML tag.
147              
148             =item inherit
149              
150             CSS properties to inherit from.
151              
152             =back
153              
154             =cut
155              
156             sub properties {
157             my ($self, %parms) = @_;
158             my (@ids, @classes, @tags, $props);
159              
160             # inherit from parent element
161             if (exists $parms{inherit}) {
162             $props = $self->inherit($parms{inherit});
163             }
164            
165             # defaults
166             unless (exists $props->{color}) {
167             $props->{color} = 'black';
168             }
169            
170             unless (exists $props->{font}->{size}) {
171             $props->{font}->{size} = FONT_SIZE;
172             }
173              
174             if (defined $parms{tag} && $parms{tag} =~ /\S/) {
175             @tags = split(/\s+/, $parms{tag});
176              
177             if (@tags) {
178             for my $tag (@tags) {
179             $self->_build_properties($props, $tag);
180              
181             if (($parms{tag} eq 'strong' || $parms{tag} eq 'b')
182             && ! exists $props->{font}->{weight}) {
183             $props->{font}->{weight} = 'bold';
184             }
185             }
186              
187             if ($parms{tag} eq 'p') {
188             # add automagic margin of 1em
189             for (qw/top bottom/) {
190             unless ($props->{margin}->{$_}) {
191             $props->{margin}->{$_} = $props->{font}->{size};
192              
193             if ($props->{font}->{size} =~ /^[0-9.]+$/) {
194             $props->{margin}->{$_} .= 'pt';
195             }
196             }
197             }
198             }
199            
200             if (! $props->{display} && exists $block_elements{$tags[0]} ) {
201             $props->{display} = 'block';
202             }
203             }
204             }
205            
206             if (defined $parms{id} && $parms{id} =~ /\S/) {
207             @ids = split(/\s+/, $parms{id});
208              
209             for my $id (@ids) {
210             $self->_build_properties($props, "#$id");
211             }
212             }
213              
214             if (defined $parms{class} && $parms{class} =~ /\S/) {
215             @classes = split(/\s+/, $parms{class});
216              
217             for my $class (@classes) {
218             $self->_build_properties($props, ".$class");
219             for (@tags) {
220             $self->_build_properties($props, "$_.$class");
221             }
222             }
223             }
224              
225             if (defined $parms{selector} && $parms{selector} =~ /\S/) {
226             $self->_build_properties($props, $parms{selector});
227             }
228              
229             $props->{display} ||= 'inline';
230              
231             $self->_expand_properties($props);
232              
233             return $props;
234             }
235              
236             =head2 descendant_properties
237              
238             Builds descendant CSS properties based on the following parameters:
239              
240             =over 4
241              
242             =item parent
243              
244             Parent properties.
245              
246             =item class
247              
248             CSS class.
249              
250             =item id
251              
252             CSS id.
253              
254             =item tag
255              
256             HTML tag.
257              
258             =back
259              
260             =cut
261              
262             sub descendant_properties {
263             my ($self, %parms) = @_;
264             my (@ids, @classes, @selectors, $regex, $sel, @tags, %selmap);
265              
266             if (ref($parms{parent}) eq 'HASH') {
267             %selmap = %{$parms{parent}};
268             }
269              
270             if (defined $parms{id} && $parms{id} =~ /\S/) {
271             @ids = split(/\s+/, $parms{id});
272              
273             for my $id (@ids) {
274             $regex = qr{^#$id\s+};
275             @selectors = $self->_grep_properties($regex);
276              
277             for (@selectors) {
278             $sel = substr($_, length($id) + 2);
279             $selmap{$sel} = $_;
280             }
281             }
282             }
283            
284             if (defined $parms{class} && $parms{class} =~ /\S/) {
285             @classes = split(/\s+/, $parms{class});
286              
287             for my $class (@classes) {
288             $regex = qr{^.$class\s+};
289             @selectors = $self->_grep_properties($regex);
290              
291             for (@selectors) {
292             $sel = substr($_, length($class) + 2);
293             $selmap{$sel} = $_;
294             }
295             }
296             }
297             elsif (defined $parms{tag} && $parms{tag} =~ /\S/) {
298             @tags = split(/\s+/, $parms{tag});
299            
300             for my $tag (@tags) {
301             $regex = qr{^$tag\s+};
302             @selectors = $self->_grep_properties($regex);
303            
304             for (@selectors) {
305             $sel = substr($_, length($tag) + 1);
306             $selmap{$sel} = $_;
307             }
308             }
309             }
310            
311             return \%selmap;
312             }
313              
314             sub _grep_properties {
315             my ($self, $sel_regex) = @_;
316             my (@selectors);
317              
318             @selectors = grep {/$sel_regex/} keys %{$self->{css}};
319              
320             return @selectors;
321             }
322              
323             sub _build_properties {
324             my ($self, $propref, $sel) = @_;
325             my ($props_css, $sides);
326             my (@specs, $value);
327            
328             $props_css = $self->{css}->{$sel};
329              
330             # background: all possible values in arbitrary order
331             # attachment,color,image,position,repeat
332              
333             if ($value = $props_css->{background}) {
334             @specs = split(/\s+/, $value);
335              
336             for (@specs) {
337             # attachment
338             if (/^(fixed|scroll)$/) {
339             $propref->{background}->{attachment} = $1;
340             next;
341             }
342             # color (switch later to one of Graphics::ColorNames modules)
343             if (/^(\#[0-9a-f]{3,6})$/) {
344             $propref->{background}->{color} = $1;
345             next;
346             }
347              
348             }
349             }
350              
351             for (qw/attachment color image position repeat/) {
352             if ($value = $props_css->{"background-$_"}) {
353             $propref->{background}->{$_} = $value;
354             }
355             }
356            
357             # border
358             if ($value = $props_css->{border}) {
359             my ($width, $style, $color) = split(/\s+/, $value);
360            
361             $propref->{border}->{all} = {width => $width,
362             style => $style,
363             color => $color};
364             }
365            
366             # border-width, border-style, border-color
367             for my $p (qw/width style color/) {
368             if ($value = $props_css->{"border-$p"}) {
369             $sides = $self->_by_sides($value);
370              
371             $propref->{border}->{all}->{$p} = $sides->{all};
372            
373             for (SIDE_NAMES) {
374             $propref->{border}->{$_}->{$p} = $sides->{$_} || $sides->{all};
375             }
376             }
377             }
378            
379             # border sides
380             for my $s (qw/top bottom left right/) {
381             if ($value = $props_css->{"border-$s"}) {
382             my ($width, $style, $color) = split(/\s+/, $value);
383              
384             $propref->{border}->{$s} = {width => $width,
385             style => $style,
386             color => $color};
387             }
388              
389             for my $p (qw/width style color/) {
390             if ($value = $props_css->{"border-$s-$p"}) {
391             $propref->{border}->{$s}->{$p} = $value;
392             }
393             }
394             }
395              
396             # clear
397             if ($props_css->{clear}) {
398             $propref->{clear} = $props_css->{clear};
399             }
400             elsif (! $propref->{clear}) {
401             $propref->{clear} = 'none';
402             }
403            
404             # color
405             if ($props_css->{color}) {
406             $propref->{color} = $props_css->{color};
407             }
408              
409             # display
410             if ($props_css->{display}) {
411             $propref->{display} = $props_css->{display};
412             }
413              
414             # float
415             if ($props_css->{float}) {
416             $propref->{float} = $props_css->{float};
417             }
418             elsif (! $propref->{float}) {
419             $propref->{float} = 'none';
420             }
421            
422             # font
423             if ($props_css->{'font-size'}) {
424             $propref->{font}->{size} = $props_css->{'font-size'};
425             }
426             if ($props_css->{'font-family'}) {
427             $propref->{font}->{family} = ucfirst(lc($props_css->{'font-family'}));
428             }
429             if ($props_css->{'font-style'}) {
430             $propref->{font}->{style} = ucfirst(lc($props_css->{'font-style'}));
431             }
432             if ($props_css->{'font-weight'}) {
433             $propref->{font}->{weight} = $props_css->{'font-weight'};
434             }
435              
436             # height
437             if ($props_css->{'height'}) {
438             $propref->{height} = $props_css->{height};
439             }
440              
441             # min-height
442             if ($props_css->{'min-height'}) {
443             $propref->{min_height} = $props_css->{'min-height'};
444             }
445            
446             # line-height
447             if ($props_css->{'line-height'}) {
448             $propref->{'line_height'} = $props_css->{'line-height'};
449             }
450              
451             # list-style
452             if ($props_css->{'list-style'}) {
453             $propref->{'list_style'} = $props_css->{'list-style'};
454             }
455            
456             # margin
457             if (exists $props_css->{'margin'}) {
458             $sides = $self->_by_sides($props_css->{'margin'});
459              
460             for (SIDE_NAMES) {
461             $propref->{margin}->{$_} = $sides->{$_} || $sides->{all};
462             }
463             }
464              
465             # margin sides
466             for (SIDE_NAMES) {
467             if (exists $props_css->{"margin-$_"}
468             && $props_css->{"margin-$_"} =~ /\S/) {
469             $propref->{margin}->{$_} = $props_css->{"margin-$_"};
470             }
471             }
472            
473             # padding
474             if ($props_css->{'padding'}) {
475             $sides = $self->_by_sides($props_css->{'padding'});
476              
477             for (SIDE_NAMES) {
478             $propref->{padding}->{$_} = $sides->{$_} || $sides->{all};
479             }
480             }
481              
482             # padding sides
483             for (SIDE_NAMES) {
484             if (exists $props_css->{"padding-$_"}
485             && $props_css->{"padding-$_"} =~ /\S/) {
486             $propref->{padding}->{$_} = $props_css->{"padding-$_"};
487             }
488             }
489              
490             # text
491             if ($props_css->{'text-align'}) {
492             $propref->{text}->{align} = $props_css->{'text-align'};
493             }
494             if ($props_css->{'text-decoration'}) {
495             $propref->{text}->{decoration} = $props_css->{'text-decoration'};
496             }
497             if ($props_css->{'text-transform'}) {
498             $propref->{text}->{transform} = $props_css->{'text-transform'};
499             }
500            
501             # transform
502             for (qw/transform -webkit-transform -moz-transform -o-transform -ms-transform/) {
503             my ($prop_value, @frags);
504              
505             if ($prop_value = $props_css->{$_}) {
506             @frags = split(/\s+/, $prop_value);
507              
508             for my $value (@frags) {
509             if ($value =~ s/^\s*rotate\(((-?)\d+(\.\d+)?)\s*deg\)\s*$/$1/) {
510             if ($2) {
511             # negative angle
512             $propref->{rotate} = 360 + $value;
513             }
514             else {
515             $propref->{rotate} = $value;
516             }
517             }
518             elsif ($value =~ /translate([xy])?\((.*?)(,(.*?))?\)/i) {
519             if (lc($1) eq 'x') {
520             # translateX value
521             $propref->{translate}->{x} = $2;
522             }
523             elsif (lc($1) eq 'y') {
524             # translateY value
525             $propref->{translate}->{y} = $2;
526             }
527             else {
528             # translate value (x and optionally y)
529             $propref->{translate}->{x} = $2;
530            
531             if ($4) {
532             $propref->{translate}->{y} = $4;
533             }
534             }
535             }
536             }
537              
538             last;
539             }
540             }
541              
542             # vertical-align
543             if ($props_css->{'vertical-align'}) {
544             $propref->{vertical_align} = $props_css->{'vertical-align'};
545             }
546              
547             # width
548             if ($props_css->{'width'}) {
549             $propref->{width} = $props_css->{width};
550             }
551              
552             # min-width
553             if ($props_css->{'min-width'}) {
554             $propref->{min_width} = $props_css->{'min-width'};
555             }
556            
557             return $propref;
558             }
559              
560             sub _expand_properties {
561             my ($self, $props) = @_;
562              
563             # border sides
564             for my $s (SIDE_NAMES) {
565             for my $p (qw/width style color/) {
566             next if exists $props->{border}->{$s}->{$p};
567             $props->{border}->{$s}->{$p} = $props->{border}->{all}->{$p};
568             }
569             }
570             }
571              
572             sub inherit {
573             my ($self, $inherit) = @_;
574             my (%props);
575              
576             # font
577             if ($inherit->{font}) {
578             %{$props{font}} = %{$inherit->{font}};
579             }
580              
581             # line height
582             if ($inherit->{line_height}) {
583             $props{line_height} = $inherit->{line_height};
584             }
585              
586             # text
587             if ($inherit->{text}) {
588             $props{text} = $inherit->{text};
589             }
590            
591             return \%props;
592             }
593              
594             # helper functions
595              
596             sub _by_sides {
597             my ($self, $value) = @_;
598             my (@specs, %sides);
599              
600             @specs = split(/\s+/, $value);
601              
602             if (@specs == 1) {
603             # all sides
604             $sides{all} = $specs[0];
605             } elsif (@specs == 2) {
606             # top/bottom, left/right
607             $sides{top} = $sides{bottom} = $specs[0];
608             $sides{left} = $sides{right} = $specs[1];
609             } elsif (@specs == 3) {
610             # top, left/right, bottom
611             $sides{top} = $specs[0];
612             $sides{left} = $sides{right} = $specs[1];
613             $sides{bottom} = $specs[2];
614             } elsif (@specs == 4) {
615             # top, right, bottom, left
616             $sides{top} = $specs[0];
617             $sides{right} = $specs[1];
618             $sides{bottom} = $specs[2];
619             $sides{left} = $specs[3];
620             }
621              
622             return \%sides;
623              
624             }
625              
626             =head1 AUTHOR
627              
628             Stefan Hornburg (Racke),
629              
630             =head1 BUGS
631              
632             Please report any bugs or feature requests to C, or through
633             the web interface at L.
634              
635             =head1 SUPPORT
636              
637             You can find documentation for this module with the perldoc command.
638              
639             perldoc Template::Flute::Style::CSS
640              
641             You can also look for information at:
642              
643             =over 4
644              
645             =item * RT: CPAN's request tracker
646              
647             L
648              
649             =item * AnnoCPAN: Annotated CPAN documentation
650              
651             L
652              
653             =item * CPAN Ratings
654              
655             L
656              
657             =item * Search CPAN
658              
659             L
660              
661             =back
662              
663             =head1 LICENSE AND COPYRIGHT
664              
665             Copyright 2010-2012 Stefan Hornburg (Racke) .
666              
667             This program is free software; you can redistribute it and/or modify it
668             under the terms of either: the GNU General Public License as published
669             by the Free Software Foundation; or the Artistic License.
670              
671             See http://dev.perl.org/licenses/ for more information.
672              
673             =cut
674              
675             1;
676