home *** CD-ROM | disk | FTP | other *** search
/ CLIX - Fazer Clix Custa Nix / CLIX-CD.cdr / mac / lib / MIME / QuotedPrint.pm < prev   
Text File  |  1997-11-18  |  3KB  |  101 lines
  1. #
  2. # $Id: QuotedPrint.pm,v 1.1 1997/11/18 00:33:23 neeri Exp $
  3.  
  4. package MIME::QuotedPrint;
  5.  
  6. =head1 NAME
  7.  
  8. encode_qp - Encode string using quoted-printable encoding
  9.  
  10. decode_qp - Decode quoted-printable string
  11.  
  12. =head1 SYNOPSIS
  13.  
  14.  use MIME::QuotedPrint;
  15.  
  16.  $encoded = encode_qp($decoded);
  17.  $decoded = decode_qp($encoded);
  18.  
  19. =head1 DESCRIPTION
  20.  
  21. This module provides functions to encode and decode strings into the
  22. Quoted-Printable encoding specified in RFC 2045 - I<MIME (Multipurpose
  23. Internet Mail Extensions)>.  The Quoted-Printable encoding is intended
  24. to represent data that largely consists of bytes that correspond to
  25. printable characters in the ASCII character set.  Non-printable
  26. characters (as defined by english americans) are represented by a
  27. triplet consisting of the character "=" followed by two hexadecimal
  28. digits.
  29.  
  30. Note that the encode_qp() routine does not change newlines C<"\n"> to
  31. the CRLF sequence even though this might be considered the right thing
  32. to do (RFC 1521 (Q-P Rule #4)).
  33.  
  34. If you prefer not to import these routines into your namespace you can
  35. call them as:
  36.  
  37.   use MIME::QuotedPrint ();
  38.   $encoded = MIME::QuotedPrint::encode($decoded);
  39.   $decoded = MIME::QuotedPrint::decode($encoded);
  40.  
  41. =head1 COPYRIGHT
  42.  
  43. Copyright 1995-1997 Gisle Aas.
  44.  
  45. This library is free software; you can redistribute it and/or
  46. modify it under the same terms as Perl itself.
  47.  
  48. =cut
  49.  
  50. use strict;
  51. use vars qw(@ISA @EXPORT $VERSION);
  52.  
  53. require Exporter;
  54. @ISA = qw(Exporter);
  55. @EXPORT = qw(encode_qp decode_qp);
  56.  
  57. $VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);
  58.  
  59.  
  60. sub encode_qp ($)
  61. {
  62.     my $res = shift;
  63.     $res =~ s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg;  # rule #2,#3
  64.     $res =~ s/([ \t]+)$/
  65.       join('', map { sprintf("=%02X", ord($_)) }
  66.            split('', $1)
  67.       )/egm;                        # rule #3 (encode whitespace at eol)
  68.  
  69.     # rule #5 (lines must be shorter than 76 chars, but we are not allowed
  70.     # to break =XX escapes.  This makes things complicated :-( )
  71.     my $brokenlines = "";
  72.     $brokenlines .= "$1=\n"
  73.     while $res =~ s/(.*?^[^\n]{73} (?:
  74.          [^=\n]{2} (?! [^=\n]{0,1} $) # 75 not followed by .?\n
  75.         |[^=\n]    (?! [^=\n]{0,2} $) # 74 not followed by .?.?\n
  76.         |          (?! [^=\n]{0,3} $) # 73 not followed by .?.?.?\n
  77.         ))//xsm;
  78.  
  79.     "$brokenlines$res";
  80. }
  81.  
  82.  
  83. sub decode_qp ($)
  84. {
  85.     my $res = shift;
  86.     $res =~ s/[ \t]+?(\r?\n)/$1/g;  # rule #3 (trailing space must be deleted)
  87.     $res =~ s/=\r?\n//g;            # rule #5 (soft line breaks)
  88.     $res =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge;
  89.     $res;
  90. }
  91.  
  92. # Set up aliases so that these functions also can be called as
  93. #
  94. # MIME::QuotedPrint::encode();
  95. # MIME::QuotedPrint::decode();
  96.  
  97. *encode = \&encode_qp;
  98. *decode = \&decode_qp;
  99.  
  100. 1;
  101.