Convert/YText.pm

   1 package Convert::YText;
   2
   3 use strict;
   4 use warnings;
   5 use vars qw/$VERSION @ISA @EXPORT_OK/;
   6 @ISA = 'Exporter';
   7 @EXPORT_OK = qw( encode_ytext decode_ytext );
   8
   9 use encoding "utf-8";
  10
  11
  12 $VERSION=0.1;
  13
  14 =head1 NAME
  15
  16 Convert::YText - Quotes strings suitably for rfc2822 local part
  17
  18 =head1 VERSION
  19
  20 Version 0.1 B<BETA>
  21
  22 =head1 SYNOPSIS
  23
  24 use Convert::YText qw(encode_ytext decode_ytext);
  25
  26 $encoded=encode_ytext($string);
  27 $decoded=decode_ytext($encoded);
  28
  29 ($decoded eq $string) || die "this should never happen!";
  30
  31
  32 =head1 DESCRIPTION
  33
  34 Convert::YText converts strings to and from "YText", a format inspired
  35 by xtext defined in RFC1894, the MIME base64 and quoted-printable
  36 types (RFC 1394).  The main goal is encode a UTF8 string into something safe
  37 for use as the local part in an internet email address  (RFC2822).
  38
  39 According to RFC 2822, the following non-alphanumerics are OK for the
  40 local part of an address: "!#$%&'*+-/=?^_`{|}~". On the other hand, it
  41 seems common in practice to block addresses having "%!/|`#&?" in the
  42 local part.  The idea is to restrict ourselves to basic ASCII
  43 alphanumerics, plus a small set of printable ASCII, namely "=_+-~.".
  44 Spaces are replaced with "+", "/" with "~", the characters
  45 "A-Za-z0-9_.-" encode as themselves, and everything else is written
  46 "=USTR=" where USTR is the base64 (using "A-Za-z0-9_." as digits)
  47 encoding of the unicode character code.
  48
  49 The characters '+' and '-' are pretty widely used to attach suffixes
  50 (although usually only one works on a given mail host). It seems ok to
  51 use '+-', since the first marks the beginning of a suffix, and then is
  52 a regular character. The character '.' also seems mostly permissable.
  53
  54
  55 =head1 METHODS
  56
  57 =cut
  58
  59 our $digit_string="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_.";
  60
  61 our $must_base64=qr{[^a-zA-Z0-9\.\-\/_ ]};
  62 our $digit_rex=qr{[$digit_string]+};
  63 our $valid_rex=qr{[A-Za-z0-9.\=\_\~\-]+};
  64
  65 our @digits=split "",$digit_string;
  66
  67 sub encode_num($){
  68     my $num=shift;
  69     my $str="";
  70
  71     while ($num>0){
  72         my $remainder=$num % 64;
  73         $num=$num >> 6;
  74
  75         $str = $digits[$remainder].$str;
  76     }
  77
  78     return $str;
  79 }
  80 sub decode_str($){
  81     my $str=shift;
  82     my @chars=split "",$str;
  83     my $num=0;
  84
  85     while (scalar(@chars)>0){
  86         my $remainder=index $digit_string,$chars[0];
  87
  88         # convert this to carp or something
  89         die if ($remainder <0);
  90
  91         $num=$num << 6;
  92         $num+=$remainder;
  93         shift @chars;
  94     }
  95
  96     return chr($num);
  97 }
  98 sub encode_ytext($){
  99     my $str=shift;
 100
 101     # "=" we use as an escape, and '+' for space
 102     $str=~ s/($must_base64)/"=".encode_num(ord($1))."="/ge;
 103
 104     $str=~ s|/|~|g;
 105     $str=~ s/ /+/g;
 106
 107     return $str;
 108 };
 109
 110 sub decode_ytext($){
 111     my $str = shift;
 112
 113     $str=~ s/\+/ /g;
 114     $str=~ s|~|/|g;
 115     $str=~ s/=($digit_rex)+=/ decode_str($1)/eg;
 116     return $str;
 117 }
 118
 119 =head1 TODO
 120
 121 Finish doc. Write tests.
 122
 123 =head1 AUTHOR
 124
 125 David Bremner, E<lt>bremner@unb.caE<gt>
 126
 127 =head1 COPYRIGHT
 128
 129 Copyright (C) 2008 David Bremner.  All Rights Reserved.
 130
 131 This module is free software; you can redistribute it and/or modify it
 132 under the same terms as Perl itself.
 133
 134 =head1 CAVEAT
 135
 136 This module is currently in B<BETA> condition.  It should not be used
 137 in a production environment, and is released with no warranty of any
 138 kind whatsoever.
 139
 140 Corrections, suggestions, bugreports and tests are welcome!
 141
 142 =head1 SEE ALSO
 143
 144 L<MIME::Base64>, L<MIME::Decoder::Base64>, L<MIME::Decoder::QuotedPrint>.
 145
 146 =cut
 147
 148 1;