| 55 |
return $_[0]->{handle}; |
return $_[0]->{handle}; |
| 56 |
} # handle |
} # handle |
| 57 |
|
|
| 58 |
|
sub has_error ($;$) { |
| 59 |
|
if (@_ > 1) { |
| 60 |
|
if (defined $_[1]) { |
| 61 |
|
$_[0]->{has_error} = 1; |
| 62 |
|
} else { |
| 63 |
|
delete $_[0]->{has_error}; |
| 64 |
|
} |
| 65 |
|
} |
| 66 |
|
|
| 67 |
|
return $_[0]->{has_error}; |
| 68 |
|
} # has_error |
| 69 |
|
|
| 70 |
sub set_utf8 ($) { |
sub set_utf8 ($) { |
| 71 |
binmode shift->{handle}, ':utf8'; |
binmode shift->{handle}, ':utf8'; |
| 72 |
} # set_utf8 |
} # set_utf8 |
| 130 |
$opt{short_title} ||= 'Struct. Errors'; |
$opt{short_title} ||= 'Struct. Errors'; |
| 131 |
$class .= ' errors'; |
$class .= ' errors'; |
| 132 |
delete $opt{role}; |
delete $opt{role}; |
| 133 |
|
} elsif ($opt{role} eq 'transfer-errors') { |
| 134 |
|
$opt{id} ||= 'transfer-errors'; |
| 135 |
|
$opt{title} ||= 'Transfer Errors'; |
| 136 |
|
$opt{short_title} ||= 'Trans. Errors'; |
| 137 |
|
$class .= ' errors'; |
| 138 |
|
delete $opt{role}; |
| 139 |
} elsif ($opt{role} eq 'reformatted') { |
} elsif ($opt{role} eq 'reformatted') { |
| 140 |
$opt{id} ||= 'document-tree'; |
$opt{id} ||= 'document-tree'; |
| 141 |
$opt{title} ||= 'Reformatted Document Source'; |
$opt{title} ||= 'Reformatted Document Source'; |
| 163 |
$opt{short_title} ||= 'Source'; |
$opt{short_title} ||= 'Source'; |
| 164 |
$class .= ' source'; |
$class .= ' source'; |
| 165 |
delete $opt{role}; |
delete $opt{role}; |
| 166 |
|
} elsif ($opt{role} eq 'result') { |
| 167 |
|
$opt{id} ||= 'result-summary'; |
| 168 |
|
$opt{title} ||= 'Result'; |
| 169 |
|
$class .= ' result'; |
| 170 |
|
delete $opt{role}; |
| 171 |
} |
} |
| 172 |
} |
} |
| 173 |
|
|
| 219 |
} elsif ($opt{role} eq 'structure-errors') { |
} elsif ($opt{role} eq 'structure-errors') { |
| 220 |
$opt{id} ||= 'document-errors-list'; |
$opt{id} ||= 'document-errors-list'; |
| 221 |
delete $opt{role}; |
delete $opt{role}; |
| 222 |
|
} elsif ($opt{role} eq 'transfer-errors') { |
| 223 |
|
$opt{id} ||= 'transfer-errors-list'; |
| 224 |
|
delete $opt{role}; |
| 225 |
} |
} |
| 226 |
} |
} |
| 227 |
|
|
| 228 |
$self->start_tag ('dl', %opt); |
$self->start_tag ('dl', %opt); |
| 229 |
|
|
| 230 |
|
delete $self->{has_error}; # reset |
| 231 |
} # start_error_list |
} # start_error_list |
| 232 |
|
|
| 233 |
sub end_error_list ($%) { |
sub end_error_list ($%) { |
| 234 |
my ($self, %opt) = @_; |
my ($self, %opt) = @_; |
| 235 |
|
|
| 236 |
|
my $no_error_message = 'No error found.'; |
| 237 |
|
|
| 238 |
if (defined $opt{role}) { |
if (defined $opt{role}) { |
| 239 |
if ($opt{role} eq 'parse-errors') { |
if ($opt{role} eq 'parse-errors') { |
|
delete $opt{role}; |
|
| 240 |
$self->end_tag ('dl'); |
$self->end_tag ('dl'); |
| 241 |
## NOTE: For parse error list, the |add_source_to_parse_error_list| |
## NOTE: For parse error list, the |add_source_to_parse_error_list| |
| 242 |
## method is invoked at the end of |generate_source_string_section|, |
## method is invoked at the end of |generate_source_string_section|, |
| 243 |
## since that generation method is invoked after the error list |
## since that generation method is invoked after the error list |
| 244 |
## is generated. |
## is generated. |
| 245 |
|
$no_error_message = 'No parse error found.'; |
| 246 |
} elsif ($opt{role} eq 'structure-errors') { |
} elsif ($opt{role} eq 'structure-errors') { |
|
delete $opt{role}; |
|
| 247 |
$self->end_tag ('dl'); |
$self->end_tag ('dl'); |
| 248 |
$self->add_source_to_parse_error_list ('document-errors-list'); |
$self->add_source_to_parse_error_list ('document-errors-list'); |
| 249 |
|
$no_error_message = 'No structural error found.'; |
| 250 |
|
} elsif ($opt{role} eq 'transfer-errors') { |
| 251 |
|
$self->end_tag ('dl'); |
| 252 |
|
$no_error_message = 'No transfer error found.'; |
| 253 |
} else { |
} else { |
| 254 |
$self->end_tag ('dl'); |
$self->end_tag ('dl'); |
| 255 |
} |
} |
| 256 |
} else { |
} else { |
| 257 |
$self->end_tag ('dl'); |
$self->end_tag ('dl'); |
| 258 |
} |
} |
| 259 |
|
|
| 260 |
|
unless ($self->{has_error}) { |
| 261 |
|
$self->start_tag ('p', class => 'no-errors'); |
| 262 |
|
$self->nl_text ($no_error_message); |
| 263 |
|
} |
| 264 |
} # end_error_list |
} # end_error_list |
| 265 |
|
|
| 266 |
sub add_source_to_parse_error_list ($$) { |
sub add_source_to_parse_error_list ($$) { |
| 443 |
$msg =~ s{<var>{text}</var>}{ |
$msg =~ s{<var>{text}</var>}{ |
| 444 |
defined $opt{text} ? $htescape->($opt{text}) : '' |
defined $opt{text} ? $htescape->($opt{text}) : '' |
| 445 |
}ge; |
}ge; |
| 446 |
|
$msg =~ s{<var>{value}</var>}{ |
| 447 |
|
defined $opt{value} ? $htescape->($opt{value}) : '' |
| 448 |
|
}ge; |
| 449 |
$msg =~ s{<var>{local-name}</var>}{ |
$msg =~ s{<var>{local-name}</var>}{ |
| 450 |
UNIVERSAL::can ($node, 'manakai_local_name') |
UNIVERSAL::can ($node, 'manakai_local_name') |
| 451 |
? $htescape->($node->manakai_local_name) : '' |
? $htescape->($node->manakai_local_name) : '' |
| 511 |
sub generate_input_section ($$) { |
sub generate_input_section ($$) { |
| 512 |
my ($out, $cgi) = @_; |
my ($out, $cgi) = @_; |
| 513 |
|
|
| 514 |
|
require Encode; |
| 515 |
|
my $decode = sub ($) { |
| 516 |
|
if (defined $_[0]) { |
| 517 |
|
return Encode::decode ('utf-8', $_[0]); |
| 518 |
|
} else { |
| 519 |
|
return undef; |
| 520 |
|
} |
| 521 |
|
}; # $decode |
| 522 |
|
|
| 523 |
my $options = sub ($) { |
my $options = sub ($) { |
| 524 |
my $context = shift; |
my $context = shift; |
| 525 |
|
|
| 593 |
$out->nl_text ('Setting innerHTML'); |
$out->nl_text ('Setting innerHTML'); |
| 594 |
$out->text (': '); |
$out->text (': '); |
| 595 |
$out->start_tag ('input', name => 'e', |
$out->start_tag ('input', name => 'e', |
| 596 |
value => scalar $cgi->get_parameter ('e')); |
value => $decode->(scalar $cgi->get_parameter ('e'))); |
| 597 |
$out->end_tag ('label'); |
$out->end_tag ('label'); |
| 598 |
} |
} |
| 599 |
|
|
| 617 |
$out->start_tag ('input', |
$out->start_tag ('input', |
| 618 |
name => 'uri', |
name => 'uri', |
| 619 |
type => 'url', |
type => 'url', |
| 620 |
value => $cgi->get_parameter ('uri')); |
value => $decode->(scalar $cgi->get_parameter ('uri'))); |
| 621 |
$out->end_tag ('label'); |
$out->end_tag ('label'); |
| 622 |
|
|
| 623 |
$out->start_tag ('p'); |
$out->start_tag ('p'); |
| 630 |
$out->end_tag ('form'); |
$out->end_tag ('form'); |
| 631 |
$out->end_section; |
$out->end_section; |
| 632 |
|
|
|
$out->end_tag ('fieldset'); |
|
|
|
|
| 633 |
## TODO: File upload |
## TODO: File upload |
| 634 |
|
|
| 635 |
$out->start_section (id => 'input-text', title => 'By direct input', |
$out->start_section (id => 'input-text', title => 'By direct input', |
| 646 |
$out->start_tag ('br'); |
$out->start_tag ('br'); |
| 647 |
$out->start_tag ('textarea', |
$out->start_tag ('textarea', |
| 648 |
name => 's'); |
name => 's'); |
| 649 |
my $s = $cgi->get_parameter ('s'); |
my $s = $decode->($cgi->get_parameter ('s')); |
| 650 |
$out->html ($htescape_value->($s)) if defined $s; |
$out->html ($htescape_value->($s)) if defined $s; |
| 651 |
$out->end_tag ('textarea'); |
$out->end_tag ('textarea'); |
| 652 |
$out->end_tag ('label'); |
$out->end_tag ('label'); |