/[suikacvs]/test/html-webhacc/WebHACC/Output.pm
Suika

Diff of /test/html-webhacc/WebHACC/Output.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7 by wakaba, Mon Jul 21 12:56:34 2008 UTC revision 1.9 by wakaba, Sun Jul 27 10:33:46 2008 UTC
# Line 17  my $htescape = sub ($) { Line 17  my $htescape = sub ($) {
17  };  };
18    
19  sub new ($) {  sub new ($) {
20    return bless {nav => [], section_rank => 1}, shift;    require WebHACC::Input;
21      return bless {nav => [], section_rank => 1,
22                    input => WebHACC::Input->new}, shift;
23  } # new  } # new
24    
25  sub input ($;$) {  sub input ($;$) {
# Line 25  sub input ($;$) { Line 27  sub input ($;$) {
27      if (defined $_[1]) {      if (defined $_[1]) {
28        $_[0]->{input} = $_[1];        $_[0]->{input} = $_[1];
29      } else {      } else {
30        delete $_[0]->{input};        $_[0]->{input} = WebHACC::Input->new;
31      }      }
32    }    }
33        
# Line 187  sub add_source_to_parse_error_list ($$) Line 189  sub add_source_to_parse_error_list ($$)
189    my $self = shift;    my $self = shift;
190    
191    $self->script (q[addSourceToParseErrorList ('] . $self->input->id_prefix .    $self->script (q[addSourceToParseErrorList ('] . $self->input->id_prefix .
192                   q[', '] . shift . q[')]);                   q[', '] . shift () . q[')]);
193  } # add_source_to_parse_error_list  } # add_source_to_parse_error_list
194    
195  sub start_code_block ($) {  sub start_code_block ($) {
# Line 218  sub dt ($$;%) { Line 220  sub dt ($$;%) {
220    $self->nl_text ($content, text => $opt{text});    $self->nl_text ($content, text => $opt{text});
221  } # dt  } # dt
222    
223    sub select ($$%) {
224      my ($self, $options, %opt) = @_;
225    
226      my $selected = $opt{selected};
227      delete $opt{selected};
228    
229      $self->start_tag ('select', %opt);
230      
231      my @options = @$options;
232      while (@options) {
233        my $opt = shift @options;
234        if ($opt->{options}) {
235          $self->html ('<optgroup label="');
236          $self->nl_text ($opt->{label});
237          $self->html ('">');
238          unshift @options, @{$opt->{options}}, {end_options => 1};
239        } elsif ($opt->{end_options}) {
240          $self->end_tag ('optgroup');
241        } else {
242          $self->start_tag ('option', value => $opt->{value},
243                            ((defined $selected and $opt->{value} eq $selected)
244                                 ? (selected => '') : ()));
245          $self->nl_text (defined $opt->{label} ? $opt->{label} : $opt->{value});
246        }
247      }
248    
249      $self->end_tag ('select');
250    } # select
251    
252  sub link ($$%) {  sub link ($$%) {
253    my ($self, $content, %opt) = @_;    my ($self, $content, %opt) = @_;
254    $self->start_tag ('a', %opt, href => $opt{url});    $self->start_tag ('a', %opt, href => $opt{url});
# Line 367  sub html_header ($) { Line 398  sub html_header ($) {
398    $self->nl_text (q[WebHACC:Title]);    $self->nl_text (q[WebHACC:Title]);
399    $self->html (q[</title>    $self->html (q[</title>
400  <link rel="stylesheet" href="../cc-style.css" type="text/css">  <link rel="stylesheet" href="../cc-style.css" type="text/css">
401    <script src="../cc-script.js"></script>
402  </head>  </head>
403  <body>  <body>
404  <h1>]);  <h1>]);
# Line 374  sub html_header ($) { Line 406  sub html_header ($) {
406    $self->html ('</h1>');    $self->html ('</h1>');
407  } # html_header  } # html_header
408    
409    sub generate_input_section ($$) {
410      my ($out, $cgi) = @_;
411    
412      my $options = sub ($) {
413        my $context = shift;
414    
415        $out->html (q[<div class=details><p class=legend onclick="nextSibling.style.display = nextSibling.style.display == 'none' ? 'block' : 'none'">]);
416        $out->nl_text (q[Options]);
417        $out->start_tag ('div');
418    
419        if ($context eq 'url') {
420          $out->start_tag ('p');
421          $out->start_tag ('label');
422          $out->start_tag ('input', type => 'checkbox', name => 'error-page',
423                           value => 1,
424                           ($cgi->get_parameter ('error-page')
425                                ? (checked => '') : ()));
426          $out->nl_text ('Check error page');
427          $out->end_tag ('label');
428        }
429    
430        $out->start_tag ('p');
431        $out->start_tag ('label');
432        $out->nl_text (q[Content type]);
433        $out->text (': ');
434        $out->select ([
435          {value => '', label => 'As specified'},
436          {value => 'application/atom+xml'},
437          {value => 'application/xhtml+xml'},
438          {value => 'application/xml'},
439          {value => 'text/html'},
440          {value => 'text/xml'},
441          {value => 'text/css'},
442          {value => 'text/cache-manifest'},
443          {value => 'text/x-webidl'},
444        ], name => 'i', selected => scalar $cgi->get_parameter ('i'));
445        $out->end_tag ('label');
446    
447        if ($context ne 'text') {
448          $out->start_tag ('p');
449          $out->start_tag ('label');
450          $out->nl_text (q[Charset]);
451          $out->text (q[: ]);
452          $out->select ([
453            {value => '', label => 'As specified'},
454            {label => 'Japanese charsets', options => [
455              {value => 'Windows-31J'},
456              {value => 'Shift_JIS'},
457              {value => 'EUC-JP'},
458              {value => 'ISO-2022-JP'},
459            ]},
460            {label => 'European charsets', options => [
461              {value => 'Windows-1252'},
462              {value => 'ISO-8859-1'},
463              {value => 'US-ASCII'},
464            ]},
465            {label => 'Asian charsets', options => [
466              {value => 'Windows-874'},
467              {value => 'ISO-8859-11'},
468              {value => 'TIS-620'},
469            ]},
470            {label => 'Unicode charsets', options => [
471              {value => 'UTF-8'},
472              {value => 'UTF-8n'},
473            ]},
474          ], name => 'charset',
475          selected => scalar $cgi->get_parameter ('charset'));
476          $out->end_tag ('label');
477        }
478    
479        if ($context eq 'text') {
480          $out->start_tag ('p');
481          $out->start_tag ('label');
482          $out->nl_text ('Setting innerHTML');
483          $out->text (': ');
484          $out->start_tag ('input', name => 'e',
485                           value => scalar $cgi->get_parameter ('e'));
486          $out->end_tag ('label');
487        }
488    
489        $out->html (q[</div></div>]);
490      }; # $options
491    
492      $out->start_section (id => 'input', title => 'Input');
493    
494      $out->start_section (id => 'input-url', title => 'By URL');
495      $out->start_tag ('form', action => './', 'accept-charset' => 'utf-8',
496                       method => 'get');
497      $out->start_tag ('input', type => 'hidden', name => '_charset_');
498    
499      $out->start_tag ('p');
500      $out->start_tag ('label');
501      $out->nl_text ('URL');
502      $out->text (': ');
503      $out->start_tag ('input',
504                       name => 'uri',
505                       type => 'url',
506                       value => $cgi->get_parameter ('uri'));
507      $out->end_tag ('label');
508    
509      $options->('url');
510    
511      $out->start_tag ('p');
512      $out->start_tag ('button', type => 'submit');
513      $out->nl_text ('Check');
514    
515      $out->end_tag ('form');
516      $out->end_section;
517    
518      $out->end_tag ('fieldset');
519    
520      ## TODO: File upload
521    
522      $out->start_section (id => 'input-text', title => 'By direct input');
523      $out->start_tag ('form', action => './', 'accept-charset' => 'utf-8',
524                       method => 'post');
525      $out->start_tag ('input', type => 'hidden', name => '_charset_');
526    
527      $out->start_tag ('p');
528      $out->start_tag ('label');
529      $out->nl_text ('Document source to check');
530      $out->text (': ');
531      $out->start_tag ('br');
532      $out->start_tag ('textarea',
533                       name => 's');
534      my $s = $cgi->get_parameter ('s');
535      $out->text ($s) if defined $s;
536      $out->end_tag ('textarea');
537      $out->end_tag ('label');
538    
539      $options->('text');
540    
541      $out->start_tag ('p');
542      $out->start_tag ('button', type => 'submit',
543                       onclick => 'form.method = form.s.value.length > 512 ? "post" : "get"');
544      $out->nl_text ('Check');
545      $out->end_tag ('button');
546    
547      $out->end_tag ('form');
548      $out->end_section;
549    
550      $out->end_section;
551    } # generate_input_section
552    
553  sub encode_url_component ($$) {  sub encode_url_component ($$) {
554    shift;    shift;
555    require Encode;    require Encode;
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.9
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24