home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Base64.pm < prev    next >
Encoding:
Perl POD Document  |  2000-11-04  |  3.2 KB  |  135 lines
  1. package MIME::Decoder::Base64;
  2.  
  3.  
  4. =head1 NAME
  5.  
  6. MIME::Decoder::Base64 - encode/decode a "base64" stream
  7.  
  8.  
  9. =head1 SYNOPSIS
  10.  
  11. A generic decoder object; see L<MIME::Decoder> for usage.
  12.  
  13.  
  14. =head1 DESCRIPTION
  15.  
  16. A L<MIME::Decoder> subclass for the C<"base64"> encoding.
  17. The name was chosen to jibe with the pre-existing MIME::Base64
  18. utility package, which this class actually uses to translate each chunk.
  19.  
  20. =over 4
  21.  
  22. =item *
  23.  
  24. When B<decoding>, the input is read one line at a time.
  25. The input accumulates in an internal buffer, which is decoded in
  26. multiple-of-4-sized chunks (plus a possible "leftover" input chunk,
  27. of course).
  28.  
  29. =item *
  30.  
  31. When B<encoding>, the input is read 45 bytes at a time: this ensures
  32. that the output lines are not too long.   We chose 45 since it is
  33. a multiple of 3 and produces lines under 76 characters, as RFC-1521 
  34. specifies.
  35.  
  36. =back
  37.  
  38.  
  39. =head1 AUTHOR
  40.  
  41. Eryq (F<eryq@zeegee.com>), ZeeGee Software Inc (F<http://www.zeegee.com>).
  42.  
  43. All rights reserved.  This program is free software; you can redistribute 
  44. it and/or modify it under the same terms as Perl itself.
  45.  
  46.  
  47. =head1 VERSION
  48.  
  49. $Revision: 5.403 $ $Date: 2000/11/04 19:54:48 $
  50.  
  51. =cut
  52.  
  53. use vars qw(@ISA $VERSION);
  54. use MIME::Decoder;
  55. use MIME::Base64 2.04;    
  56. use MIME::Tools qw(debug);
  57.  
  58. @ISA = qw(MIME::Decoder);
  59.  
  60. ### The package version, both in 1.23 style *and* usable by MakeMaker:
  61. $VERSION = substr q$Revision: 5.403 $, 10;
  62.  
  63. ### How many bytes to encode at a time (must be a multiple of 3, and
  64. ### less than (76 * 0.75)!
  65. my $EncodeChunkLength = 45;
  66.  
  67. ### How many bytes to decode at a time?
  68. my $DecodeChunkLength = 32 * 1024;
  69.  
  70. #------------------------------
  71. #
  72. # decode_it IN, OUT
  73. #
  74. sub decode_it {
  75.     my ($self, $in, $out) = @_;
  76.     my $len_4xN;
  77.     
  78.     ### Create a suitable buffer:
  79.     my $buffer = ' ' x (120 + $DecodeChunkLength); $buffer = '';
  80.     debug "in = $in; out = $out";
  81.  
  82.     ### Get chunks until done:
  83.     local($_) = ' ' x $DecodeChunkLength;    
  84.     while ($in->read($_, $DecodeChunkLength)) {
  85.     tr{A-Za-z0-9+/}{}cd;         ### get rid of non-base64 chars
  86.  
  87.     ### Concat any new input onto any leftover from the last round:
  88.     $buffer .= $_;
  89.     length($buffer) >= $DecodeChunkLength or next;
  90.     
  91.         ### Extract substring with highest multiple of 4 bytes:
  92.     ###   0 means not enough to work with... get more data!
  93.     $len_4xN = length($buffer) & ~3; 
  94.  
  95.     ### Partition into largest-multiple-of-4 (which we decode),
  96.     ### and the remainder (which gets handled next time around):
  97.     $out->print(decode_base64(substr($buffer, 0, $len_4xN)));
  98.     $buffer = substr($buffer, $len_4xN);
  99.     }
  100.     
  101.     ### No more input remains.  Dispose of anything left in buffer:
  102.     if (length($buffer)) {
  103.  
  104.     ### Pad to 4-byte multiple, and decode:
  105.     $buffer .= "===";            ### need no more than 3 pad chars
  106.     $len_4xN = length($buffer) & ~3;     
  107.  
  108.     ### Decode it!
  109.     $out->print(decode_base64(substr($buffer, 0, $len_4xN)));
  110.     }
  111.     1;
  112. }
  113.  
  114. #------------------------------
  115. #
  116. # encode_it IN, OUT
  117. #
  118. sub encode_it {
  119.     my ($self, $in, $out) = @_;
  120.     my $encoded;
  121.  
  122.     my $nread;
  123.     my $buf = '';
  124.     while ($nread = $in->read($buf, $EncodeChunkLength)) {
  125.     $encoded = encode_base64($buf);
  126.     $encoded .= "\n" unless ($encoded =~ /\n\Z/);   ### ensure newline!
  127.     $out->print($encoded);
  128.     }
  129.     1;
  130. }
  131.  
  132. #------------------------------
  133. 1;
  134.  
  135.