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