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