--- test/html-webhacc/WebHACC/Output.pm 2008/07/20 16:53:10 1.2 +++ test/html-webhacc/WebHACC/Output.pm 2008/09/10 10:22:59 1.23 @@ -1,6 +1,8 @@ package WebHACC::Output; use strict; + require IO::Handle; +use Scalar::Util qw/refaddr/; my $htescape = sub ($) { my $s = $_[0]; @@ -14,8 +16,19 @@ return $s; }; +my $htescape_value = sub ($) { + my $s = $_[0]; + $s =~ s/&/&/g; + $s =~ s/</g; + $s =~ s/>/>/g; + $s =~ s/"/"/g; + return $s; +}; + sub new ($) { - return bless {nav => []}, shift; + require WebHACC::Input; + return bless {nav => [], section_rank => 1, + input => WebHACC::Input->new}, shift; } # new sub input ($;$) { @@ -23,7 +36,7 @@ if (defined $_[1]) { $_[0]->{input} = $_[1]; } else { - delete $_[0]->{input}; + $_[0]->{input} = WebHACC::Input->new; } } @@ -42,6 +55,18 @@ return $_[0]->{handle}; } # handle +sub has_error ($;$) { + if (@_ > 1) { + if (defined $_[1]) { + $_[0]->{has_error} = 1; + } else { + delete $_[0]->{has_error}; + } + } + + return $_[0]->{has_error}; +} # has_error + sub set_utf8 ($) { binmode shift->{handle}, ':utf8'; } # set_utf8 @@ -71,40 +96,180 @@ sub start_tag ($$%) { my ($self, $tag_name, %opt) = @_; - $self->html ('<' . $htescape->($tag_name)); # escape for safety + $self->html ('<' . $htescape_value->($tag_name)); # escape for safety if (exists $opt{id}) { my $id = $self->input->id_prefix . $opt{id}; - $self->html (' id="' . $htescape->($id) . '"'); + $self->html (' id="' . $htescape_value->($id) . '"'); delete $opt{id}; } for (keys %opt) { # for safety - $self->html (' ' . $htescape->($_) . '="' . $htescape->($opt{$_}) . '"'); + $self->html (' ' . $htescape_value->($_) . '="' . + $htescape_value->($opt{$_}) . '"'); } $self->html ('>'); } # start_tag sub end_tag ($$) { - shift->html ('' . $htescape->(shift) . '>'); + shift->html ('' . $htescape_value->(shift) . '>'); } # end_tag sub start_section ($%) { my ($self, %opt) = @_; - $self->html ('
');
} # start_code_block
@@ -113,10 +278,55 @@
shift->html ('');
} # end_code_block
-sub code ($$) {
- shift->html ('' . $htescape->(shift) . '');
+sub code ($$;%) {
+ my ($self, $content, %opt) = @_;
+ $self->start_tag ('code', %opt);
+ $self->text ($content);
+ $self->html ('');
} # code
+sub script ($$;%) {
+ my ($self, $content, %opt) = @_;
+ $self->start_tag ('script', %opt);
+ $self->html ($content);
+ $self->html ('');
+} # script
+
+sub dt ($$;%) {
+ my ($self, $content, %opt) = @_;
+ $self->start_tag ('dt', %opt);
+ $self->nl_text ($content, text => $opt{text});
+} # dt
+
+sub select ($$%) {
+ my ($self, $options, %opt) = @_;
+
+ my $selected = $opt{selected};
+ delete $opt{selected};
+
+ $self->start_tag ('select', %opt);
+
+ my @options = @$options;
+ while (@options) {
+ my $opt = shift @options;
+ if ($opt->{options}) {
+ $self->html ('