home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / NBit.pm < prev    next >
Encoding:
Perl POD Document  |  2002-06-14  |  4.6 KB  |  161 lines
  1. package MIME::Decoder::NBit;
  2.  
  3.  
  4. =head1 NAME
  5.  
  6. MIME::Decoder::NBit - encode/decode a "7bit" or "8bit" 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. This is a MIME::Decoder subclass for the C<7bit> and C<8bit> content
  17. transfer encodings.  These are not "encodings" per se: rather, they
  18. are simply assertions of the content of the message.
  19. From RFC-2045 Section 6.2.:
  20.  
  21.    Three transformations are currently defined: identity, the "quoted-
  22.    printable" encoding, and the "base64" encoding.  The domains are
  23.    "binary", "8bit" and "7bit".
  24.  
  25.    The Content-Transfer-Encoding values "7bit", "8bit", and "binary" all
  26.    mean that the identity (i.e. NO) encoding transformation has been
  27.    performed.  As such, they serve simply as indicators of the domain of
  28.    the body data, and provide useful information about the sort of
  29.    encoding that might be needed for transmission in a given transport
  30.    system.
  31.  
  32. In keeping with this: as of MIME-tools 4.x,
  33. I<this class does no modification of its input when encoding;>
  34. all it does is attempt to I<detect violations> of the 7bit/8bit assertion,
  35. and issue a warning (one per message) if any are found.
  36.  
  37.  
  38. =head2 Legal 7bit data
  39.  
  40. RFC-2045 Section 2.7 defines legal C<7bit> data:
  41.  
  42.    "7bit data" refers to data that is all represented as relatively
  43.    short lines with 998 octets or less between CRLF line separation
  44.    sequences [RFC-821].  No octets with decimal values greater than 127
  45.    are allowed and neither are NULs (octets with decimal value 0).  CR
  46.    (decimal value 13) and LF (decimal value 10) octets only occur as
  47.    part of CRLF line separation sequences.
  48.  
  49.  
  50. =head2 Legal 8bit data
  51.  
  52. RFC-2045 Section 2.8 defines legal C<8bit> data:
  53.  
  54.    "8bit data" refers to data that is all represented as relatively
  55.    short lines with 998 octets or less between CRLF line separation
  56.    sequences [RFC-821]), but octets with decimal values greater than 127
  57.    may be used.  As with "7bit data" CR and LF octets only occur as part
  58.    of CRLF line separation sequences and no NULs are allowed.
  59.  
  60.  
  61. =head2 How decoding is done
  62.  
  63. The B<decoder> does a line-by-line pass-through from input to output,
  64. leaving the data unchanged I<except> that an end-of-line sequence of
  65. CRLF is converted to a newline "\n".  Given the line-oriented nature
  66. of 7bit and 8bit, this seems relatively sensible.
  67.  
  68.  
  69. =head2 How encoding is done
  70.  
  71. The B<encoder> does a line-by-line pass-through from input to output,
  72. and simply attempts to I<detect> violations of the C<7bit>/C<8bit>
  73. domain.  The default action is to warn once per encoding if violations
  74. are detected; the warnings may be silenced with the QUIET configuration
  75. of L<MIME::Tools>.
  76.  
  77.  
  78. =head1 AUTHOR
  79.  
  80. Eryq (F<eryq@zeegee.com>), ZeeGee Software Inc (F<http://www.zeegee.com>).
  81.  
  82. All rights reserved.  This program is free software; you can redistribute
  83. it and/or modify it under the same terms as Perl itself.
  84.  
  85.  
  86. =head1 VERSION
  87.  
  88. $Revision: 5.403 $ $Date: 2000/11/04 19:54:48 $
  89.  
  90.  
  91. =cut
  92.  
  93. use vars qw(@ISA $VERSION);
  94.  
  95. use MIME::Decoder;
  96. use MIME::Tools qw(:msgs);
  97.  
  98. @ISA = qw(MIME::Decoder);
  99.  
  100. ### The package version, both in 1.23 style *and* usable by MakeMaker:
  101. $VERSION = substr q$Revision: 5.403 $, 10;
  102.  
  103. ### How many bytes to decode at a time?
  104. my $DecodeChunkLength = 8 * 1024;
  105.  
  106. #------------------------------
  107. #
  108. # decode_it IN, OUT
  109. #
  110. sub decode_it {
  111.     my ($self, $in, $out) = @_;
  112.     my $and_also;
  113.  
  114.     ### Allocate a buffer suitable for a chunk and a line:
  115.     local $_ = (' ' x ($DecodeChunkLength + 1024)); $_ = '';
  116.  
  117.     ### Get chunks until done:
  118.     while ($in->read($_, $DecodeChunkLength)) {
  119.     $and_also = $in->getline;
  120.     $_ .= $and_also if defined($and_also);
  121.     
  122.     ### Just got a chunk ending in a line.
  123.     s/\015\012$/\n/g;
  124.     $out->print($_);
  125.     }
  126.     1;
  127. }
  128.  
  129. #------------------------------
  130. #
  131. # encode_it IN, OUT
  132. #
  133. sub encode_it {
  134.     my ($self, $in, $out) = @_;
  135.     my $saw_8bit = 0;    ### warn them ONCE PER ENCODING if 8-bit data exists
  136.     my $saw_long = 0;    ### warn them ONCE PER ENCODING if long lines exist
  137.     my $seven_bit = ($self->encoding eq '7bit');      ### 7bit?
  138.  
  139.     my $line;
  140.     while (defined($line = $in->getline)) {
  141.  
  142.     ### Whine if encoding is 7bit and it has 8-bit data:
  143.     if ($seven_bit && ($line =~ /[\200-\377]/)) { ### oops! saw 8-bit data!
  144.         whine "saw 8-bit data while encoding 7bit" unless $saw_8bit++;
  145.     }
  146.  
  147.     ### Whine if long lines detected:
  148.     if (length($line) > 998) {
  149.         whine "saw long line while encoding 7bit/8bit" unless $saw_long++;
  150.     }
  151.  
  152.     ### Output!
  153.     $out->print($line);
  154.     }
  155.     1;
  156. }
  157.  
  158. 1;
  159.  
  160.  
  161.