File Coverage

lib/CSS/Simple.pm
Criterion Covered Total %
statement 134 162 82.7
branch 25 38 65.7
condition 13 24 54.1
subroutine 21 24 87.5
pod 14 14 100.0
total 207 262 79.0


line stmt bran cond sub pod time code
1             package CSS::Simple;
2 6     6   4518 use strict;
  6         10  
  6         218  
3 6     6   24 use warnings;
  6         8  
  6         258  
4              
5             our $VERSION = '3220';
6              
7 6     6   29 use Carp;
  6         5  
  6         462  
8              
9 6     6   2858 use Tie::IxHash;
  6         20627  
  6         168  
10 6     6   3636 use Storable qw(dclone);
  6         16399  
  6         589  
11              
12             =pod
13              
14             =head1 NAME
15              
16             CSS::Simple - Interface through which to read/write/manipulate CSS files while respecting the cascade order
17              
18             =head1 SYNOPSIS
19              
20             use CSS::Simple;
21              
22             my $css = new CSS::Simple();
23              
24             $css->read_file({ filename => 'input.css' });
25              
26             #perform manipulations...
27              
28             $css->write_file({ filename => 'output.css' });
29              
30             =head1 DESCRIPTION
31              
32             Class for reading, manipulating and writing CSS. Unlike other CSS classes on CPAN this particular module
33             focuses on respecting the order of selectors while providing a common sense API through which to manipulate the
34             rules.
35              
36             Please note that while ordering is respected, the exact order of selectors may change. I.e. the rules
37             implied by the styles and their ordering will not change, but the actual ordering of the styles may shift around.
38             See the read method for more information.
39              
40             =cut
41              
42             BEGIN {
43 6     6   21 my $members = ['ordered','stylesheet','warns_as_errors','content_warnings','browser_specific_properties'];
44              
45             #generate all the getter/setter we need
46 6         389 foreach my $member (@{$members}) {
  6         14  
47 6     6   518 no strict 'refs';
  6         445  
  6         970  
48              
49 30         11504 *{'_' . $member} = sub {
50 240     240   181 my ($self,$value) = @_;
51              
52 240         239 $self->_check_object();
53              
54 240 100       309 $self->{$member} = $value if defined($value);
55              
56 240         1212 return $self->{$member};
57             }
58 30         81 }
59             }
60              
61              
62             =pod
63              
64             =head1 CONSTRUCTOR
65              
66             =over 4
67              
68             =item new ([ OPTIONS ])
69              
70             Instantiates the CSS::Simple object. Sets up class variables that are used during file parsing/processing.
71              
72             B (optional). Boolean value to indicate whether fatal errors should occur during parse failures.
73              
74             B (optional). Boolean value to indicate whether browser specific properties should be processed.
75              
76             =back
77              
78             =cut
79              
80             sub new {
81 10     10 1 4249 my ($proto, $params) = @_;
82              
83 10   33     58 my $class = ref($proto) || $proto;
84              
85 10         13 my $css = {};
86              
87 10         65 my $self = {
88             stylesheet => undef,
89 10 100 66     12 ordered => tie(%{$css}, 'Tie::IxHash'),
    100 100        
90             content_warnings => undef,
91             warns_as_errors => (defined($$params{warns_as_errors}) && $$params{warns_as_errors}) ? 1 : 0,
92             browser_specific_properties => (defined($$params{browser_specific_properties}) && $$params{browser_specific_properties}) ? 1 : 0
93             };
94              
95 10         212 bless $self, $class;
96 10         354 return $self;
97             }
98              
99             =head1 METHODS
100              
101             =cut
102              
103             =pod
104              
105             =over 4
106              
107             =item read_file( params )
108              
109             Opens and reads a CSS file, then subsequently performs the parsing of the CSS file
110             necessary for later manipulation.
111              
112             This method requires you to pass in a params hash that contains a
113             filename argument. For example:
114              
115             $self->read_file({filename => 'myfile.css'});
116              
117             =cut
118              
119             sub read_file {
120 0     0 1 0 my ($self,$params) = @_;
121              
122 0         0 $self->_check_object();
123              
124 0 0 0     0 unless ($params && $$params{filename}) {
125 0         0 croak "You must pass in hash params that contain a filename argument";
126             }
127              
128 0 0       0 open FILE, "<", $$params{filename} or croak $!;
129 0         0 my $css = do { local( $/ ) ; } ;
  0         0  
  0         0  
130 0         0 close FILE;
131              
132 0         0 $self->read({css => $css});
133              
134 0         0 return();
135             }
136              
137             =pod
138              
139             =item read( params )
140              
141             Reads css data and parses it. The intermediate data is stored in class variables.
142              
143             Compound selectors (i.e. "a, span") are split apart during parsing and stored
144             separately, so the output of any given stylesheet may not match the output 100%, but the
145             rules themselves should apply as expected.
146              
147             Ordering of selectors may shift if the same selector is seen twice within the stylesheet.
148             The precendence for any given selector is the last time it was seen by the parser.
149              
150             This method requires you to pass in a params hash that contains scalar
151             css data. For example:
152              
153             $self->read({css => $css});
154              
155             =cut
156              
157             sub read {
158 8     8 1 37 my ($self,$params) = @_;
159              
160 8         12 $self->_check_object();
161              
162 8         12 $self->_content_warnings({}); # overwrite any existing warnings
163              
164 8 50       15 unless (exists $$params{css}) {
165 0         0 croak 'You must pass in hash params that contains the css data';
166             }
167              
168 8 50 33     31 if ($params && $$params{css}) {
169             # Flatten whitespace and remove /* comment */ style comments
170 8         8 my $string = $$params{css};
171 8         17 $string =~ tr/\n\t/ /;
172 8         14 $string =~ s!/\*.*?\*\/!!g;
173              
174             # Split into styles
175 8         131 foreach (grep { /\S/ } split /(?<=\})/, $string) {
  38         58  
176              
177 30 50       151 unless ( /^\s*([^{]+?)\s*\{(.*)\}\s*$/ ) {
178 0         0 $self->_report_warning({ info => "Invalid or unexpected style data '$_'" });
179 0         0 next;
180             }
181              
182             # Split in such a way as to support grouped styles
183 30         45 my $rule = $1;
184 30         40 my $props = $2;
185              
186 30         40 $rule =~ s/\s{2,}/ /g;
187              
188             # Split into properties
189 30         24 my $properties = {};
190 30         58 foreach ( grep { /\S/ } split /\;/, $props ) {
  89         135  
191              
192             # skip over browser specific properties unless specified in constructor
193 59 100 100     73 if (!$self->_browser_specific_properties() && (( /^\s*[*-_]/ ) || ( /\\/ ))) {
      66        
194 12         13 next;
195             }
196              
197             # check if properties are valid, reporting error as configured
198 47 100       145 unless ( /^\s*([\w._-]+)\s*:\s*(.*?)\s*$/ ) {
199 3         22 $self->_report_warning({ info => "Invalid or unexpected property '$_' in style '$rule'" });
200 2         6 next;
201             }
202              
203             #store the property for later
204 44         125 $$properties{lc $1} = $2;
205             }
206              
207 29         63 my @selectors = split /,/, $rule; # break the rule into the component selector(s)
208              
209             #apply the found rules to each selector
210 29         32 foreach my $selector (@selectors) {
211 30         64 $selector =~ s/^\s+|\s+$//g;
212 30 100       60 if ($self->check_selector({selector => $selector})) { #check if we already exist
213 3         13 my $old_properties = $self->get_properties({selector => $selector});
214 3         17 $self->delete_selector({selector => $selector});
215              
216 3         10 my %merged = (%$old_properties, %$properties);
217              
218 3         8 $self->add_selector({selector => $selector, properties => \%merged});
219             }
220             else {
221             #store the properties within this selector
222 27         139 $self->add_selector({selector => $selector, properties => $properties});
223             }
224             }
225             }
226             }
227             else {
228 0         0 $self->_report_warning({ info => 'No stylesheet data was found in the document'});
229             }
230              
231 7         16 return();
232             }
233              
234             =pod
235              
236             =item write_file()
237              
238             Write the parsed and manipulated CSS out to a file parameter
239              
240             This method requires you to pass in a params hash that contains a
241             filename argument. For example:
242              
243             $self->write_file({filename => 'myfile.css'});
244              
245             =cut
246              
247             sub write_file {
248 0     0 1 0 my ($self,$params) = @_;
249              
250 0         0 $self->_check_object();
251              
252 0 0       0 unless (exists $$params{filename}) {
253 0         0 croak "No filename specified for write operation";
254             }
255              
256             # Write the file
257 0 0       0 open( CSS, '>'. $$params{filename} ) or croak "Failed to open file '$$params{filename}' for writing: $!";
258 0         0 print CSS $self->write();
259 0         0 close( CSS );
260              
261 0         0 return();
262             }
263              
264             =pod
265              
266             =item write()
267              
268             Write the parsed and manipulated CSS out to a scalar and return it
269              
270             =cut
271              
272             sub write {
273 4     4 1 14 my ($self,$params) = @_;
274              
275 4         21 $self->_check_object();
276              
277 4         5 my $contents = '';
278              
279 4         9 foreach my $selector ( $self->_ordered()->Keys ) {
280              
281             #grab the properties that make up this particular selector
282 28         77 my $properties = $self->get_properties({selector => $selector});
283              
284 28 100       100 if (keys(%{$properties})) { # only output if the selector has properties
  28         60  
285 23         25 $contents .= "$selector {\n";
286 23         18 foreach my $property ( sort keys %{ $properties } ) {
  23         61  
287 42         73 $contents .= "\t" . lc($property) . ": ".$properties->{$property}. ";\n";
288             }
289 23         37 $contents .= "}\n";
290             }
291             }
292              
293 4         11 return $contents;
294             }
295              
296             =pod
297            
298             =item content_warnings()
299            
300             Return back any warnings thrown while parsing a given block of css
301              
302             Note: content warnings are initialized at read time. In order to
303             receive back content feedback you must perform read() first.
304              
305             =cut
306              
307             sub content_warnings {
308 1     1 1 4 my ($self,$params) = @_;
309              
310 1         1 $self->_check_object();
311              
312 1         1 my @content_warnings = keys %{$self->_content_warnings()};
  1         2  
313              
314 1         3 return \@content_warnings;
315             }
316              
317             ####################################################################
318             # #
319             # The following are all get/set methods for manipulating the #
320             # stored stylesheet #
321             # #
322             # Provides a nicer interface than dealing with TIE #
323             # #
324             ####################################################################
325              
326             =pod
327              
328             =item get_selectors( params )
329              
330             Get an array of selectors that represents an inclusive list of all selectors
331             stored.
332              
333             =cut
334              
335             sub get_selectors {
336 0     0 1 0 my ($self,$params) = @_;
337              
338 0         0 $self->_check_object();
339              
340 0         0 return($self->_ordered()->Keys());
341             }
342              
343             =pod
344              
345             =item get_properties( params )
346              
347             Get a hash that represents the various properties for this particular selector
348              
349             This method requires you to pass in a params hash that contains scalar
350             css data. For example:
351              
352             $self->get_properties({selector => '.foo'});
353              
354             =cut
355              
356             sub get_properties {
357 39     39 1 48 my ($self,$params) = @_;
358              
359 39         37 $self->_check_object();
360              
361 39         46 return($self->_ordered()->FETCH($$params{selector}));
362             }
363              
364             =pod
365              
366             =item check_selector( params )
367              
368             Determine if a selector exists within the stored rulesets
369              
370             This method requires you to pass in a params hash that contains scalar
371             css data. For example:
372              
373             $self->check_selector({selector => '.foo'});
374              
375             =cut
376              
377             sub check_selector {
378 77     77 1 56 my ($self,$params) = @_;
379              
380 77         93 $self->_check_object();
381              
382 77         92 return($self->_ordered()->EXISTS($$params{selector}));
383             }
384              
385             =pod
386              
387             =item modify_selector( params )
388              
389             Modify an existing selector
390            
391             Modifying a selector maintains the existing selectivity of the rule with relation to the
392             original stylesheet. If you want to ignore that selectivity, delete the element and re-add
393             it to CSS::Simple
394              
395             This method requires you to pass in a params hash that contains scalar
396             css data. For example:
397              
398             $self->modify_selector({selector => '.foo', new_selector => '.bar' });
399              
400             =cut
401              
402             sub modify_selector {
403 2     2 1 15 my ($self,$params) = @_;
404              
405 2         4 $self->_check_object();
406              
407             #if the selector is found, replace the selector
408 2 50       4 if ($self->check_selector({selector => $$params{selector}})) {
409             #we probably want to be doing this explicitely
410 2         11 my ($index) = $self->_ordered()->Indices( $$params{selector} );
411 2         12 my $properties = $self->get_properties({selector => $$params{selector}});
412              
413 2         10 $self->_ordered()->Replace($index,$properties,$$params{new_selector});
414             }
415             #otherwise new element, stick it onto the end of the rulesets
416             else {
417             #add a selector, there was nothing to replace
418 0         0 $self->add_selector({selector => $$params{new_selector}, properties => {}});
419             }
420              
421 2         35 return();
422             }
423              
424             =pod
425              
426             =item add_selector( params )
427              
428             Add a selector and associated properties to the stored rulesets
429              
430             In the event that this particular ruleset already exists, invoking this method will
431             simply replace the item. This is important - if you are modifying an existing rule
432             using this method than the previously existing selectivity will continue to persist.
433             Delete the selector first if you want to ignore the previous selectivity.
434              
435             This method requires you to pass in a params hash that contains scalar
436             css data. For example:
437              
438             $self->add_selector({selector => '.foo', properties => {color => 'red' }});
439              
440             =cut
441              
442             sub add_selector {
443 41     41 1 75 my ($self,$params) = @_;
444              
445 41         48 $self->_check_object();
446              
447             #if we existed already, invoke REPLACE to preserve selectivity
448 41 100       90 if ($self->check_selector({selector => $$params{selector}})) {
449             #we probably want to be doing this explicitely
450 2         7 my ($index) = $self->_ordered()->Indices( $$params{selector} );
451              
452 2         10 $self->_ordered()->Replace($index,dclone($$params{properties}));
453             }
454             #new element, stick it onto the end of the rulesets
455             else {
456             #store the properties
457 39         146 $self->_ordered()->STORE($$params{selector},dclone($$params{properties}));
458             }
459              
460 41         469 return();
461             }
462              
463             =pod
464              
465             =item add_properties( params )
466              
467             Add properties to an existing selector, preserving the selectivity of the original declaration.
468              
469             In the event that this method is invoked with a selector that doesn't exist then the call
470             is just translated to an add_selector call, thus creating the rule at the end of the ruleset.
471              
472             This method requires you to pass in a params hash that contains scalar
473             css data. For example:
474              
475             $self->add_properties({selector => '.foo', properties => {color => 'red' }});
476              
477             =cut
478              
479             sub add_properties {
480 4     4 1 24 my ($self,$params) = @_;
481              
482 4         5 $self->_check_object();
483              
484             #If selector exists already, merge properties into this selector
485 4 100       8 if ($self->check_selector({selector => $$params{selector}})) {
486             #merge property sets together
487 1         3 my %properties = (%{$self->get_properties({selector => $$params{selector}})}, %{$$params{properties}});
  1         3  
  1         7  
488              
489             #overwrite the existing properties for this selector with the new hybrid style
490 1         14 $self->add_selector({selector => $$params{selector}, properties => \%properties});
491             }
492             #otherwise add it wholesale
493             else {
494 3         14 $self->add_selector({selector => $$params{selector}, properties => $$params{properties}});
495             }
496              
497 4         7 return();
498             }
499              
500             =pod
501              
502             =item delete_selector( params )
503              
504             Delete a selector from the ruleset
505              
506             This method requires you to pass in a params hash that contains scalar
507             css data. For example:
508              
509             $self->delete_selector({selector => '.foo' });
510              
511             =cut
512              
513             sub delete_selector {
514 3     3 1 2 my ($self,$params) = @_;
515              
516 3         3 $self->_check_object();
517              
518             #store the properties, potentially overwriting properties that were there
519 3         4 $self->_ordered()->DELETE($$params{selector});
520              
521 3         35 return();
522             }
523              
524             =pod
525              
526             =item delete_property( params )
527              
528             Delete a property from a specific selectors rules
529              
530             This method requires you to pass in a params hash that contains scalar
531             css data. For example:
532              
533             $self->delete_property({selector => '.foo', property => 'color' });
534              
535             =back
536              
537             =cut
538              
539             sub delete_property {
540 1     1 1 5 my ($self,$params) = @_;
541              
542 1         2 $self->_check_object();
543              
544             #get the properties so we can remove the requested property from the hash
545 1         2 my $properties = $self->get_properties({selector => $$params{selector}});
546              
547 1         5 delete $$properties{$$params{property}};
548              
549 1         2 $self->add_selector({selector => $$params{selector}, properties => $properties});
550              
551 1         2 return();
552             }
553            
554             ####################################################################
555             # #
556             # The following are all private methods and are not for normal use #
557             # I am working to finalize the get/set methods to make them public #
558             # #
559             ####################################################################
560              
561             sub _check_object {
562 423     423   315 my ($self,$params) = @_;
563              
564 423 50 33     1218 unless ($self && ref $self) {
565 0         0 croak "You must instantiate this class in order to properly use it";
566             }
567              
568 423         340 return();
569             }
570              
571             sub _report_warning {
572 3     3   4 my ($self,$params) = @_;
573              
574 3         3 $self->_check_object();
575              
576 3 100       5 if ($self->{warns_as_errors}) {
577 1         169 croak $$params{info};
578             }
579             else {
580 2         2 my $warnings = $self->_content_warnings();
581 2         3 $$warnings{$$params{info}} = 1;
582             }
583              
584 2         2 return();
585             }
586              
587             1;
588              
589             =pod
590              
591             =head1 Sponsor
592              
593             This code has been developed under sponsorship of MailerMailer LLC, http://www.mailermailer.com/
594              
595             =head1 AUTHOR
596              
597             Kevin Kamel >
598              
599             =head1 ATTRIBUTION
600              
601             This module is directly based off of Adam Kennedy's CSS::Tiny module.
602              
603             This particular version differs in terms of interface and the ultimate ordering of the CSS.
604              
605             =head1 LICENSE
606              
607             This module is a derived version of Adam Kennedy's CSS::Tiny Module.
608              
609             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
610              
611             The full text of the license can be found in the LICENSE file included with this module.
612              
613             =cut