| 1 |
wakaba |
1.1 |
package Whatpm::CSS::MediaQueryParser; |
| 2 |
|
|
use strict; |
| 3 |
|
|
our $VERSION=do{my @r=(q$Revision: 1.10 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r}; |
| 4 |
|
|
|
| 5 |
|
|
use Whatpm::CSS::Tokenizer qw(:token); |
| 6 |
|
|
|
| 7 |
|
|
sub new ($) { |
| 8 |
|
|
my $self = bless {onerror => sub { }, |
| 9 |
|
|
must_level => 'm', unsupported_level => 'u'}, shift; |
| 10 |
|
|
#$self->{href} = \(uri in which the MQ appears); |
| 11 |
|
|
return $self; |
| 12 |
|
|
} # new |
| 13 |
|
|
|
| 14 |
|
|
sub parse_char_string ($$) { |
| 15 |
|
|
my $self = $_[0]; |
| 16 |
|
|
|
| 17 |
|
|
my $s = $_[1]; |
| 18 |
|
|
pos ($s) = 0; |
| 19 |
|
|
|
| 20 |
|
|
my $tt = Whatpm::CSS::Tokenizer->new; |
| 21 |
|
|
$tt->{onerror} = $self->{onerror}; |
| 22 |
|
|
$tt->{line} = 1; |
| 23 |
|
|
$tt->{column} = 1; |
| 24 |
|
|
$tt->{get_char} = sub { |
| 25 |
|
|
if (pos $s < length $s) { |
| 26 |
|
|
$tt->{column} = 1 + pos $s; |
| 27 |
|
|
return ord substr $s, pos ($s)++, 1; |
| 28 |
|
|
} else { |
| 29 |
|
|
return -1; |
| 30 |
|
|
} |
| 31 |
|
|
}; # $tt->{get_char} |
| 32 |
|
|
$tt->init; |
| 33 |
|
|
|
| 34 |
|
|
my $t = $tt->get_next_token; |
| 35 |
|
|
$t = $tt->get_next_token while $t->{type} == S_TOKEN; |
| 36 |
|
|
|
| 37 |
|
|
my $r; |
| 38 |
|
|
($t, $r) = $self->_parse_mq_with_tokenizer ($t, $tt); |
| 39 |
|
|
return undef unless defined $r; |
| 40 |
|
|
|
| 41 |
|
|
if ($t->{type} != EOF_TOKEN) { |
| 42 |
|
|
$self->{onerror}->(type => 'mq syntax error', |
| 43 |
|
|
level => $self->{must_level}, |
| 44 |
|
|
uri => \$self->{href}, |
| 45 |
|
|
token => $t); |
| 46 |
|
|
return undef; |
| 47 |
|
|
} |
| 48 |
|
|
|
| 49 |
|
|
return $r; |
| 50 |
|
|
} # parse_char_string |
| 51 |
|
|
|
| 52 |
|
|
sub _parse_mq_with_tokenizer ($$$) { |
| 53 |
|
|
my ($self, $t, $tt) = @_; |
| 54 |
|
|
|
| 55 |
|
|
my $r = []; |
| 56 |
|
|
|
| 57 |
|
|
A: { |
| 58 |
|
|
## NOTE: Unknown media types are converted into 'unknown', since |
| 59 |
|
|
## Opera and WinIE do so and our implementation of the CSS |
| 60 |
|
|
## tokenizer currently normalizes numbers in NUMBER or DIMENSION tokens |
| 61 |
|
|
## so that the original representation cannot be preserved (e.g. '03d' |
| 62 |
|
|
## is covnerted to '3' with unit 'd'). |
| 63 |
|
|
|
| 64 |
|
|
if ($t->{type} == IDENT_TOKEN) { |
| 65 |
|
|
my $type = lc $t->{value}; ## TODO: case |
| 66 |
|
|
if ({ |
| 67 |
|
|
all => 1, braille => 1, embossed => 1, handheld => 1, print => 1, |
| 68 |
|
|
projection => 1, screen => 1, tty => 1, tv => 1, |
| 69 |
|
|
speech => 1, aural => 1, |
| 70 |
|
|
'atsc-tv' => 1, 'dde-tv' => 1, 'dvb-tv' => 1, |
| 71 |
|
|
dark => 1, emacs => 1, light => 1, xemacs => 1, |
| 72 |
|
|
}->{$type}) { |
| 73 |
|
|
push @$r, [['#type', $type]]; |
| 74 |
|
|
} else { |
| 75 |
|
|
push @$r, [['#type', 'unknown']]; |
| 76 |
|
|
$self->{onerror}->(type => 'unknown media type', |
| 77 |
|
|
level => $self->{unsupported_level}, |
| 78 |
|
|
uri => \$self->{href}, |
| 79 |
|
|
token => $t); |
| 80 |
|
|
} |
| 81 |
|
|
$t = $tt->get_next_token; |
| 82 |
|
|
} elsif ($t->{type} == NUMBER_TOKEN or $t->{type} == DIMENSION_TOKEN) { |
| 83 |
|
|
push @$r, [['#type', 'unknown']]; |
| 84 |
|
|
$self->{onerror}->(type => 'unknown media type', |
| 85 |
|
|
level => $self->{unsupported_level}, |
| 86 |
|
|
uri => \$self->{href}, |
| 87 |
|
|
token => $t); |
| 88 |
|
|
$t = $tt->get_next_token; |
| 89 |
|
|
} else { |
| 90 |
|
|
$self->{onerror}->(type => 'mq syntax error', |
| 91 |
|
|
level => $self->{must_level}, |
| 92 |
|
|
uri => \$self->{href}, |
| 93 |
|
|
token => $t); |
| 94 |
|
|
return ($t, undef); |
| 95 |
|
|
} |
| 96 |
|
|
|
| 97 |
|
|
$t = $tt->get_next_token while $t->{type} == S_TOKEN; |
| 98 |
|
|
if ($t->{type} == COMMA_TOKEN) { |
| 99 |
|
|
$t = $tt->get_next_token; |
| 100 |
|
|
$t = $tt->get_next_token while $t->{type} == S_TOKEN; |
| 101 |
|
|
redo A; |
| 102 |
|
|
} |
| 103 |
|
|
} # A |
| 104 |
|
|
|
| 105 |
|
|
return ($t, $r); |
| 106 |
|
|
} # _parse_mq_with_tokenizer |
| 107 |
|
|
|
| 108 |
|
|
1; |