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

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

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

revision 1.6 by wakaba, Sat Jul 26 11:27:25 2008 UTC revision 1.10 by wakaba, Sat Aug 16 07:42:20 2008 UTC
# Line 178  sub generate_info_section ($$) { Line 178  sub generate_info_section ($$) {
178    $out->end_section;    $out->end_section;
179  } # generate_info_section  } # generate_info_section
180    
181  sub generate_transfer_sections ($$) {  sub generate_transfer_sections ($$) { }
   my $self = shift;  
   my $result = shift;  
     
   $self->generate_http_header_section ($result);  
 } # generate_transfer_sections  
   
 sub generate_http_header_section ($$) {  
   my ($self, $result) = @_;  
     
   return unless defined $self->{header_status_code} or  
       defined $self->{header_status_text} or  
       @{$self->{header_field} or []};  
   
   my $out = $result->output;  
     
   $out->start_section (id => 'source-header', title => 'HTTP Header');  
   $out->html (qq[<p><strong>Note</strong>: Due to the limitation of the  
 network library in use, the content of this section might  
 not be the real header.</p>  
   
 <table><tbody>  
 ]);  
   
   if (defined $self->{header_status_code}) {  
     $out->html (qq[<tr><th scope="row">Status code</th>]);  
     $out->start_tag ('td');  
     $out->code ($self->{header_status_code});  
   }  
   if (defined $self->{header_status_text}) {  
     $out->html (qq[<tr><th scope="row">Status text</th>]);  
     $out->start_tag ('td');  
     $out->code ($self->{header_status_text});  
   }  
     
   for (@{$self->{header_field}}) {  
     $out->start_tag ('tr');  
     $out->start_tag ('th', scope => 'row');  
     $out->code ($_->[0]);  
     $out->start_tag ('td');  
     $out->code ($_->[1]);  
   }  
   
   $out->end_tag ('table');  
   
   $out->end_section;  
 } # generate_http_header_section  
182    
183  package WebHACC::Input::HTTP;  package WebHACC::Input::HTTP;
184  push our @ISA, 'WebHACC::Input';  push our @ISA, 'WebHACC::Input';
# Line 266  sub _get_document ($$$$$) { Line 220  sub _get_document ($$$$$) {
220    
221    unless ($self->host_permit->check ($url_o->uri_host, $url_o->uri_port || 80)) {    unless ($self->host_permit->check ($url_o->uri_host, $url_o->uri_port || 80)) {
222      $self->{error_status_text} = 'Connection to the host is forbidden';      $self->{error_status_text} = 'Connection to the host is forbidden';
223        bless $self, 'WebHACC::Input::Error';
224      return $self;      return $self;
225    }    }
226    
# Line 320  sub _get_document ($$$$$) { Line 275  sub _get_document ($$$$$) {
275    return $self;    return $self;
276  } # _get_document  } # _get_document
277    
278    sub generate_transfer_sections ($$) {
279      my $self = shift;
280      my $result = shift;
281    
282      $result->layer_uncertain ('transfer');
283      
284      $self->generate_http_header_section ($result);
285    } # generate_transfer_sections
286    
287    sub generate_http_header_section ($$) {
288      my ($self, $result) = @_;
289      
290      return unless defined $self->{header_status_code} or
291          defined $self->{header_status_text} or
292          @{$self->{header_field} or []};
293    
294      my $out = $result->output;
295      
296      $out->start_section (id => 'source-header', title => 'HTTP Header');
297      $out->html (qq[<p><strong>Note</strong>: Due to the limitation of the
298    network library in use, the content of this section might
299    not be the real header.</p>
300    
301    <table><tbody>
302    ]);
303    
304      if (defined $self->{header_status_code}) {
305        $out->html (qq[<tr><th scope="row">Status code</th>]);
306        $out->start_tag ('td');
307        $out->code ($self->{header_status_code});
308      }
309      if (defined $self->{header_status_text}) {
310        $out->html (qq[<tr><th scope="row">Status text</th>]);
311        $out->start_tag ('td');
312        $out->code ($self->{header_status_text});
313      }
314      
315      for (@{$self->{header_field}}) {
316        $out->start_tag ('tr');
317        $out->start_tag ('th', scope => 'row');
318        $out->code ($_->[0]);
319        $out->start_tag ('td');
320        $out->code ($_->[1]);
321      }
322    
323      $out->end_tag ('table');
324    
325      $out->end_section;
326    } # generate_http_header_section
327    
328  package WebHACC::Input::Text;  package WebHACC::Input::Text;
329  push our @ISA, 'WebHACC::Input';  push our @ISA, 'WebHACC::Input';
330    
# Line 343  package WebHACC::Input::Subdocument; Line 348  package WebHACC::Input::Subdocument;
348  push our @ISA, 'WebHACC::Input';  push our @ISA, 'WebHACC::Input';
349    
350  sub new ($$) {  sub new ($$) {
351    my $self = bless {}, shift;    my $self = shift->SUPER::new;
352    $self->{subdocument_index} = shift;    $self->{subdocument_index} = shift;
353    return $self;    return $self;
354  } # new  } # new
355    
356  sub id_prefix ($) {  sub id_prefix ($) {
357    return 'subdoc-' . shift->full_subdocument_index . '-';    my $self = shift;
358      return $self->{parent_input}->id_prefix .
359          'subdoc-' . $self->{subdocument_index} . '-';
360  } # id_prefix  } # id_prefix
361    
362  sub nested ($) { 1 }  sub nested ($) { 1 }
# Line 374  sub start_section ($$) { Line 381  sub start_section ($$) {
381    my $result = shift;    my $result = shift;
382    my $out = $result->output;    my $out = $result->output;
383    
384    my $index = $self->full_subdocument_index;    my $index = $self->subdocument_index;
385    $out->start_section (id => $self->id_prefix,    $out->start_section (id => my $id = 'subdoc-' . $index . '-',
386                         title => qq[Subdocument #],                         title => qq[Subdocument #],
387                         short_title => 'Sub #',                         short_title => 'Sub #',
388                         text => $index);                         role => 'subdoc',
389                           text => $self->full_subdocument_index);
390      $out->script (q[ insertNavSections ('] . $out->input->id_prefix . $id . q[') ]);
391  } # start_section  } # start_section
392    
393  sub end_section ($$) {  sub end_section ($$) {
# Line 420  push our @ISA, 'WebHACC::Input'; Line 429  push our @ISA, 'WebHACC::Input';
429    
430  sub generate_transfer_sections ($$) {  sub generate_transfer_sections ($$) {
431    my $self = shift;    my $self = shift;
   
   $self->SUPER::generate_transfer_sections (@_);  
432        
433    my $result = shift;    my $result = shift;
434    my $out = $result->output;    my $out = $result->output;
435    
436    $out->start_section (id => 'transfer-errors', title => 'Transfer Errors');    $out->start_section (role => 'transfer-errors');
437      $out->start_error_list (role => 'transfer-errors');
438    
439    $out->start_tag ('dl');    $result->layer_applicable ('transfer');
440    $result->add_error (layer => 'transfer',    $result->add_error (layer => 'transfer',
441                        level => 'u',                        level => 'u',
442                        type => 'resource retrieval error',                        type => 'resource retrieval error',
443                        url => $self->{request_uri},                        url => $self->{request_uri},
444                        text => $self->{error_status_text});                        text => $self->{error_status_text});
   $out->end_tag ('dl');  
445    
446      $out->end_error_list (role => 'transfer-errors');
447    $out->end_section;    $out->end_section;
448  } # generate_transfer_sections  } # generate_transfer_sections
449    
450  package WebHACC::Input::HTTPError;  package WebHACC::Input::HTTPError;
451  push our @ISA, 'WebHACC::Input::Error', 'WebHACC::Input::HTTP';  push our @ISA, 'WebHACC::Input::Error', 'WebHACC::Input::HTTP';
452    
453    sub generate_transfer_sections ($$) {
454      my $self = shift;
455      
456      my $result = shift;
457    
458      $self->WebHACC::Input::Error::generate_transfer_sections ($result);
459      $self->WebHACC::Input::HTTP::generate_transfer_sections ($result);
460    
461    } # generate_transfer_sections
462    
463  package WebHACC::Input::UnsupportedURLSchemeError;  package WebHACC::Input::UnsupportedURLSchemeError;
464  push our @ISA, 'WebHACC::Input::Error';  push our @ISA, 'WebHACC::Input::Error';
465    
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.10
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24