1############################################################################# 2## Name: Base64.pm 3## Purpose: XML::Smart::Base64 4## Author: Graciliano M. P. 5## Modified by: 6## Created: 25/5/2003 7## RCS-ID: 8## Copyright: (c) 2003 Graciliano M. P. 9## Licence: This program is free software; you can redistribute it and/or 10## modify it under the same terms as Perl itself 11 12 13############################################################################# 14 15 16## 17## Modified by Harish to fix bugs in xml creation and to errors more readable. 18## Tue Nov 1 21:18:43 IST 2011 19 20 21############################################################################ 22 23 24package XML::Smart::Base64 ; 25 26use strict ; 27use warnings ; 28 29use Carp ; 30 31use XML::Smart::Shared qw( _unset_sig_warn _reset_sig_warn ) ; 32 33our $VERSION = '1.3' ; 34 35 36my ($BASE64_PM) ; 37eval("use MIME::Base64 ()") ; 38if ( defined &MIME::Base64::encode_base64 ) { $BASE64_PM = 1 ;} 39 40 41 42 43################# 44# ENCODE_BASE64 # 45################# 46 47sub encode_base64 { 48 49 my $value = $_[0] ; 50 51 if( $BASE64_PM ) { 52 53 eval { 54 _unset_sig_warn() ; 55 my $encoded = MIME::Base64::encode_base64( $value ) ; 56 my $decoded = MIME::Base64::decode_base64( $encoded) ; 57 _reset_sig_warn() ; 58 59 my $tmp_decoded = $decoded ; 60 $tmp_decoded =~ s/\n//g ; 61 62 my $tmp_value = $value ; 63 $tmp_value =~ s/\n//g ; 64 65 return $encoded if( $tmp_decoded eq $tmp_value ) ; 66 }; 67 68 } 69 70 { 71 my $encoded ; 72 my $decoded ; 73 my $tmp_value ; 74 my $tmp_decoded ; 75 eval { 76 _unset_sig_warn() ; 77 $encoded = _encode_base64_pure_perl( $value ) ; 78 $decoded = _decode_base64_pure_perl( $encoded ) ; 79 _reset_sig_warn() ; 80 81 $tmp_decoded = $decoded ; 82 $tmp_decoded =~ s/\n//g ; 83 84 $tmp_value = $value ; 85 $tmp_value =~ s/\n//g ; 86 } ; unless( $@ ) { 87 return $encoded if( $tmp_decoded eq $tmp_value ) ; 88 } 89 } 90 91 { 92 _unset_sig_warn() ; 93 my $encoded = _encode_ord_special( $value ) ; 94 my $decoded = _decode_ord_special( $encoded ) ; 95 _reset_sig_warn() ; 96 97 my $tmp_decoded = $decoded ; 98 $tmp_decoded =~ s/\n//g ; 99 100 my $tmp_value = $value ; 101 $tmp_value =~ s/\n//g ; 102 103 return $encoded if( $tmp_decoded eq $tmp_value ) ; 104 } 105 106 107 108 croak( "Error Encoding\n" ) ; 109 110} 111 112############################ 113# _ENCODE_BASE64_PURE_PERL # 114############################ 115 116sub _encode_base64_pure_perl { 117 my $res = ""; 118 my $eol = $_[1]; 119 $eol = "\n" unless defined $eol; 120 pos($_[0]) = 0; # ensure start at the beginning 121 while ($_[0] =~ /(.{1,45})/gs) { 122 my $text = $1 ; 123 $res .= substr( pack('u', $text ), 1 ) ; 124 chop($res); 125 } 126 $res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs 127 # fix padding at the end 128 my $padding = (3 - length($_[0]) % 3) % 3; 129 $res =~ s/.{$padding}$/'=' x $padding/e if $padding; 130 # break encoded string into lines of no more than 76 characters each 131 if (length $eol) { 132 $res =~ s/(.{1,76})/$1$eol/g; 133 } 134 $res; 135} 136 137 138 139############################ 140# _ENCODE_ORD_SPECIAL # 141############################ 142 143 144sub _encode_ord_special { 145 146 my $value = shift ; 147 148 my @chars = split( //, $value ) ; 149 my @ords ; 150 foreach my $char ( @chars ) { 151 push @ords, ord( $char ) ; 152 } 153 154 return join( "|", @ords ) ; 155 156} 157 158 159############################ 160# _DECODE_ORD_SPECIAL # 161############################ 162 163 164sub _decode_ord_special { 165 166 my $value = shift ; 167 my @ords = split( /\|/, $value ) ; 168 my @chars ; 169 foreach my $ord ( @ords ) { 170 push @chars, chr( $ord ) ; 171 } 172 173 return join( "", @chars ) ; 174 175} 176 177################# 178# DECODE_BASE64 # 179################# 180 181sub decode_base64 { 182 183 my $value = $_[0] ; 184 185 if( $BASE64_PM ) { 186 187 eval { 188 _unset_sig_warn() ; 189 my $decoded = MIME::Base64::decode_base64( $value ) ; 190 my $encoded = MIME::Base64::encode_base64( $decoded ) ; 191 _reset_sig_warn() ; 192 193 my $tmp_value = $value ; 194 $tmp_value =~ s/\n//g ; 195 196 my $tmp_encoded = $encoded ; 197 $tmp_encoded =~ s/\n//g ; 198 199 return $decoded if( $tmp_encoded eq $tmp_value ) ; 200 }; 201 202 } 203 204 { 205 206 my $decoded ; 207 my $encoded ; 208 my $tmp_value ; 209 my $tmp_encoded ; 210 eval { 211 $decoded = _decode_base64_pure_perl( $value ) ; 212 $encoded = _encode_base64_pure_perl( $decoded ) ; 213 214 $tmp_value = $value ; 215 $tmp_value =~ s/\n//g ; 216 217 $tmp_encoded = $encoded ; 218 $tmp_encoded =~ s/\n//g ; 219 } ; unless( $@ ) { 220 return $decoded if( $tmp_encoded eq $tmp_value ) ; 221 } 222 223 } 224 225 { 226 227 my $decoded = _decode_ord_special( $value ) ; 228 my $encoded = _encode_ord_special( $decoded ) ; 229 230 my $tmp_value = $value ; 231 $tmp_value =~ s/\n//g ; 232 233 my $tmp_encoded = $encoded ; 234 $tmp_encoded =~ s/\n//g ; 235 236 return $decoded if( $tmp_encoded eq $tmp_value ) ; 237 238 } 239 240 croak "Error Decoding $value\n" ; 241 242} 243 244 245############################ 246# _DECODE_BASE64_PURE_PERL # 247############################ 248 249sub _decode_base64_pure_perl { 250 local($^W) = 0 ; 251 my $str = shift ; 252 my $res = ""; 253 254 $str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars 255 if (length($str) % 4) { 256 #require Carp; 257 #Carp::carp("Length of base64 data not a multiple of 4") 258 } 259 $str =~ s/=+$//; # remove padding 260 $str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format 261 while ($str =~ /(.{1,60})/gs) { 262 my $len = chr(32 + length($1)*3/4); # compute length byte 263 $res .= unpack("u", $len . $1 ); # uudecode 264 } 265 $res; 266} 267 268####### 269# END # 270####### 271 2721; 273 274