File Coverage

blib/lib/MIME/Decoder/NBit.pm
Criterion Covered Total %
statement 37 37 100.0
branch 7 10 70.0
condition 3 3 100.0
subroutine 7 7 100.0
pod 2 2 100.0
total 56 59 94.9


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