Whatpm/CSS/MediaQueryParser.pm

package Whatpm::CSS::MediaQueryParser;
use strict;
our $VERSION=do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};

use Whatpm::CSS::Tokenizer qw(:token);

sub new ($) {
  my $self = bless {
    onerror => sub { },
    level => {
      must => 'm',
      uncertain => 'u',
    },
  }, shift;
  #$self->{href} = \(uri in which the MQ appears);
  return $self;
} # new

sub parse_char_string ($$) {
  my $self = $_[0];

  my $s = $_[1];
  pos ($s) = 0;

  my $tt = Whatpm::CSS::Tokenizer->new;
  $tt->{onerror} = $self->{onerror};
  $tt->{line} = 1;
  $tt->{column} = 1;
  $tt->{get_char} = sub {
    if (pos $s < length $s) {
      $tt->{column} = 1 + pos $s;
      return ord substr $s, pos ($s)++, 1;
    } else {
      return -1;
    }
  }; # $tt->{get_char}
  $tt->init;

  my $t = $tt->get_next_token;
  $t = $tt->get_next_token while $t->{type} == S_TOKEN;

  my $r;
  ($t, $r) = $self->_parse_mq_with_tokenizer ($t, $tt);
  return undef unless defined $r;

  if ($t->{type} != EOF_TOKEN) {
    $self->{onerror}->(type => 'mq syntax error',
                       level => $self->{level}->{must},
                       uri => \$self->{href},
                       token => $t);
    return undef;
  }

  return $r;
} # parse_char_string

sub _parse_mq_with_tokenizer ($$$) {
  my ($self, $t, $tt) = @_;

  my $r = [];

  A: {
    ## NOTE: Unknown media types are converted into 'unknown', since
    ## Opera and WinIE do so and our implementation of the CSS
    ## tokenizer currently normalizes numbers in NUMBER or DIMENSION tokens
    ## so that the original representation cannot be preserved (e.g. '03d'
    ## is covnerted to '3' with unit 'd').

    if ($t->{type} == IDENT_TOKEN) {
      my $type = lc $t->{value}; ## TODO: case
      if ({
        all => 1, braille => 1, embossed => 1, handheld => 1, print => 1,
        projection => 1, screen => 1, tty => 1, tv => 1,
        speech => 1, aural => 1,
        'atsc-tv' => 1, 'dde-tv' => 1, 'dvb-tv' => 1,
        dark => 1, emacs => 1, light => 1, xemacs => 1,
      }->{$type}) {
        push @$r, [['#type', $type]];
      } else {
        push @$r, [['#type', 'unknown']];
        $self->{onerror}->(type => 'unknown media type',
                           level => $self->{level}->{uncertain},
                           uri => \$self->{href},
                           token => $t);
      }
      $t = $tt->get_next_token;
    } elsif ($t->{type} == NUMBER_TOKEN or $t->{type} == DIMENSION_TOKEN) {
      push @$r, [['#type', 'unknown']];
      $self->{onerror}->(type => 'unknown media type',
                         level => $self->{level}->{uncertain},
                         uri => \$self->{href},
                         token => $t);
      $t = $tt->get_next_token;
    } else {
      $self->{onerror}->(type => 'mq syntax error',
                         level => $self->{level}->{must},
                         uri => \$self->{href},
                         token => $t);    
      return ($t, undef);
    }

    $t = $tt->get_next_token while $t->{type} == S_TOKEN;
    if ($t->{type} == COMMA_TOKEN) {
      $t = $tt->get_next_token;
      $t = $tt->get_next_token while $t->{type} == S_TOKEN;
      redo A;
    }
  } # A

  return ($t, $r);
} # _parse_mq_with_tokenizer

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