Message/CGI/Util.pm

package Message::CGI::Util;
use strict;

use Exporter;
push our @ISA, 'Exporter';

our @EXPORT_OK = qw/
  htescape
  percent_encode percent_encode_na
  percent_decode
  get_absolute_url
/;

require Encode;

sub htescape ($) {
  my $s = shift;
  $s =~ s/&/&amp;/g;
  $s =~ s/</&lt;/g;
  $s =~ s/"/&quot;/g;
  return $s;
} # htescape

sub percent_encode ($) {
  my $s = Encode::encode ('utf8', $_[0]);
  $s =~ s/([^A-Za-z0-9_~-])/sprintf '%%%02X', ord $1/ges;
  return $s;
} # percent_encode

sub percent_encode_na ($) {
  my $s = Encode::encode ('utf8', $_[0]);
  $s =~ s/([^\x00-\x7F])/sprintf '%%%02X', ord $1/ges;
  return $s;
} # percent_encode_na

sub percent_decode ($) { # input should be a byte string.
  my $s = shift;
  $s =~ s/%([0-9A-Fa-f]{2})/pack 'C', hex $1/ge;
  return Encode::decode ('utf-8', $s); # non-UTF-8 octet converted to \xHH
} # percent_decode

sub get_absolute_url ($$) {
  require Message::DOM::DOMImplementation;
  return Message::DOM::DOMImplementation->create_uri_reference ($_[0])
      ->get_absolute_reference ($_[1])
      ->get_uri_reference 
      ->uri_reference;
} # get_absolute_url

1;
1	package Message::CGI::Util;
2	use strict;
3
4	use Exporter;
5	push our @ISA, 'Exporter';
6
7	our @EXPORT_OK = qw/
8	htescape
9	percent_encode percent_encode_na
10	percent_decode
11	get_absolute_url
12	/;
13
14	require Encode;
15
16	sub htescape ($) {
17	my $s = shift;
18	$s =~ s/&/&/g;
19	$s =~ s/</</g;
20	$s =~ s/"/"/g;
21	return $s;
22	} # htescape
23
24	sub percent_encode ($) {
25	my $s = Encode::encode ('utf8', $_[0]);
26	$s =~ s/([^A-Za-z0-9_~-])/sprintf '%%%02X', ord $1/ges;
27	return $s;
28	} # percent_encode
29
30	sub percent_encode_na ($) {
31	my $s = Encode::encode ('utf8', $_[0]);
32	$s =~ s/([^\x00-\x7F])/sprintf '%%%02X', ord $1/ges;
33	return $s;
34	} # percent_encode_na
35
36	sub percent_decode ($) { # input should be a byte string.
37	my $s = shift;
38	$s =~ s/%([0-9A-Fa-f]{2})/pack 'C', hex $1/ge;
39	return Encode::decode ('utf-8', $s); # non-UTF-8 octet converted to \xHH
40	} # percent_decode
41
42	sub get_absolute_url ($$) {
43	require Message::DOM::DOMImplementation;
44	return Message::DOM::DOMImplementation->create_uri_reference ($_[0])
45	->get_absolute_reference ($_[1])
46	->get_uri_reference
47	->uri_reference;
48	} # get_absolute_url
49
50	1;