html-webhacc/WebHACC/Input.pm

package WebHACC::Input;
use strict;

sub new ($) {
  return bless {id_prefix => ''}, shift;
} # new

sub id_prefix ($;$) {
  if (@_ > 1) {
    if (defined $_[1]) {
      $_[0]->{id_prefix} = ''.$_[1];
    } else {
      $_[0]->{id_prefix} = '';
    }
  }

  return $_[0]->{id_prefix};
} # id_prefix

sub nested ($;$) {
  if (@_ > 1) {
    if ($_[1]) {
      $_[0]->{nested} = 1;
    } else {
      delete $_[0]->{nested};
    }
  }

  return $_[0]->{nested};
} # nested

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

package WebHACC::Input::Error;
push our @ISA, 'WebHACC::Input';

sub generate_transfer_sections ($$) {
  my $self = shift;

  $self->SUPER::generate_transfer_sections (@_);
  
  my $result = shift;
  my $out = $result->output;

  $out->start_section (id => 'transfer-errors', title => 'Transfer Errors');

  $out->start_tag ('dl');
  $result->add_error (layer => 'transfer',
                      level => 'u',
                      type => 'resource retrieval error',
                      url => $self->{request_uri},
                      text => $self->{error_status_text});
  $out->end_tag ('dl');

  $out->end_section;
} # generate_transfer_sections

1;
1	wakaba	1.1	package WebHACC::Input;
2			use strict;
3
4			sub new ($) {
5			return bless {id_prefix => ''}, shift;
6			} # new
7
8			sub id_prefix ($;$) {
9			if (@_ > 1) {
10			if (defined $_[1]) {
11			$_[0]->{id_prefix} = ''.$_[1];
12			} else {
13			$_[0]->{id_prefix} = '';
14			}
15			}
16
17			return $_[0]->{id_prefix};
18			} # id_prefix
19
20			sub nested ($;$) {
21			if (@_ > 1) {
22			if ($_[1]) {
23			$_[0]->{nested} = 1;
24			} else {
25			delete $_[0]->{nested};
26			}
27			}
28
29			return $_[0]->{nested};
30			} # nested
31
32	wakaba	1.2	sub generate_transfer_sections ($$) {
33			my $self = shift;
34			my $result = shift;
35
36			$self->generate_http_header_section ($result);
37			} # generate_transfer_sections
38
39			sub generate_http_header_section ($$) {
40			my ($self, $result) = @_;
41
42			return unless defined $self->{header_status_code} or
43			defined $self->{header_status_text} or
44			@{$self->{header_field} or []};
45
46			my $out = $result->output;
47
48			$out->start_section (id => 'source-header', title => 'HTTP Header');
49			$out->html (qq[<p><strong>Note</strong>: Due to the limitation of the
50			network library in use, the content of this section might
51			not be the real header.</p>
52
53			<table><tbody>
54			]);
55
56			if (defined $self->{header_status_code}) {
57			$out->html (qq[<tr><th scope="row">Status code</th>]);
58			$out->start_tag ('td');
59			$out->code ($self->{header_status_code});
60			}
61			if (defined $self->{header_status_text}) {
62			$out->html (qq[<tr><th scope="row">Status text</th>]);
63			$out->start_tag ('td');
64			$out->code ($self->{header_status_text});
65			}
66
67			for (@{$self->{header_field}}) {
68			$out->start_tag ('tr');
69			$out->start_tag ('th', scope => 'row');
70			$out->code ($_->[0]);
71			$out->start_tag ('td');
72			$out->code ($_->[1]);
73			}
74
75			$out->end_tag ('table');
76
77			$out->end_section;
78			} # generate_http_header_section
79
80			package WebHACC::Input::Error;
81			push our @ISA, 'WebHACC::Input';
82
83			sub generate_transfer_sections ($$) {
84			my $self = shift;
85
86			$self->SUPER::generate_transfer_sections (@_);
87
88			my $result = shift;
89			my $out = $result->output;
90
91			$out->start_section (id => 'transfer-errors', title => 'Transfer Errors');
92
93			$out->start_tag ('dl');
94			$result->add_error (layer => 'transfer',
95			level => 'u',
96			type => 'resource retrieval error',
97			url => $self->{request_uri},
98			text => $self->{error_status_text});
99			$out->end_tag ('dl');
100
101			$out->end_section;
102			} # generate_transfer_sections
103
104	wakaba	1.1	1;