1 |
package WebHACC::Language::RegExpJS; |
2 |
use strict; |
3 |
require WebHACC::Language::Base; |
4 |
push our @ISA, 'WebHACC::Language::Base'; |
5 |
|
6 |
sub new ($) { |
7 |
my $self = bless {}, shift; |
8 |
return $self; |
9 |
} # new |
10 |
|
11 |
sub generate_syntax_error_section ($) { |
12 |
my $self = shift; |
13 |
|
14 |
require Regexp::Parser::JavaScript; |
15 |
|
16 |
$self->result->layer_uncertain ('charset'); |
17 |
|
18 |
my $out = $self->output; |
19 |
$out->start_section (role => 'parse-errors'); |
20 |
$out->start_error_list (role => 'parse-errors'); |
21 |
$self->result->layer_applicable ('syntax'); |
22 |
|
23 |
my $input = $self->input; |
24 |
my $result = $self->result; |
25 |
|
26 |
$self->result->layer_uncertain ('encode') unless $input->{is_char_string}; |
27 |
|
28 |
require Encode; |
29 |
my $s = $input->{is_char_string} ? $input->{s} : Encode::decode ($input->{charset} || 'utf-8', $input->{s}); ## TODO: charset |
30 |
my $parser = Regexp::Parser::JavaScript->new; |
31 |
|
32 |
$parser->onerror (sub { |
33 |
my %opt = @_; |
34 |
|
35 |
if ($opt{code} == [$parser->RPe_BADESC]->[0]) { |
36 |
$opt{type} =~ s{%s%s}{ |
37 |
'%s' . (defined $opt{args}->[1] ? $opt{args}->[1] : '') |
38 |
}e; |
39 |
} elsif ($opt{code} == [$parser->RPe_FRANGE]->[0] or |
40 |
$opt{code} == [$parser->RPe_IRANGE]->[0]) { |
41 |
$opt{text} = $opt{args}->[0] . '-'; |
42 |
$opt{text} .= $opt{args}->[1] if defined $opt{args}->[1]; |
43 |
} elsif ($opt{code} == [$parser->RPe_BADFLG]->[0]) { |
44 |
## NOTE: Not used by JavaScript regexp parser in fact. |
45 |
$opt{text} = $opt{args}->[0] . $opt{args}->[1]; |
46 |
} else { |
47 |
$opt{text} = $opt{args}->[0]; |
48 |
} |
49 |
|
50 |
$result->add_error (%opt, layer => 'syntax'); |
51 |
}); |
52 |
|
53 |
eval { |
54 |
$parser->parse ($s); |
55 |
}; |
56 |
|
57 |
$self->{structure} = $parser; |
58 |
|
59 |
$out->end_error_list (role => 'parse-errors'); |
60 |
$out->end_section; |
61 |
} # generate_parse_error_section |
62 |
|
63 |
sub generate_structure_dump_section ($) { |
64 |
my $self = shift; |
65 |
|
66 |
my $parser = $self->{structure}; |
67 |
return if $parser->errnum; |
68 |
|
69 |
my $out = $self->output; |
70 |
$out->start_section (id => 'graph-', title => 'Graph'); |
71 |
|
72 |
require Regexp::Visualize::Simple; |
73 |
my $v = Regexp::Visualize::Simple->new; |
74 |
$v->push_regexp_node ($parser->root); |
75 |
|
76 |
require Encode; |
77 |
require MIME::Base64; |
78 |
|
79 |
while ($v->has_regexp_node) { |
80 |
my ($g, $i) = $v->next_graph; |
81 |
|
82 |
my $index = $out->input->full_subdocument_index; |
83 |
$index = $index ? $index . '.' . $i : $i; |
84 |
|
85 |
$out->start_section (id => 'graph-' . $i, |
86 |
title => 'Regexp #', text => $index, |
87 |
notab => 1); |
88 |
|
89 |
## If browsers supported SVG in text/html! |
90 |
|
91 |
my $svg = $g->as_svg; |
92 |
my $width = ''; |
93 |
my $height = ''; |
94 |
$width = int $1 + 1 if $svg =~ /width="([\d.]+)"/; |
95 |
$height = int $1 + 1 if $svg =~ /height="([\d.]+)"/; |
96 |
|
97 |
my $data_url = Encode::encode ('utf8', $svg); |
98 |
$data_url = MIME::Base64::encode_base64 ($data_url); |
99 |
$data_url =~ s/\s+//g; |
100 |
$data_url = 'data:image/svg+xml;base64,' . $data_url; |
101 |
|
102 |
$out->start_tag ('iframe', |
103 |
src => $data_url, |
104 |
width => $width, height => $height, |
105 |
seamless => 1); |
106 |
$out->end_tag ('iframe'); |
107 |
|
108 |
$out->end_section; |
109 |
} |
110 |
|
111 |
$out->end_section |
112 |
|
113 |
} # generate_structure_dump_section |
114 |
|
115 |
sub generate_structure_error_section ($) { } |
116 |
|
117 |
1; |