home *** CD-ROM | disk | FTP | other *** search
/ CLIX - Fazer Clix Custa Nix / CLIX-CD.cdr / mac / lib / MIME / Base64.pm next >
Text File  |  1997-11-18  |  4KB  |  154 lines
  1. #
  2. # $Id: Base64.pm,v 1.1 1997/11/18 00:33:22 neeri Exp $
  3.  
  4. package MIME::Base64;
  5.  
  6. =head1 NAME
  7.  
  8. encode_base64 - Encode string using base64 encoding
  9.  
  10. decode_base64 - Decode base64 string
  11.  
  12. =head1 SYNOPSIS
  13.  
  14.  use MIME::Base64;
  15.  
  16.  $encoded = encode_base64('Aladdin:open sesame');
  17.  $decoded = decode_base64($encoded);
  18.  
  19. =head1 DESCRIPTION
  20.  
  21. This module provides functions to encode and decode strings into the
  22. Base64 encoding specified in RFC 2045 - I<MIME (Multipurpose Internet
  23. Mail Extensions)>. The Base64 encoding is designed to represent
  24. arbitrary sequences of octets in a form that need not be humanly
  25. readable. A 65-character subset ([A-Za-z0-9+/=]) of US-ASCII is used,
  26. enabling 6 bits to be represented per printable character.
  27.  
  28. The following functions are provided:
  29.  
  30. =over 4
  31.  
  32. =item encode_base64($str, [$eol])
  33.  
  34. Encode data by calling the encode_base64() function.  The first
  35. argument is the string to encode.  The second argument is the line
  36. ending sequence to use (it is optional and defaults to C<"\n">).  The
  37. returned encoded string is broken into lines of no more than 76
  38. characters each and it will end with $eol unless it is empty.  Pass an
  39. empty string as second argument if you do not want the encoded string
  40. broken into lines.
  41.  
  42. =item decode_base64($str)
  43.  
  44. Decode a base64 string by calling the decode_base64() function.  This
  45. function takes a single argument which is the string to decode and
  46. returns the decoded data.  Any character not part of the legal base64
  47. chars is ignored.
  48.  
  49. =back
  50.  
  51. If you prefer not to import these routines into your namespace you can
  52. call them as:
  53.  
  54.     use MIME::Base64 ();
  55.     $encoded = MIME::Base64::encode($decoded);
  56.     $decoded = MIME::Base64::decode($encoded);
  57.  
  58.  
  59. =head1 COPYRIGHT
  60.  
  61. Copyright 1995-1997 Gisle Aas.
  62.  
  63. This library is free software; you can redistribute it and/or
  64. modify it under the same terms as Perl itself.
  65.  
  66. Distantly based on LWP::Base64 written by Martijn Koster
  67. <m.koster@nexor.co.uk> and Joerg Reichelt <j.reichelt@nexor.co.uk> and
  68. code posted to comp.lang.perl <3pd2lp$6gf@wsinti07.win.tue.nl> by Hans
  69. Mulder <hansm@wsinti07.win.tue.nl>
  70.  
  71. The XS implementation use code from metamail.  Copyright 1991 Bell
  72. Communications Research, Inc. (Bellcore)
  73.  
  74. =cut
  75.  
  76. use strict;
  77. use vars qw(@ISA @EXPORT $VERSION $OLD_CODE);
  78.  
  79. require Exporter;
  80. require DynaLoader;
  81. @ISA = qw(Exporter DynaLoader);
  82. @EXPORT = qw(encode_base64 decode_base64);
  83.  
  84. $VERSION = '2.03';
  85.  
  86. eval { bootstrap MIME::Base64 $VERSION; };
  87. if ($@) {
  88.     # can't bootstrap XS implementation, use perl implementation
  89.     *encode_base64 = \&old_encode_base64;
  90.     *decode_base64 = \&old_decode_base64;
  91.  
  92.     $OLD_CODE = $@;
  93.     #warn $@ if $^W;
  94. }
  95.  
  96. # Historically this module has been implemented as pure perl code.
  97. # The XS implementation runs about 20 times faster, but the perl
  98. # code might be more portable, so it is still supported.
  99.  
  100. use integer;
  101.  
  102. sub old_encode_base64 ($;$)
  103. {
  104.     my $res = "";
  105.     my $eol = $_[1];
  106.     $eol = "\n" unless defined $eol;
  107.     pos($_[0]) = 0;                          # ensure start at the beginning
  108.     while ($_[0] =~ /(.{1,45})/gs) {
  109.     $res .= substr(pack('u', $1), 1);
  110.     chop($res);
  111.     }
  112.     $res =~ tr|` -_|AA-Za-z0-9+/|;               # `# help emacs
  113.     # fix padding at the end
  114.     my $padding = (3 - length($_[0]) % 3) % 3;
  115.     $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
  116.     # break encoded string into lines of no more than 76 characters each
  117.     if (length $eol) {
  118.     $res =~ s/(.{1,76})/$1$eol/g;
  119.     }
  120.     $res;
  121. }
  122.  
  123.  
  124. sub old_decode_base64 ($)
  125. {
  126.     local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]
  127.  
  128.     my $str = shift;
  129.     my $res = "";
  130.  
  131.     $str =~ tr|A-Za-z0-9+=/||cd;            # remove non-base64 chars
  132.     if (length($str) % 4) {
  133.     require Carp;
  134.     Carp::croak("Base64 decoder requires string length to be a multiple of 4")
  135.     }
  136.     $str =~ s/=+$//;                        # remove padding
  137.     $str =~ tr|A-Za-z0-9+/| -_|;            # convert to uuencoded format
  138.     while ($str =~ /(.{1,60})/gs) {
  139.     my $len = chr(32 + length($1)*3/4); # compute length byte
  140.     $res .= unpack("u", $len . $1 );    # uudecode
  141.     }
  142.     $res;
  143. }
  144.  
  145. # Set up aliases so that these functions also can be called as
  146. #
  147. #    MIME::Base64::encode();
  148. #    MIME::Base64::decode();
  149.  
  150. *encode = \&encode_base64;
  151. *decode = \&decode_base64;
  152.  
  153. 1;
  154.