File Coverage

blib/lib/Catalyst/Controller/SimpleCAS/CSS/Simple.pm
Criterion Covered Total %
statement 23 161 14.2
branch 0 36 0.0
condition 0 18 0.0
subroutine 7 24 29.1
pod 14 14 100.0
total 44 253 17.3


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