File Coverage

blib/lib/CSS/Object/Parser/Enhanced.pm
Criterion Covered Total %
statement 25 108 23.1
branch 0 54 0.0
condition 0 48 0.0
subroutine 9 14 64.2
pod 3 3 100.0
total 37 227 16.3


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## CSS Object Oriented - ~/lib/CSS/Object/Parser/Enhanced.pm
3             ## Version v0.1.0
4             ## Copyright(c) 2020 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <@sitael.tokyo.deguest.jp>
6             ## Created 2020/08/09
7             ## Modified 2020/08/09
8             ##
9             ##----------------------------------------------------------------------------
10             package CSS::Object::Parser::Enhanced;
11             BEGIN
12             {
13 1     1   1010 use strict;
  1         4  
  1         41  
14 1     1   6 use warnings;
  1         2  
  1         29  
15 1     1   6 use Module::Generic;
  1         2  
  1         6  
16 1     1   272 use parent qw( CSS::Object::Parser );
  1         2  
  1         5  
17 1     1   69 use CSS::Object::Rule;
  1         2  
  1         6  
18 1     1   222 use CSS::Object::Selector;
  1         3  
  1         7  
19 1     1   221 use CSS::Object::Property;
  1         2  
  1         7  
20 1     1   210 use Devel::Confess;
  1         2  
  1         20  
21 1     1   1111 our $VERSION = 'v0.1.0';
22             };
23              
24             sub parse_string
25             {
26 0     0 1   my $self = shift( @_ );
27 0   0       my $string = shift( @_ ) || return;
28 0   0       my $css = $self->css || return( $self->error( "Our css object is gone!" ) );
29 0           my $this = {};
30 0           for( my $pos = 0; $pos < length( $string ); $pos++ )
31             {
32 0           my $c = substr( $string, $pos, 1 );
33 0           my $next = substr( $string, $pos + 1, 1 );
34 0 0         my $prev = $pos > 0 ? substr( $string, $pos - 1, 1 ) : '';
35 0 0 0       if( $c eq '*' && $next eq '/' )
    0 0        
    0 0        
    0          
    0          
36             {
37 0           $css->new_comment( [ split( /\r?\n/, $this->{line} ) ] )->add_to( $css );
38 0           $this->{line} = '';
39 0           $this->{inside_comment} = 0;
40 0           next;
41             }
42             ## We found a comment in between rules. Comments within rules are processed separately in parse_element
43             elsif( $c eq '/' && $next eq '*' )
44             {
45 0           $this->{inside_comment}++;
46 0           next;
47             }
48             elsif( $this->{inside_comment} )
49             {
50 0           $this->{line} .= $c;
51             }
52             elsif( $this->{inside_statement} )
53             {
54             ## If we found a space and the next character is an opening brace, we are inside the element definition
55 0 0 0       if( $c =~ /^[[:space:]\h]$/ &&
    0 0        
    0 0        
    0 0        
56             !$this->{inside_quote} &&
57             $next eq '{' )
58             {
59 0           $this->{name} = $this->{buffer};
60 0           $this->{name} = $self->_trim( $this->{name} );
61             ## $pos + 1 because we skip the opening brace
62             $pos = $self->parse_element({
63             data => \$string,
64             pos => $pos + 1,
65             name => $this->{name},
66 0           });
67             }
68             elsif( $this->{inside_quote} )
69             {
70 0 0 0       if( $c eq $this->{inside_quote} && $prev ne '\\' )
71             {
72 0           $this->{inside_quote} = '';
73             }
74 0           $this->{buffer} .= $c;
75             }
76             elsif( ( $c eq '"' || $c eq "'" ) && $prev ne '\\' )
77             {
78 0 0         if( $this->{inside_quote} )
79             {
80 0           $this->{inside_quote} = '';
81             }
82             else
83             {
84 0           $this->{inside_quote} = $c;
85             }
86 0           $this->{buffer} .= $c;
87             }
88             elsif( $this->{inside_quote} )
89             {
90 0           $this->{buffer} .= $c;
91             }
92             else
93             {
94 0           $this->{buffer} .= $c;
95             }
96             }
97             ## We may have found an element, check the first character
98             ## XXX Confirm with rfc for the lawful characters
99             elsif( !$this->{inside_statement} && $c =~ /^[\@\:\[\#\.a-zA-Z0-9]$/ )
100             {
101 0           $this->{inside_statement}++;
102 0           $this->{buffer} = $c;
103             }
104             }
105             }
106              
107             sub parse_element
108             {
109 0     0 1   my $self = shift( @_ );
110 0           my $opts = {};
111 0 0         $opts = shift( @_ ) if( $self->_is_hash( $_[0] ) );
112             ## String reference
113 0           my $sref = $opts->{data};
114 0           my $pos = $opts->{pos};
115 0 0         die( "Value provided is not a scalar reference\n" ) if( ref( $sref ) ne 'SCALAR' );
116 0 0         die( "Position provided is not an integer\n" ) if( $pos !~ /^\-?\d+$/ );
117 0   0       my $css = $self->css || return( $self->error( "Our css object is gone!" ) );
118 0   0       my $rule = $self->rule_from_token( $opts->{name} ) || return;
119 0           my $p;
120 0           my $this = {};
121 0           for( $p = $pos; $p < length( $$sref ); $p++ )
122             {
123 0           my $c = substr( $string, $p, 1 );
124 0           my $next = substr( $string, $p + 1, 1 );
125 0 0         my $prev = $p > 0 ? substr( $string, $p - 1, 1 ) : '';
126 0 0 0       if( ( $c eq "'" || $c eq '"' ) && $prev ne '\\' )
    0 0        
    0 0        
    0          
127             {
128 0 0         if( $this->{inside_quote} )
129             {
130 0           $this->{inside_quote} = '';
131             }
132             else
133             {
134 0           $this->{inside_quote} = $c;
135             }
136 0           $this->{buffer} .= $c;
137             }
138             elsif( $this->{inside_quote} )
139             {
140 0           $this->{buffer} .= $c;
141             }
142             elsif( !length( $this->{prop} ) )
143             {
144 0           $this->{prop} = $c;
145             }
146             ## We are done with this property, and either this is the start of a sub element, such as with keyframes containing braces for the definitions of each frames
147             elsif( $c eq '{' && $prev ne '\\' )
148             {
149 0           $this->{prop} .= $this->{buffer};
150 0           $this->{buffer} = '';
151 0           $this->{prop} = $self->_trim( $this->{prop} );
152             my $res = $self->parse_element({
153             name => $this->{prop},
154 0   0       data => $sref,
155             ## After the opening brace we just found
156             pos => $p + 1,
157             }) || return;
158 0           my $props = $res->{properties};
159 0           $p = $res->{pos};
160             }
161             ## or we found semicolon which signals the start of the property value
162             else
163             {
164 0           $this->{buffer} .= $c;
165             }
166             }
167 0           $pos = $p;
168 0           return({ pos => $pos });
169             }
170              
171             ## "There are two kinds of statements"
172             ## https://developer.mozilla.org/en-US/docs/Web/CSS/Syntax#CSS_statements
173             sub rule_from_token
174             {
175 0     0 1   my $self = shift( @_ );
176 0   0       my $token = shift( @_ ) || return( $self->error( "No token was provided to create associated rule" ) );
177             ## If it's an at-rule
178 0 0         if( substr( $token, 0, 1 ) eq '@' )
179             {
180             }
181             else
182             {
183 0           my $selectors = $self->_split( $token );
184             }
185             }
186              
187             sub _split
188             {
189 0     0     my $self = shift( @_ );
190 0           my $token = shift( @_ );
191 0 0         return( [] ) if( !length( $token ) );
192 0           my $this = {};
193 0           for( my $i = 0; $i < length( $token ); $i++ )
194             {
195 0           my $c = substr( $token, $i, 1 );
196 0           my $next = substr( $token, $i + 1, 1 );
197 0 0         my $prev = $i > 0 ? substr( $token, $i - 1, 1 ) : '';
198 0 0         if( $this->{inside_quote} )
199             {
200 0 0 0       if( $c eq $this->{inside_quote} && $prev ne '\\' )
201             {
202 0           $this->{inside_quote} = '';
203             }
204 0           $this->{buffer} .= $c;
205             }
206             }
207             }
208              
209             sub _trim
210             {
211 0     0     my $self = shift( @_ );
212 0           my $text = shift( @_ );
213 0 0         return if( !length( $text ) );
214 0           $text =~ s/^[[:blank:]\h\r\n\v]+|[[:blank:]\h\r\n\v]+$//gs;
215 0           return( $text );
216             }
217              
218             1;
219              
220             __END__
221              
222             =encoding utf-8
223              
224             =head1 NAME
225              
226             CSS::Object::Parser::Enhanced - CSS Object Oriented Enhanced Parser
227              
228             =head1 SYNOPSIS
229              
230             use CSS::Object;
231             my $css = CSS::Object->new(
232             parser => 'CSS::Object::Parser::Enhanced',
233             format => $format_object,
234             debug => 3,
235             ) || die( CSS::Object->error );
236             $css->read( '/my/file.css' ) || die( $css->error );
237              
238             =head1 VERSION
239              
240             v0.1.0
241              
242             =head1 DESCRIPTION
243              
244             L<CSS::Object::Parser::Enhanced> is a lightweight, but thorough css parser. It aims at being very reliable and fast. The elements parsed are stored in a way so they can be stringified to produce a css stylesheet very close to the one that was parsed.
245              
246             =head1 CONSTRUCTOR
247              
248             =head2 new
249              
250             To instantiate a new L<CSS::Object::Parser::Enhanced> object, pass an hash reference of following parameters:
251              
252             =over 4
253              
254             =item I<debug>
255              
256             This is an integer. The bigger it is and the more verbose is the output.
257              
258             =back
259              
260             =head1 METHODS
261              
262             =head2 add_rule
263              
264             It takes 2 parameters: string of selectors and the rule content, i.e. inside the curly braces.
265              
266             It creates a new L<CSS::Object::Rule> object, adds to it a new L<CSS::Object::Selector> object for each selector found and also add a new L<CSS::Object::Property> object for each property found.
267              
268             It returns the rule object created.
269              
270             =head2 parse_element
271              
272             Provided with a set of parameters as an hash reference and this parse the element and returns a hash reference with 2 properties: I<rule> which is a L<CSS::Object::Rule> object and I<pos> which is an integer representing the position of the pointer in the parsed string.
273              
274             =head2 parse_string
275              
276             Provided with some css text data and this will parse it and return an array object of L<CSS::Object::Rule> objects. The array returned is an L<Module::Generic::Array> object.
277              
278             It does this by calling L</add_rule> on each rule found in the css data provided.
279              
280             Each L<CSS::Object::Rule> object containing one more more L<CSS::Object::Selector> objects and one or more L<CSS::Object::Property> objects.
281              
282             =head2 rule_from_token
283              
284             Provided with a css token and this returns an adequate rule object. CSS token can be a css selector, or an at rule
285              
286             =head1 AUTHOR
287              
288             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
289              
290             =head1 SEE ALSO
291              
292             L<CSS::Object>
293              
294             =head1 COPYRIGHT & LICENSE
295              
296             Copyright (c) 2020 DEGUEST Pte. Ltd.
297              
298             You can use, copy, modify and redistribute this package and associated
299             files under the same terms as Perl itself.
300              
301             =cut