Warning: Undefined variable $auth in /home/pevo0181/public_html/pia-soft.com/cleania/routes/index.php on line 542
Warning: Trying to access array offset on value of type null in /home/pevo0181/public_html/pia-soft.com/cleania/routes/index.php on line 542
#
# $Id: UTF7.pm,v 2.10 2017/06/10 17:23:50 dankogai Exp $
#
package Encode::Unicode::UTF7;
use strict;
use warnings;
use parent qw(Encode::Encoding);
__PACKAGE__->Define('UTF-7');
our $VERSION = do { my @r = ( q$Revision: 2.10 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r };
use MIME::Base64;
use Encode qw(find_encoding);
#
# Algorithms taken from Unicode::String by Gisle Aas
#
our $OPTIONAL_DIRECT_CHARS = 1;
my $specials = quotemeta "\'(),-./:?";
$OPTIONAL_DIRECT_CHARS
and $specials .= quotemeta "!\"#$%&*;<=>@[]^_`{|}";
# \s will not work because it matches U+3000 DEOGRAPHIC SPACE
# We use qr/[\n\r\t\ ] instead
my $re_asis = qr/(?:[\n\r\t\ A-Za-z0-9$specials])/;
my $re_encoded = qr/(?:[^\n\r\t\ A-Za-z0-9$specials])/;
my $e_utf16 = find_encoding("UTF-16BE");
sub needs_lines { 1 }
sub encode($$;$) {
my ( $obj, $str, $chk ) = @_;
return undef unless defined $str;
my $len = length($str);
pos($str) = 0;
my $bytes = substr($str, 0, 0); # to propagate taintedness
while ( pos($str) < $len ) {
if ( $str =~ /\G($re_asis+)/ogc ) {
my $octets = $1;
utf8::downgrade($octets);
$bytes .= $octets;
}
elsif ( $str =~ /\G($re_encoded+)/ogsc ) {
if ( $1 eq "+" ) {
$bytes .= "+-";
}
else {
my $s = $1;
my $base64 = encode_base64( $e_utf16->encode($s), '' );
$base64 =~ s/=+$//;
$bytes .= "+$base64-";
}
}
else {
die "This should not happen! (pos=" . pos($str) . ")";
}
}
$_[1] = '' if $chk;
return $bytes;
}
sub decode($$;$) {
use re 'taint';
my ( $obj, $bytes, $chk ) = @_;
return undef unless defined $bytes;
my $len = length($bytes);
my $str = substr($bytes, 0, 0); # to propagate taintedness;
pos($bytes) = 0;
no warnings 'uninitialized';
while ( pos($bytes) < $len ) {
if ( $bytes =~ /\G([^+]+)/ogc ) {
$str .= $1;
}
elsif ( $bytes =~ /\G\+-/ogc ) {
$str .= "+";
}
elsif ( $bytes =~ /\G\+([A-Za-z0-9+\/]+)-?/ogsc ) {
my $base64 = $1;
my $pad = length($base64) % 4;
$base64 .= "=" x ( 4 - $pad ) if $pad;
$str .= $e_utf16->decode( decode_base64($base64) );
}
elsif ( $bytes =~ /\G\+/ogc ) {
$^W and warn "Bad UTF7 data escape";
$str .= "+";
}
else {
die "This should not happen " . pos($bytes);
}
}
$_[1] = '' if $chk;
return $str;
}
1;
__END__
=head1 NAME
Encode::Unicode::UTF7 -- UTF-7 encoding
=head1 SYNOPSIS
use Encode qw/encode decode/;
$utf7 = encode("UTF-7", $utf8);
$utf8 = decode("UTF-7", $ucs2);
=head1 ABSTRACT
This module implements UTF-7 encoding documented in RFC 2152. UTF-7,
as its name suggests, is a 7-bit re-encoded version of UTF-16BE. It
is designed to be MTA-safe and expected to be a standard way to
exchange Unicoded mails via mails. But with the advent of UTF-8 and
8-bit compliant MTAs, UTF-7 is hardly ever used.
UTF-7 was not supported by Encode until version 1.95 because of that.
But Unicode::String, a module by Gisle Aas which adds Unicode supports
to non-utf8-savvy perl did support UTF-7, the UTF-7 support was added
so Encode can supersede Unicode::String 100%.
=head1 In Practice
When you want to encode Unicode for mails and web pages, however, do
not use UTF-7 unless you are sure your recipie