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
  datetime_in_content
/;

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

## Returns the specified time in the "date or time strings in content" format.
sub datetime_in_content ($) {
  my @time = gmtime shift;
  return sprintf '%04d-%02d-%02d %02d:%02d:%02d+00:00',
      $time[5] + 1900, $time[4] + 1, $time[3], $time[2], $time[1], $time[0];
} # datetime_in_content

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	wakaba	1.2	datetime_in_content
13	wakaba	1.1	/;
14
15			require Encode;
16
17			sub htescape ($) {
18			my $s = shift;
19			$s =~ s/&/&/g;
20			$s =~ s/</</g;
21			$s =~ s/"/"/g;
22			return $s;
23			} # htescape
24
25			sub percent_encode ($) {
26			my $s = Encode::encode ('utf8', $_[0]);
27			$s =~ s/([^A-Za-z0-9_~-])/sprintf '%%%02X', ord $1/ges;
28			return $s;
29			} # percent_encode
30
31			sub percent_encode_na ($) {
32			my $s = Encode::encode ('utf8', $_[0]);
33			$s =~ s/([^\x00-\x7F])/sprintf '%%%02X', ord $1/ges;
34			return $s;
35			} # percent_encode_na
36
37			sub percent_decode ($) { # input should be a byte string.
38			my $s = shift;
39			$s =~ s/%([0-9A-Fa-f]{2})/pack 'C', hex $1/ge;
40			return Encode::decode ('utf-8', $s); # non-UTF-8 octet converted to \xHH
41			} # percent_decode
42
43			sub get_absolute_url ($$) {
44			require Message::DOM::DOMImplementation;
45			return Message::DOM::DOMImplementation->create_uri_reference ($_[0])
46			->get_absolute_reference ($_[1])
47			->get_uri_reference
48			->uri_reference;
49			} # get_absolute_url
50	wakaba	1.2
51			## Returns the specified time in the "date or time strings in content" format.
52			sub datetime_in_content ($) {
53			my @time = gmtime shift;
54			return sprintf '%04d-%02d-%02d %02d:%02d:%02d+00:00',
55			$time[5] + 1900, $time[4] + 1, $time[3], $time[2], $time[1], $time[0];
56			} # datetime_in_content
57	wakaba	1.1
58			1;