3 ################################################################
6 ### $VER: 2.1 (8bit,quoted-printable,perlish)$
7 ### USAGE: $codec=&Codec::new('perlish');
8 ### $encoded=$codec->encode($clear);
9 ### $clear=$codec->decode($encoded);
20 return undef unless (defined $encode{$type});
22 $$res{'encode'}=$encode{$type};
23 $$res{'decode'}=$decode{$type};
36 return &{$$obj{'encode'}}($str);
41 return &{$$obj{'decode'}}($str);
49 ################################################################
52 $crlf=pack("CC",13,10);
54 ################################################################
57 $encode{'8bit'}=sub { return $_[0]; };
58 $decode{'8bit'}=sub { return $_[0]; };
60 ################################################################
72 $str=~s/([\x80-\xFF])/sprintf("\\x%02x",ord($1))/eg;
73 $str=~s/([\x00-\x20])/sprintf("\\x%02x",ord($1))/eg;
79 my($type,$key,$value,@res,$entry);
83 if ((!defined $type)||($type eq "")) {
84 return "\042"."e_perlish($item)."\042";
87 if ($type eq "HASH") {
88 while (($key,$value)=each %$item) {
89 $entry="\042"."e_perlish($key)."\042";
91 $entry.=&convert_perlish($value);
94 return "{".join(",",@res)."}";
96 if ($type eq "ARRAY") {
97 foreach $value (@$item) {
98 push(@res,&convert_perlish($value));
100 return "[".join(",",@res)."]";
102 if ($type eq "SCALAR") {
103 return "\042"."e_perlish($item)."\042";
109 $encode{'perlish'}=\&convert_perlish;
111 $decode{'perlish'}=sub {
118 ################################################################
121 $encode{'quoted-printable'}=sub {
127 $str=~s/([\x00-\x1F\x80-\xFF])/sprintf("=%02X",ord($1))/eg;
129 if (length($str)>75) {
130 while (length($str)>75) {
131 if (substr($str,73,1) eq "=") {
132 push(@lines,substr($str,0,73)."="); ### soft break
133 $str=substr($str,73);
135 elsif (substr($str,74,1) eq "=") {
136 push(@lines,substr($str,0,74)."="); ### soft break
137 $str=substr($str,74);
140 push(@lines,substr($str,0,75)."="); ### soft break
141 $str=substr($str,75);
145 $str=join($HTTP::crlf,@lines);
151 $decode{'quoted-printable'}=sub {
152 $_[0]=~s/=([0-9a-fA-F][0-9a-fA-F])/pack("C", hex($1))/eg;