File Coverage

File:blib/lib/CSS.pm
Coverage:92.0%

linestmtbrancondsubtimecode
1package CSS;
2
3
5
5
5
22
8
42
use strict;
4
5
5
5
29
11
28
use warnings;
5
6our $VERSION = 2.01_07;
7
8sub new {
9
9
26
        my $class = shift;
10
9
36
        my $self = bless {}, $class;
11
12
9
1
55
4
        my %opts = (ref $_[0]) ? ((ref $_[0] eq 'HASH') ? %{$_[0]} : () ) : @_;
13
14
9
35
        $self->{atrules} = [];
15
9
27
        $self->{rulesets} = [];
16
9
29
        $self->{items} = [];
17
9
26
        $self->{sheets} = [];
18
19
9
32
        $self->{styles} = $self->{rulesets};
20
21
9
62
        $self->{grammar} = $opts{grammar} || 'CSS::Grammar::Core';
22
9
69
        $self->{adaptor} = $opts{adaptor} || 'CSS::Adaptor';
23
24
9
42
        return $self;
25}
26
27sub read_file {
28
13
45
        my ($self, $path) = @_;
29
30
13
41
        if (ref $path){
31
2
10
                if (ref $path eq 'ARRAY'){
32
1
1
2
8
                        $self->read_file($_) for @$path;
33
1
4
                        return;
34                }
35        } else {
36
11
39
   if ($path){
37
10
25
                        local *IN;
38
10
282
    open(IN, $path) or die "Couldn't open file: $!";
39
9
240
                        my $source = join '',<IN>;
40
9
62
                        close(IN);
41
9
52
                        $self->parse_string($source) if $source;
42
9
45
                        return;
43                }
44        }
45
2
2
        die "Only scalars and arrays accepted: $!";
46}
47
48sub read_string {
49
6
19
        my ($self, $data) = @_;
50
51
6
19
        if (ref $data){
52
2
10
                if (ref $data eq 'ARRAY'){
53
1
1
2
6
                        $self->read_string($_) for @$data;
54
1
3
                        return;
55                }
56        } else {
57
4
21
                return $self->parse_string($data) if length $data;
58        }
59}
60
61sub parse_string {
62
12
39
        my ($self, $string) = @_;
63
64
12
37
        my $grammar_class = $self->{grammar};
65
12
37
        return 0 unless $grammar_class;
66
67
12
41
        $self->load_module($grammar_class);
68
12
254
        my $grammar = eval "new $grammar_class";
69
12
96
        return 0 unless $grammar;
70
71        #
72        # toke, lex, reduce & walk into a sheet
73        #
74
75
12
48
        my $sheet = $grammar->parse($string);
76
77
12
41
        unless (defined $sheet){
78
79
0
0
                die "Can't walk the match tree";
80
0
0
                return 0;
81        }
82
83
84        #
85        # merge the resultant sheet with the CSS object
86        #
87
88
12
49
        $self->merge_sheet($sheet);
89
90
12
36
        return 1;
91}
92
93sub purge {
94
4
12
        my ($self) = @_;
95
96
4
15
        $self->{atrules} = [];
97
4
14
        $self->{rulesets} = [];
98
4
12
        $self->{items} = [];
99
4
17
        $self->{sheets} = [];
100
101
4
41
        $self->{styles} = $self->{rulesets};
102}
103
104sub set_adaptor {
105
1
4
        my $self = shift;
106
1
2
        my $adaptor = shift;
107
108
1
4
        $self->{adaptor} = $adaptor;
109}
110
111sub output {
112
5
12
        my $self = shift;
113
5
28
        my $adaptor_class = shift || $self->{adaptor};
114
115
5
12
        unless ($adaptor_class){
116
0
0
                die "no adaptor class";
117        }
118
119
5
16
        unless ($self->load_module($adaptor_class)){
120
0
0
                die "unable to load adaptor module";
121        }
122
123
5
73
        my $adaptor = eval "$adaptor_class->new();";
124
125
5
18
        unless (defined $adaptor){
126
0
0
                die "can't create adaptor ($adaptor_class)";
127        }
128
129
5
35
        unless ($adaptor->can('format_stylesheet')){
130
1
2
                die "adaptor can't format stylesheets";
131        }
132
133
4
15
        return $adaptor->format_stylesheet($self);
134}
135
136sub get_style_by_selector {
137
138
1
5
        return get_ruleset_by_selector(@_);
139}
140
141sub get_ruleset_by_selector {
142
3
11
        my ($self, $sel_name) = @_;
143
144
3
3
5
12
        for my $ruleset (@{$self->{rulesets}}){
145
146
7
21
                return $ruleset if $ruleset->match_selector($sel_name);
147        }
148
149
1
4
        return undef;
150}
151
152sub merge_sheet {
153
12
39
        my ($self, $stylesheet) = @_;
154
155
12
12
21
48
        for my $item (@{$stylesheet->{items}}){
156
157
41
41
64
124
                push @{$self->{items}}, $item;
158
41
3
141
9
                push @{$self->{atrules}}, $item if ref $item eq 'CSS::AtRule';
159
41
38
148
149
                push @{$self->{rulesets}}, $item if ref $item eq 'CSS::Ruleset';
160        }
161
162
12
12
25
46
        push @{$self->{sheets}}, $stylesheet;
163}
164
165sub load_module {
166
17
53
        my ($self, $module) = @_;
167
168
17
51
        my $file = "$module" . '.pm';
169
17
69
        $file =~ s{::}{/}g;
170
171
17
11
75
29
        return eval { 1 } if $INC{$file};
172
6
189
        my $ret = eval "require \$file";
173
6
85
        return 0 unless $ret;
174
175
6
99
        eval "\$module->import();";
176
6
30
        return 1;
177}
178
1791;
180