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	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	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	1;