File Coverage

blib/lib/MIME/Decoder/BinHex.pm
Criterion Covered Total %
statement 70 78 89.7
branch 6 12 50.0
condition 2 7 28.5
subroutine 8 11 72.7
pod 2 5 40.0
total 88 113 77.8


line stmt bran cond sub pod time code
1             package MIME::Decoder::BinHex;
2 1     1   6 use strict;
  1         3  
  1         32  
3 1     1   6 use warnings;
  1         1  
  1         53  
4              
5              
6             =head1 NAME
7              
8             MIME::Decoder::BinHex - decode a "binhex" stream
9              
10              
11             =head1 SYNOPSIS
12              
13             A generic decoder object; see L for usage.
14              
15             Also supports a preamble() method to recover text before
16             the binhexed portion of the stream.
17              
18              
19             =head1 DESCRIPTION
20              
21             A MIME::Decoder subclass for a nonstandard encoding whereby
22             data are binhex-encoded. Common non-standard MIME encodings for this:
23              
24             x-uu
25             x-uuencode
26              
27             =head1 SEE ALSO
28              
29             L
30              
31             =head1 AUTHOR
32              
33             Julian Field (F).
34              
35             All rights reserved. This program is free software; you can redistribute
36             it and/or modify it under the same terms as Perl itself.
37              
38             =cut
39              
40              
41             require 5.002;
42 1     1   15 use vars qw(@ISA $VERSION);
  1         2  
  1         59  
43 1     1   6 use MIME::Decoder;
  1         2  
  1         35  
44 1     1   6 use MIME::Tools qw(whine);
  1         2  
  1         79  
45 1     1   1104 use Convert::BinHex;
  1         6427  
  1         666  
46              
47             @ISA = qw(MIME::Decoder);
48              
49             # The package version, both in 1.23 style *and* usable by MakeMaker:
50             $VERSION = "5.507";
51              
52              
53             #------------------------------
54             #
55             # decode_it IN, OUT
56             #
57             sub decode_it {
58 1     1 1 3 my ($self, $in, $out) = @_;
59 1         1 my ($mode, $file);
60 0         0 my (@preamble, @data);
61 1         4 my $H2B = Convert::BinHex->hex2bin;
62 1         18 my $line;
63              
64 1         2 $self->{MDU_Preamble} = \@preamble;
65 1         2 $self->{MDU_Mode} = '600';
66 1         2 $self->{MDU_File} = undef;
67              
68             ### Find beginning...
69 1         2 local $_;
70 1         29 while (defined($_ = $in->getline)) {
71 1 50       39 if (/^\(This file must be converted/) {
72 1         21 $_ = $in->getline;
73 1 50       26 last if /^:/;
74             }
75 0         0 push @preamble, $_;
76             }
77 1 50       3 die("binhex decoding: fell off end of file\n") if !defined($_);
78              
79             ### Decode:
80 1         3 my $data;
81 1         3 $data = $H2B->next($_); # or whine("Next error is $@ $!\n");
82 1         141 my $len = unpack("C", $data);
83 1   33     5 while ($len > length($data)+21 && defined($line = $in->getline)) {
84 0         0 $data .= $H2B->next($line);
85             }
86 1 50       6 if (length($data) >= 22+$len) {
87 1         3 $data = substr($data, 22+$len);
88             } else {
89 0         0 $data = '';
90             }
91              
92 1         3 $out->print($data);
93 1         32 while (defined($_ = $in->getline)) {
94 63         1493 $line = $_;
95 63         139 $data = $H2B->next($line);
96 63         8933 $out->print($data);
97 63 100       1457 last if $line =~ /:$/;
98             }
99 1         24 1;
100             }
101              
102             #------------------------------
103             #
104             # encode_it IN, OUT
105             #
106             sub encode_it {
107 1     1 1 2 my ($self, $in, $out) = @_;
108 1         2 my $line;
109 1         2 my $buf = '';
110 1   50     21 my $fname = (($self->head &&
111             $self->head->mime_attr('content-disposition.filename')) ||
112             '');
113 1         4 my $B2H = Convert::BinHex->bin2hex;
114 1         23 $out->print("(This file must be converted with BinHex 4.0)\n");
115              
116             # Sigh... get length of file
117 1         24 $in->seek(0, 2);
118 1         18 my $datalen = $in->tell();
119 1         8 $in->seek(0, 0);
120              
121             # Build header in core:
122 1         5 my @hdrs;
123 1         2 my $flen = length($fname);
124 1         4 push @hdrs, pack("C", $flen);
125 1         4 push @hdrs, pack("a$flen", $fname);
126 1         2 push @hdrs, pack('C', 4);
127 1         1 push @hdrs, pack('a4', '????');
128 1         3 push @hdrs, pack('a4', '????');
129 1         1 push @hdrs, pack('n', 0);
130 1         3 push @hdrs, pack('N', $datalen);
131 1         2 push @hdrs, pack('N', 0); # Resource length
132 1         3 my $hdr = join '', @hdrs;
133              
134             # Compute the header CRC:
135 1         3 my $crc = Convert::BinHex::binhex_crc("\000\000",
136             Convert::BinHex::binhex_crc($hdr, 0));
137              
138             # Output the header (plus its CRC):
139 1         55 $out->print($B2H->next($hdr . pack('n', $crc)));
140              
141 1         16 while ($in->read($buf, 1000)) {
142 4         380 $out->print($B2H->next($buf));
143             }
144 1         19 $out->print($B2H->done);
145 1         46 1;
146             }
147              
148             #------------------------------
149             #
150             # last_preamble
151             #
152             # Return the last preamble as ref to array of lines.
153             # Gets reset by decode_it().
154             #
155             sub last_preamble {
156 0     0 0   my $self = shift;
157 0   0       return $self->{MDU_Preamble} || [];
158             }
159              
160             #------------------------------
161             #
162             # last_mode
163             #
164             # Return the last mode.
165             # Gets reset to undef by decode_it().
166             #
167             sub last_mode {
168 0     0 0   shift->{MDU_Mode};
169             }
170              
171             #------------------------------
172             #
173             # last_filename
174             #
175             # Return the last filename.
176             # Gets reset by decode_it().
177             #
178             sub last_filename {
179 0 0   0 0   shift->{MDU_File} || undef; #[];
180             }
181              
182             #------------------------------
183             1;