File Coverage

blib/lib/CSS/Tidy.pm
Criterion Covered Total %
statement 68 98 69.3
branch 12 22 54.5
condition 3 3 100.0
subroutine 11 13 84.6
pod 2 7 28.5
total 96 143 67.1


line stmt bran cond sub pod time code
1             package CSS::Tidy;
2 1     1   63092 use warnings;
  1         3  
  1         36  
3 1     1   5 use strict;
  1         2  
  1         19  
4 1     1   4 use Carp;
  1         2  
  1         45  
5 1     1   14 use utf8;
  1         3  
  1         7  
6             require Exporter;
7             our @ISA = qw(Exporter);
8             our @EXPORT_OK = qw/
9             copy_css
10             tidy_css
11             /;
12             our %EXPORT_TAGS = (
13             all => \@EXPORT_OK,
14             );
15             our $VERSION = '0.02';
16              
17 1     1   538 use C::Tokenize '$comment_re';
  1         4090  
  1         204  
18 1     1   567 use File::Slurper qw!read_text write_text!;
  1         13290  
  1         1053  
19              
20             sub copy_css
21             {
22 0     0 1 0 my (%options) = @_;
23 0         0 my $in = get_option (\%options, 'in');
24 0 0       0 if (! $in) {
25 0         0 carp "Specify the input css file with in => 'file'";
26 0         0 return;
27             }
28 0         0 my $out = get_option (\%options, 'out');
29 0 0       0 if (! $out) {
30 0         0 carp "Specify the output css file with out => 'file'";
31 0         0 return;
32             }
33 0         0 my $css = read_text ($in);
34 0         0 $css = tidy_css ($css, %options);
35 0         0 write_text ($out, $css);
36             }
37              
38             sub get_option
39             {
40 6     6 0 8 my ($o, $name) = @_;
41 6         11 my $value = $o->{$name};
42 6         8 delete $o->{$name};
43 6         8 return $value;
44             }
45              
46             sub check_options
47             {
48 6     6 0 7 my ($o) = @_;
49 6         11 my @k = keys %$o;
50 6         14 for my $k (@k) {
51 0         0 carp "Unknown option $k";
52 0         0 delete $o->{$k};
53             }
54             }
55              
56             sub tidy_css
57             {
58 6     6 1 3002 my ($text, %options) = @_;
59              
60 6         18 my $decomment = get_option (\%options, 'decomment');
61 6         16 check_options (\%options);
62              
63             # Store for comments during processing. They are then restored.
64 6         6 my $comments;
65 6 50       12 if ($decomment) {
66 0         0 $text = rm_comments ($text);
67             }
68             else {
69 6         13 ($text, $comments) = strip_comments ($text);
70             }
71 6         23 my @lines = split /\n/, $text;
72              
73 6         11 my @tidy;
74              
75             # Line number, but this could be wrong due to comment removal.
76             my $i;
77              
78             # Depth of nested { }
79 6         6 my $depth = 0;
80              
81 6         9 for (@lines) {
82 20         49 $i++;
83             # {} on the same line.
84              
85             # It would be better to deal with these beforehand.
86              
87             # If done before processing it will break the line numbers.
88              
89             # Need to also add then remove line number fake information.
90              
91 20 50       36 if (/^\s*(.*)\{(.*?)\}(.*)$/) {
92 0         0 my ($before, $between, $after) = ($1, $2, $3);
93 0         0 my $indent = ' ' x ($depth + 1);
94 0         0 push @tidy, "$indent$before {";
95 0         0 my @between = split /;\s*/, $between;
96 0         0 for my $b (@between) {
97 0         0 push @tidy, "$indent $b";
98             }
99 0         0 push @tidy, "$indent}";
100 0         0 push @tidy, "$indent$after";
101 0         0 next;
102             }
103 20 100       31 if (/\}/) {
104 6         7 $depth--;
105 6 50       12 if ($depth < 0) {
106 0         0 warn "$i: depth = $depth\n";
107             }
108             }
109 20         24 my $initial = '';
110 20 50       50 if (/^(\s*)/) {
111 20         30 $initial = $1;
112             }
113 20 50       35 if (length ($initial) != $depth * 4) {
114 0         0 s/^$initial/' ' x $depth/e;
  0         0  
115             }
116             # If not a CSS pseudoclass or pseudoelement
117 20 100 100     79 if (! /(?:\.|#)\w+.*?:/ && ! /^\s*:+/) {
118             # Insert a space after a colon
119 16         24 s/([^:]):(\S)/$1: $2/;
120             }
121 20         42 s/\s+$//;
122 20         26 push @tidy, $_;
123 20 100       46 if (/\{/) {
124 6         10 $depth++;
125             }
126             }
127              
128 6         16 my $out = join ("\n", @tidy);
129             # Reduce multiple blank lines to a single one.
130 6         22 $out =~ s/\n+/\n/g;
131             # Add a blank after }
132 6         43 $out =~ s/^(\s*\})/$1\n/gsm;
133             # Remove a blank line before }. This also tidies up the
134             # aftereffects of the above regex, which puts too many blank
135             # lines.
136 6         11 $out =~ s/\n\n(\s*\})/\n$1/g;
137 6 50       13 if (! $decomment) {
138 6         13 $out = restore_comments ($out, $comments);
139             }
140             # Add a blank line after comments.
141 6         14 $out =~ s!(\*/)!$1\n!g;
142 6         25 return $out;
143             }
144              
145             # Completely remove all the comments.
146              
147             sub rm_comments
148             {
149 0     0 0 0 my ($text) = @_;
150 0         0 $text =~ s!$comment_re!!sm;
151 0         0 return $text;
152             }
153              
154             # Strip the comments out in such a way that they can be restored.
155              
156             sub strip_comments
157             {
158 6     6 0 9 my ($text) = @_;
159 6         6 my @comments;
160 6         9 my $n = 0;
161 6         137 while ($text =~ s!($comment_re)!/\@ css_tidy_#$n \@/!sm) {
162 1         4 $n++;
163 1         8 push @comments, $1;
164             }
165 6         17 return ($text, \@comments);
166             }
167              
168             sub restore_comments
169             {
170 6     6 0 9 my ($text, $comments) = @_;
171 6         14 $text =~ s!/\@ css_tidy_#([0-9]+) \@/!$comments->[$1]!g;
172 6         10 return $text;
173             }
174              
175             1;