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 |
datetime_in_content |
13 |
/; |
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 |
|
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 |
|
58 |
1; |