/[pdpsoft]/trunk/fetchcrl/base64.pm
ViewVC logotype

Diff of /trunk/fetchcrl/base64.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

fetchcrl/base64.pm revision 1758 by davidg, Fri Jun 11 15:39:04 2010 UTC trunk/fetchcrl/base64.pm revision 1768 by davidg, Fri Jun 11 19:45:08 2010 UTC
# Line 1  Line 1 
 #!/usr/bin/perl  
 # $Id: base64.pl,v 2.4 2004/05/17 04:18:13 ehood Exp $  
1  #  #
2  # Library based on Perl 4 code from:  # Library inspired by the Perl 4 code from base64.pl by A. P. Barrett
3  #       base64.pl -- A perl package to handle MIME-style BASE64 encoding  # <barrett@ee.und.ac.za>, October 1993, and subsequent changes by
4  #       A. P. Barrett <barrett@ee.und.ac.za>, October 1993  # Earl Hood <earl@earlhood.com> to use MIME::Base64 if available.
 #       Revision: 1.4 Date: 1994/08/11 16:08:51  
5  #  #
 # Subsequent changes made by Earl Hood, earl@earlhood.com.  
6    
7  package base64;  package base64;
8    
9  my $_have_MIME_Base64;  my $use_MIMEBase64 = eval { require MIME::Base64; };
 BEGIN {  
   eval { require MIME::Base64; };  
   $_have_MIME_Base64 = scalar($@) ? 0 : 1;  
 }  
   
 # Synopsis:  
 #       require 'base64.pl';  
 #  
 #       $uuencode_string = &base64::b64touu($base64_string);  
 #       $binary_string = &base64::b64decode($base64_string);  
 #       $base64_string = &base64::uutob64($uuencode_string);  
 #       $base64_string = &base64::b64encode($binary_string);  
 #       $uuencode_string = &base64::uuencode($binary_string);  
 #       $binary_string = &base64::uudecode($uuencode_string);  
 #  
 #       uuencode and base64 input strings may contain multiple lines,  
 #       but may not contain any headers or trailers.  (For uuencode,  
 #       remove the begin and end lines, and for base64, remove the MIME  
 #       headers and boundaries.)  
 #  
 #       uuencode and base64 output strings will be contain multiple  
 #       lines if appropriate, but will not contain any headers or  
 #       trailers.  (For uuencode, add the "begin" line and the  
 #       " \nend\n" afterwards, and for base64, add any MIME stuff  
 #       afterwards.)  
   
 ####################  
   
 my $base64_alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.  
                       'abcdefghijklmnopqrstuvwxyz'.  
                       '0123456789+/';  
 my $base64_pad = '=';  
   
 my $uuencode_alphabet = q|`!"#$%&'()*+,-./0123456789:;<=>?|.  
                         '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_';  
 my $uuencode_pad = '`';  
   
 # Build some strings for use in tr/// commands.  
 # Some uuencodes use " " and some use "`", so we handle both.  
 # We also need to protect backslashes and other special characters.  
 my $tr_uuencode =  " ".$uuencode_alphabet;  
    $tr_uuencode =~ s/(\W)/\\$1/g;  
 my $tr_base64   =  "A".$base64_alphabet;  
    $tr_base64   =~ s/(\W)/\\$1/g;  
   
 sub b64touu  
 {  
     local ($_) = shift;  
     my ($result);  
       
     # zap bad characters and translate others to uuencode alphabet  
     eval qq{  
         tr|$tr_base64||cd;  
         tr|$tr_base64|$tr_uuencode|;  
     };  
   
     # break into lines of 60 encoded chars, prepending "M" for uuencode  
     while (s/^(.{60})//) {  
         $result .= 'M' . $1 . "\n";  
     }  
   
     # any leftover chars go onto a shorter line  
     # with padding to the next multiple of 4 chars  
     if ($_ ne '') {  
         $result .= substr($uuencode_alphabet, length($_)*3/4, 1)  
                    . $_  
                    . ($uuencode_pad x ((60 - length($_)) % 4)) . "\n";  
     }  
   
     # return result  
     $result;  
 }  
10    
11  sub b64decode  sub b64decode
12  {  {
13      # call more efficient module if available (ehood, 2003-09-28)      return &MIME::Base64::decode_base64(@_) if $use_MIMEBase64;
     if ($_have_MIME_Base64) {  
         return &MIME::Base64::decode_base64;  
     }  
14    
15      # substr() usage added by ehood, 1996/04/16      local($^W) = 0;
16        use integer; # should be faster and more accurate
17    
18      my($str) = shift;      ( my $str = shift ) =~ tr|A-Za-z0-9+=/||cd;
19      my($result, $tmp, $offset, $len);      $str =~ s/=+$//;
20            $str =~ tr|A-Za-z0-9+/| -_|; # collapse base64 unto continuous set of chars
21      # zap bad characters and translate others to uuencode alphabet                                   # (by convention the uuencode set, for unpack)
22      eval qq{  
23          \$str =~ tr|$tr_base64||cd;      return "" unless $str;
24          \$str =~ tr|$tr_base64|$tr_uuencode|;      return unpack("u", join('', map( chr(32 + length($_)*3/4) . $_,
25      };                                  $str =~ /(.{1,60})/gs) ) );
   
     # break into lines of 60 encoded chars, prepending "M" for uuencode,  
     # and then using perl's builtin uudecoder to convert to binary.  
     $result     = '';                   # init return string  
     $offset     = 0;                    # init offset to 0  
     $len        = length($str);         # store length  
     while ($offset+60 <= $len) {                # loop until < 60 chars left  
         $tmp = substr($str, $offset, 60);       # grap 60 char block  
         $offset += 60;                          # increment offset  
         $result .= unpack('u', 'M' . $tmp);     # decode block  
     }  
     # also decode any leftover chars  
     if ($offset < $len) {  
         $tmp = substr($str, $offset, $len-$offset);  
         $result .= unpack('u',  
                     substr($uuencode_alphabet, length($tmp)*3/4, 1) . $tmp);  
     }  
   
     # return result  
     $result;  
 }  
   
 sub uutob64  
 {  
     # This is the most difficult, because some perverse uuencoder  
     # might have made lines that do not describe multiples of 3 bytes.  
     # I don't see any better method than uudecoding to binary and then  
     # b64encoding the binary.  
   
     &b64encode(&uudecode); # implicitly pass @_ to &uudecode  
26  }  }
27    
28  sub b64encode  sub b64encode
29  {  {
30      # call more efficient module if available (ehood, 2003-09-28)      return &MIME::Base64::encode_base64(@_) if $use_MIMEBase64;
     if ($_have_MIME_Base64) {  
         return &MIME::Base64::encode_base64;  
     }  
   
     local ($_) = shift;  
     my ($chunk);  
     my ($result);  
       
     # break into chunks of 45 input chars, use perl's builtin  
     # uuencoder to convert each chunk to uuencode format,  
     # then kill the leading "M", translate to the base64 alphabet,  
     # and finally append a newline.  
     while (s/^([\s\S]{45})//) {  
         $chunk = substr(pack('u', $1), $[+1, 60);  
         eval qq{  
             \$chunk =~ tr|$tr_uuencode|$tr_base64|;  
         };  
         $result .= $chunk . "\n";  
     }  
31    
     # any leftover chars go onto a shorter line  
     # with uuencode padding converted to base64 padding  
     if ($_ ne '') {  
         $chunk = substr(pack('u', $_), $[+1,  
                         int((length($_)+2)/3)*4 - (45-length($_))%3);  
         eval qq{  
             \$chunk =~ tr|$tr_uuencode|$tr_base64|;  
         };  
         $result .= $chunk . ($base64_pad x ((60 - length($chunk)) % 4)) . "\n";  
     }  
   
     # return result  
     $result;  
 }  
   
 sub uuencode  
 {  
32      local ($_) = shift;      local ($_) = shift;
33      my ($result);      local($^W) = 0;
34        use integer; # should be faster and more accurate
35            
36      # break into chunks of 45 input chars, and use perl's builtin      my $result = pack("u", $_[0]);
37      # uuencoder to convert each chunk to uuencode format.      $result =~ s/^.//mg;
38      # (newline is added by builtin uuencoder.)      $result =~ s/\n//g;
39      while (s/^([\s\S]{45})//) {  
40          $result .= pack('u', $1);      $result =~ tr| -_|A-Za-z0-9+/|;
41        my $padding = (3 - length($_[0]) % 3) % 3;
42    
43        $result =~ s/.{$padding}$/'=' x $padding/e if $padding;
44        if (length $eol) {
45            $result =~ s/(.{1,76})/$1$eol/g;
46      }      }
47        return $result;
     # any leftover chars go onto a shorter line  
     # with padding to the next multiple of 4 chars  
     if ($_ ne '') {  
         $result .= pack('u', $_);  
     }  
   
     # return result  
     $result;  
 }  
   
 sub uudecode  
 {  
     local ($_) = shift;  
     my $result = '';  
       
     # strip out begin/end lines         (ehood, 1996/03/21)  
     s/^\s*begin[^\n]+\n//;  
     s/\nend\s*$//;  
   
     # use perl's builtin uudecoder to convert each line  
     while (s/^([^\n]+\n?)//) {  
         last  if substr($1, 0, 1) eq '`';  
         $result .= unpack('u', $1);  
     }  
   
     # return result  
     $result;  
48  }  }
49    
50  1;  1;
Legend:
Removed from v.1758  
changed lines
  Added in v.1768
grid.support@nikhef.nl
 ViewVC Help
Powered by ViewVC 1.1.28