html-webhacc/WebHACC/Output.pm

package WebHACC::Output;
use strict;

require IO::Handle;
use Scalar::Util qw/refaddr/;

my $htescape = sub ($) {
  my $s = $_[0];
  $s =~ s/&/&amp;/g;
  $s =~ s/</&lt;/g;
  $s =~ s/>/&gt;/g;
  $s =~ s/"/&quot;/g;
  $s =~ s{([\x00-\x09\x0B-\x1F\x7F-\xA0\x{FEFF}\x{FFFC}-\x{FFFF}])}{
    sprintf '<var>U+%04X</var>', ord $1;
  }ge;
  return $s;
};

sub new ($) {
  return bless {nav => [], section_rank => 1}, shift;
} # new

sub input ($;$) {
  if (@_ > 1) {
    if (defined $_[1]) {
      $_[0]->{input} = $_[1];
    } else {
      delete $_[0]->{input};
    }
  }
  
  return $_[0]->{input};
} # input

sub handle ($;$) {
  if (@_ > 1) {
    if (defined $_[1]) {
      $_[0]->{handle} = $_[1];
    } else {
      delete $_[0]->{handle};
    }
  }
  
  return $_[0]->{handle};
} # handle

sub set_utf8 ($) {
  binmode shift->{handle}, ':utf8';
} # set_utf8

sub set_flush ($) {
  shift->{handle}->autoflush (1);
} # set_flush

sub unset_flush ($) {
  shift->{handle}->autoflush (0);
} # unset_flush

sub html ($$) {
  shift->{handle}->print (shift);
} # html

sub text ($$) {
  shift->html ($htescape->(shift));
} # text

sub url ($$%) {
  my ($self, $url, %opt) = @_;
  $self->html (q[<code class=uri>&lt;]);
  $self->link ($url, %opt, url => $url);
  $self->html (q[></code>]);
} # url

sub start_tag ($$%) {
  my ($self, $tag_name, %opt) = @_;
  $self->html ('<' . $htescape->($tag_name)); # escape for safety
  if (exists $opt{id}) {
    my $id = $self->input->id_prefix . $opt{id};
    $self->html (' id="' . $htescape->($id) . '"');
    delete $opt{id};
  }
  for (keys %opt) {    # for safety
    $self->html (' ' . $htescape->($_) . '="' . $htescape->($opt{$_}) . '"');
  }
  $self->html ('>');
} # start_tag

sub end_tag ($$) {
  shift->html ('</' . $htescape->(shift) . '>');
} # end_tag

sub start_section ($%) {
  my ($self, %opt) = @_;

  if (defined $opt{role}) {
    if ($opt{role} eq 'parse-errors') {
      $opt{id} ||= 'parse-errors';
      $opt{title} ||= 'Parse Errors Section';
      $opt{short_title} ||= 'Parse Errors';
      delete $opt{role};
    } elsif ($opt{role} eq 'structure-errors') {
      $opt{id} ||= 'document-errors';
      $opt{title} ||= 'Structural Errors';
      $opt{short_title} ||= 'Struct. Errors';
      delete $opt{role};
    } elsif ($opt{role} eq 'reformatted') {
      $opt{id} ||= 'document-tree';
      $opt{title} ||= 'Reformatted Document Source';
      $opt{short_title} ||= 'Reformatted';
      delete $opt{role}
    } elsif ($opt{role} eq 'tree') {
      $opt{id} ||= 'document-tree';
      $opt{title} ||= 'Document Tree';
      $opt{short_title} ||= 'Tree';
      delete $opt{role};
    } elsif ($opt{role} eq 'structure') {
      $opt{id} ||= 'document-structure';
      $opt{title} ||= 'Document Structure';
      $opt{short_title} ||= 'Structure';
      delete $opt{role};
    }
  }

  $self->{section_rank}++;
  $self->html ('<div class=section');
  if (defined $opt{id}) {
    my $id = $self->input->id_prefix . $opt{id};
    $self->html (' id="' . $htescape->($id) . '"');
    push @{$self->{nav}},
        [$id => $opt{short_title} || $opt{title} => $opt{text}] 
        if $self->{section_rank} == 2;
  }
  my $section_rank = $self->{section_rank};
  $section_rank = 6 if $section_rank > 6;
  $self->html ('><h' . $section_rank . '>');
  $self->nl_text ($opt{title}, text => $opt{text});
  $self->html ('</h' . $section_rank . '>');
} # start_section

sub end_section ($) {
  my $self = shift;
  $self->html ('</div>');
  $self->{handle}->flush;
  $self->{section_rank}--;
} # end_section

sub start_error_list ($%) {
  my ($self, %opt) = @_;

  if (defined $opt{role}) {
    if ($opt{role} eq 'parse-errors') {
      $opt{id} ||= 'parse-errors-list';
      delete $opt{role};
    } elsif ($opt{role} eq 'structure-errors') {
      $opt{id} ||= 'document-errors-list';
      delete $opt{role};
    }
  }

  $self->start_tag ('dl', %opt);
} # start_error_list

sub end_error_list ($%) {
  my ($self, %opt) = @_;

  if (defined $opt{role}) {
    if ($opt{role} eq 'parse-errors') {
      delete $opt{role};
      $self->end_tag ('dl');
      ## NOTE: For parse error list, the |add_source_to_parse_error_list|
      ## method is invoked at the end of |generate_source_string_section|,
      ## since that generation method is invoked after the error list
      ## is generated.
    } elsif ($opt{role} eq 'structure-errors') {
      delete $opt{role};
      $self->end_tag ('dl');
      $self->add_source_to_parse_error_list ('document-errors-list');
    } else {
      $self->end_tag ('dl');
    }
  } else {
    $self->end_tag ('dl');
  }
} # end_error_list

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

  $self->script (q[addSourceToParseErrorList ('] . $self->input->id_prefix .
                 q[', '] . shift . q[')]);
} # add_source_to_parse_error_list

sub start_code_block ($) {
  shift->html ('<pre><code>');
} # start_code_block

sub end_code_block ($) {
  shift->html ('</code></pre>');
} # end_code_block

sub code ($$;%) {
  my ($self, $content, %opt) = @_;
  $self->start_tag ('code', %opt);
  $self->text ($content);
  $self->html ('</code>');
} # code

sub script ($$;%) {
  my ($self, $content, %opt) = @_;
  $self->start_tag ('script', %opt);
  $self->html ($content);
  $self->html ('</script>');
} # script

sub dt ($$;%) {
  my ($self, $content, %opt) = @_;
  $self->start_tag ('dt', %opt);
  $self->nl_text ($content, text => $opt{text});
} # dt

sub link ($$%) {
  my ($self, $content, %opt) = @_;
  $self->start_tag ('a', %opt, href => $opt{url});
  $self->text ($content);
  $self->html ('</a>');
} # link

sub xref ($$%) {
  my ($self, $content, %opt) = @_;
  $self->html ('<a href="#' . $htescape->($self->input->id_prefix . $opt{target}) . '">');
  $self->nl_text ($content, text => $opt{text});
  $self->html ('</a>');
} # xref

sub link_to_webhacc ($$%) {
  my ($self, $content, %opt) = @_;
  $opt{url} = './?uri=' . $self->encode_url_component ($opt{url});
  $self->link ($content, %opt);
} # link_to_webhacc

my $get_node_path = sub ($) {
  my $node = shift;
  my @r;
  while (defined $node) {
    my $rs;
    if ($node->node_type == 1) {
      $rs = $node->node_name;
      $node = $node->parent_node;
    } elsif ($node->node_type == 2) {
      $rs = '@' . $node->node_name;
      $node = $node->owner_element;
    } elsif ($node->node_type == 3) {
      $rs = '"' . $node->data . '"';
      $node = $node->parent_node;
    } elsif ($node->node_type == 9) {
      @r = ('') unless @r;
      $rs = '';
      $node = $node->parent_node;
    } else {
      $rs = '#' . $node->node_type;
      $node = $node->parent_node;
    }
    unshift @r, $rs;
  }
  return join '/', @r;
}; # $get_node_path

sub node_link ($$) {
  my ($self, $node) = @_;
  $self->xref ($get_node_path->($node), target => 'node-' . refaddr $node);
} # node_link

{
  my $Msg = {};

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

  my $lang = shift; # MUST be a canonical lang name
  my $file_name = qq[cc-msg.$lang.txt];
  $lang = 'en' unless -f $file_name;
  $self->{primary_language} = $lang;
  
  open my $file, '<:utf8', $file_name or die "$0: $file_name: $!";
  while (<$file>) {
    if (s/^([^;]+);([^;]*);//) {
      my ($type, $cls, $msg) = ($1, $2, $_);
      $msg =~ tr/\x0D\x0A//d;
      $Msg->{$type} = [$cls, $msg];
    }
  }
} # load_text_catalog

sub nl_text ($$;%) {
  my ($self, $type, %opt) = @_;
  my $node = $opt{node};

  my @arg;
  {
    if (defined $Msg->{$type}) {
      my $msg = $Msg->{$type}->[1];
      if ($msg =~ /<var>/) {
        $msg =~ s{<var>\$([0-9]+)</var>}{
          defined $arg[$1] ? $htescape->($arg[$1]) : '(undef)';
        }ge;
        $msg =~ s{<var>{\@([A-Za-z0-9:_.-]+)}</var>}{
          UNIVERSAL::can ($node, 'get_attribute_ns')
              ? $htescape->($node->get_attribute_ns (undef, $1)) : ''
        }ge;
        $msg =~ s{<var>{\@}</var>}{
          UNIVERSAL::can ($node, 'value') ? $htescape->($node->value) : ''
        }ge;
        $msg =~ s{<var>{text}</var>}{
          defined $opt{text} ? $htescape->($opt{text}) : ''
        }ge;
        $msg =~ s{<var>{local-name}</var>}{
          UNIVERSAL::can ($node, 'manakai_local_name')
            ? $htescape->($node->manakai_local_name) : ''
        }ge;
        $msg =~ s{<var>{element-local-name}</var>}{
          (UNIVERSAL::can ($node, 'owner_element') and
           $node->owner_element)
            ? $htescape->($node->owner_element->manakai_local_name) : ''
        }ge;
      }
      $self->html ($msg);
      return;
    } elsif ($type =~ s/:([^:]*)$//) {
      unshift @arg, $1;
      redo;
    }
  }
  $self->text ($type);
} # nl_text

}

sub nav_list ($) {
  my $self = shift;
  $self->html (q[<ul class="navigation" id="nav-items">]);
  for (@{$self->{nav}}) {
    $self->html (qq[<li><a href="#@{[$htescape->($_->[0])]}">]);
    $self->nl_text ($_->[1], text => $_->[2]);
    $self->html ('</a>');
  }
  $self->html ('</ul>');
} # nav_list

sub http_header ($) {
  shift->html (qq[Content-Type: text/html; charset=utf-8\n\n]);
} # http_header

sub http_error ($$) {
  my $self = shift;
  my $code = 0+shift;
  my $text = {
    404 => 'Not Found',
  }->{$code};
  $self->html (qq[Status: $code $text\nContent-Type: text/html ; charset=us-ascii\n\n$code $text]);
} # http_error

sub html_header ($) {
  my $self = shift;
  $self->html (q[<!DOCTYPE html>]);
  $self->start_tag ('html', lang => $self->{primary_language});
  $self->html (q[<head><title>]);
  $self->nl_text (q[WebHACC:Title]);
  $self->html (q[</title>
<link rel="stylesheet" href="../cc-style.css" type="text/css">
</head>
<body>
<h1>]);
  $self->nl_text (q[WebHACC:Heading]);
  $self->html ('</h1>');
} # html_header

sub encode_url_component ($$) {
  shift;
  require Encode;
  my $s = Encode::encode ('utf8', shift);
  $s =~ s/([^0-9A-Za-z_.~-])/sprintf '%%%02X', ord $1/ge;
  return $s;
} # encode_url_component

1;
1	package WebHACC::Output;
2	use strict;
3
4	require IO::Handle;
5	use Scalar::Util qw/refaddr/;
6
7	my $htescape = sub ($) {
8	my $s = $_[0];
9	$s =~ s/&/&/g;
10	$s =~ s/</</g;
11	$s =~ s/>/>/g;
12	$s =~ s/"/"/g;
13	$s =~ s{([\x00-\x09\x0B-\x1F\x7F-\xA0\x{FEFF}\x{FFFC}-\x{FFFF}])}{
14	sprintf '<var>U+%04X</var>', ord $1;
15	}ge;
16	return $s;
17	};
18
19	sub new ($) {
20	return bless {nav => [], section_rank => 1}, shift;
21	} # new
22
23	sub input ($;$) {
24	if (@_ > 1) {
25	if (defined $_[1]) {
26	$_[0]->{input} = $_[1];
27	} else {
28	delete $_[0]->{input};
29	}
30	}
31
32	return $_[0]->{input};
33	} # input
34
35	sub handle ($;$) {
36	if (@_ > 1) {
37	if (defined $_[1]) {
38	$_[0]->{handle} = $_[1];
39	} else {
40	delete $_[0]->{handle};
41	}
42	}
43
44	return $_[0]->{handle};
45	} # handle
46
47	sub set_utf8 ($) {
48	binmode shift->{handle}, ':utf8';
49	} # set_utf8
50
51	sub set_flush ($) {
52	shift->{handle}->autoflush (1);
53	} # set_flush
54
55	sub unset_flush ($) {
56	shift->{handle}->autoflush (0);
57	} # unset_flush
58
59	sub html ($$) {
60	shift->{handle}->print (shift);
61	} # html
62
63	sub text ($$) {
64	shift->html ($htescape->(shift));
65	} # text
66
67	sub url ($$%) {
68	my ($self, $url, %opt) = @_;
69	$self->html (q[<code class=uri><]);
70	$self->link ($url, %opt, url => $url);
71	$self->html (q[></code>]);
72	} # url
73
74	sub start_tag ($$%) {
75	my ($self, $tag_name, %opt) = @_;
76	$self->html ('<' . $htescape->($tag_name)); # escape for safety
77	if (exists $opt{id}) {
78	my $id = $self->input->id_prefix . $opt{id};
79	$self->html (' id="' . $htescape->($id) . '"');
80	delete $opt{id};
81	}
82	for (keys %opt) { # for safety
83	$self->html (' ' . $htescape->($_) . '="' . $htescape->($opt{$_}) . '"');
84	}
85	$self->html ('>');
86	} # start_tag
87
88	sub end_tag ($$) {
89	shift->html ('</' . $htescape->(shift) . '>');
90	} # end_tag
91
92	sub start_section ($%) {
93	my ($self, %opt) = @_;
94
95	if (defined $opt{role}) {
96	if ($opt{role} eq 'parse-errors') {
97	$opt{id} \|\|= 'parse-errors';
98	$opt{title} \|\|= 'Parse Errors Section';
99	$opt{short_title} \|\|= 'Parse Errors';
100	delete $opt{role};
101	} elsif ($opt{role} eq 'structure-errors') {
102	$opt{id} \|\|= 'document-errors';
103	$opt{title} \|\|= 'Structural Errors';
104	$opt{short_title} \|\|= 'Struct. Errors';
105	delete $opt{role};
106	} elsif ($opt{role} eq 'reformatted') {
107	$opt{id} \|\|= 'document-tree';
108	$opt{title} \|\|= 'Reformatted Document Source';
109	$opt{short_title} \|\|= 'Reformatted';
110	delete $opt{role}
111	} elsif ($opt{role} eq 'tree') {
112	$opt{id} \|\|= 'document-tree';
113	$opt{title} \|\|= 'Document Tree';
114	$opt{short_title} \|\|= 'Tree';
115	delete $opt{role};
116	} elsif ($opt{role} eq 'structure') {
117	$opt{id} \|\|= 'document-structure';
118	$opt{title} \|\|= 'Document Structure';
119	$opt{short_title} \|\|= 'Structure';
120	delete $opt{role};
121	}
122	}
123
124	$self->{section_rank}++;
125	$self->html ('<div class=section');
126	if (defined $opt{id}) {
127	my $id = $self->input->id_prefix . $opt{id};
128	$self->html (' id="' . $htescape->($id) . '"');
129	push @{$self->{nav}},
130	[$id => $opt{short_title} \|\| $opt{title} => $opt{text}]
131	if $self->{section_rank} == 2;
132	}
133	my $section_rank = $self->{section_rank};
134	$section_rank = 6 if $section_rank > 6;
135	$self->html ('><h' . $section_rank . '>');
136	$self->nl_text ($opt{title}, text => $opt{text});
137	$self->html ('</h' . $section_rank . '>');
138	} # start_section
139
140	sub end_section ($) {
141	my $self = shift;
142	$self->html ('</div>');
143	$self->{handle}->flush;
144	$self->{section_rank}--;
145	} # end_section
146
147	sub start_error_list ($%) {
148	my ($self, %opt) = @_;
149
150	if (defined $opt{role}) {
151	if ($opt{role} eq 'parse-errors') {
152	$opt{id} \|\|= 'parse-errors-list';
153	delete $opt{role};
154	} elsif ($opt{role} eq 'structure-errors') {
155	$opt{id} \|\|= 'document-errors-list';
156	delete $opt{role};
157	}
158	}
159
160	$self->start_tag ('dl', %opt);
161	} # start_error_list
162
163	sub end_error_list ($%) {
164	my ($self, %opt) = @_;
165
166	if (defined $opt{role}) {
167	if ($opt{role} eq 'parse-errors') {
168	delete $opt{role};
169	$self->end_tag ('dl');
170	## NOTE: For parse error list, the \|add_source_to_parse_error_list\|
171	## method is invoked at the end of \|generate_source_string_section\|,
172	## since that generation method is invoked after the error list
173	## is generated.
174	} elsif ($opt{role} eq 'structure-errors') {
175	delete $opt{role};
176	$self->end_tag ('dl');
177	$self->add_source_to_parse_error_list ('document-errors-list');
178	} else {
179	$self->end_tag ('dl');
180	}
181	} else {
182	$self->end_tag ('dl');
183	}
184	} # end_error_list
185
186	sub add_source_to_parse_error_list ($$) {
187	my $self = shift;
188
189	$self->script (q[addSourceToParseErrorList ('] . $self->input->id_prefix .
190	q[', '] . shift . q[')]);
191	} # add_source_to_parse_error_list
192
193	sub start_code_block ($) {
194	shift->html ('<pre><code>');
195	} # start_code_block
196
197	sub end_code_block ($) {
198	shift->html ('</code></pre>');
199	} # end_code_block
200
201	sub code ($$;%) {
202	my ($self, $content, %opt) = @_;
203	$self->start_tag ('code', %opt);
204	$self->text ($content);
205	$self->html ('</code>');
206	} # code
207
208	sub script ($$;%) {
209	my ($self, $content, %opt) = @_;
210	$self->start_tag ('script', %opt);
211	$self->html ($content);
212	$self->html ('</script>');
213	} # script
214
215	sub dt ($$;%) {
216	my ($self, $content, %opt) = @_;
217	$self->start_tag ('dt', %opt);
218	$self->nl_text ($content, text => $opt{text});
219	} # dt
220
221	sub link ($$%) {
222	my ($self, $content, %opt) = @_;
223	$self->start_tag ('a', %opt, href => $opt{url});
224	$self->text ($content);
225	$self->html ('</a>');
226	} # link
227
228	sub xref ($$%) {
229	my ($self, $content, %opt) = @_;
230	$self->html ('<a href="#' . $htescape->($self->input->id_prefix . $opt{target}) . '">');
231	$self->nl_text ($content, text => $opt{text});
232	$self->html ('</a>');
233	} # xref
234
235	sub link_to_webhacc ($$%) {
236	my ($self, $content, %opt) = @_;
237	$opt{url} = './?uri=' . $self->encode_url_component ($opt{url});
238	$self->link ($content, %opt);
239	} # link_to_webhacc
240
241	my $get_node_path = sub ($) {
242	my $node = shift;
243	my @r;
244	while (defined $node) {
245	my $rs;
246	if ($node->node_type == 1) {
247	$rs = $node->node_name;
248	$node = $node->parent_node;
249	} elsif ($node->node_type == 2) {
250	$rs = '@' . $node->node_name;
251	$node = $node->owner_element;
252	} elsif ($node->node_type == 3) {
253	$rs = '"' . $node->data . '"';
254	$node = $node->parent_node;
255	} elsif ($node->node_type == 9) {
256	@r = ('') unless @r;
257	$rs = '';
258	$node = $node->parent_node;
259	} else {
260	$rs = '#' . $node->node_type;
261	$node = $node->parent_node;
262	}
263	unshift @r, $rs;
264	}
265	return join '/', @r;
266	}; # $get_node_path
267
268	sub node_link ($$) {
269	my ($self, $node) = @_;
270	$self->xref ($get_node_path->($node), target => 'node-' . refaddr $node);
271	} # node_link
272
273	{
274	my $Msg = {};
275
276	sub load_text_catalog ($$) {
277	my $self = shift;
278
279	my $lang = shift; # MUST be a canonical lang name
280	my $file_name = qq[cc-msg.$lang.txt];
281	$lang = 'en' unless -f $file_name;
282	$self->{primary_language} = $lang;
283
284	open my $file, '<:utf8', $file_name or die "$0: $file_name: $!";
285	while (<$file>) {
286	if (s/^([^;]+);([^;]*);//) {
287	my ($type, $cls, $msg) = ($1, $2, $_);
288	$msg =~ tr/\x0D\x0A//d;
289	$Msg->{$type} = [$cls, $msg];
290	}
291	}
292	} # load_text_catalog
293
294	sub nl_text ($$;%) {
295	my ($self, $type, %opt) = @_;
296	my $node = $opt{node};
297
298	my @arg;
299	{
300	if (defined $Msg->{$type}) {
301	my $msg = $Msg->{$type}->[1];
302	if ($msg =~ /<var>/) {
303	$msg =~ s{<var>\$([0-9]+)</var>}{
304	defined $arg[$1] ? $htescape->($arg[$1]) : '(undef)';
305	}ge;
306	$msg =~ s{<var>{\@([A-Za-z0-9:_.-]+)}</var>}{
307	UNIVERSAL::can ($node, 'get_attribute_ns')
308	? $htescape->($node->get_attribute_ns (undef, $1)) : ''
309	}ge;
310	$msg =~ s{<var>{\@}</var>}{
311	UNIVERSAL::can ($node, 'value') ? $htescape->($node->value) : ''
312	}ge;
313	$msg =~ s{<var>{text}</var>}{
314	defined $opt{text} ? $htescape->($opt{text}) : ''
315	}ge;
316	$msg =~ s{<var>{local-name}</var>}{
317	UNIVERSAL::can ($node, 'manakai_local_name')
318	? $htescape->($node->manakai_local_name) : ''
319	}ge;
320	$msg =~ s{<var>{element-local-name}</var>}{
321	(UNIVERSAL::can ($node, 'owner_element') and
322	$node->owner_element)
323	? $htescape->($node->owner_element->manakai_local_name) : ''
324	}ge;
325	}
326	$self->html ($msg);
327	return;
328	} elsif ($type =~ s/:([^:]*)$//) {
329	unshift @arg, $1;
330	redo;
331	}
332	}
333	$self->text ($type);
334	} # nl_text
335
336	}
337
338	sub nav_list ($) {
339	my $self = shift;
340	$self->html (q[<ul class="navigation" id="nav-items">]);
341	for (@{$self->{nav}}) {
342	$self->html (qq[<li><a href="#@{[$htescape->($_->[0])]}">]);
343	$self->nl_text ($_->[1], text => $_->[2]);
344	$self->html ('</a>');
345	}
346	$self->html ('</ul>');
347	} # nav_list
348
349	sub http_header ($) {
350	shift->html (qq[Content-Type: text/html; charset=utf-8\n\n]);
351	} # http_header
352
353	sub http_error ($$) {
354	my $self = shift;
355	my $code = 0+shift;
356	my $text = {
357	404 => 'Not Found',
358	}->{$code};
359	$self->html (qq[Status: $code $text\nContent-Type: text/html ; charset=us-ascii\n\n$code $text]);
360	} # http_error
361
362	sub html_header ($) {
363	my $self = shift;
364	$self->html (q[<!DOCTYPE html>]);
365	$self->start_tag ('html', lang => $self->{primary_language});
366	$self->html (q[<head><title>]);
367	$self->nl_text (q[WebHACC:Title]);
368	$self->html (q[</title>
369	<link rel="stylesheet" href="../cc-style.css" type="text/css">
370	</head>
371	<body>
372	<h1>]);
373	$self->nl_text (q[WebHACC:Heading]);
374	$self->html ('</h1>');
375	} # html_header
376
377	sub encode_url_component ($$) {
378	shift;
379	require Encode;
380	my $s = Encode::encode ('utf8', shift);
381	$s =~ s/([^0-9A-Za-z_.~-])/sprintf '%%%02X', ord $1/ge;
382	return $s;
383	} # encode_url_component
384
385	1;