Add BinHex support.

Submitted by:   Julian Field <mailscanner@ecs.soton.ac.uk>

1 files changed, 260 insertions, 0 deletions

diff --git a/mail/p5-MIME-Tools/files/patch-Parser-BinHex b/mail/p5-MIME-Tools/files/patch-Parser-BinHex
new file mode 100644
index 000000000000..cdeec197cc10
--- /dev/null
+++ b/mail/p5-MIME-Tools/files/patch-Parser-BinHex
@@ -0,0 +1,260 @@
+--- /dev/null	Sun Aug  1 22:44:02 2004
++++ lib/MIME/Decoder/BinHex.pm	Sun Aug  1 22:43:12 2004
+@@ -0,0 +1,182 @@
++package MIME::Decoder::BinHex;
++
++
++=head1 NAME
++
++MIME::Decoder::BinHex - decode a "binhex" stream
++
++
++=head1 SYNOPSIS
++
++A generic decoder object; see L<MIME::Decoder> for usage.
++
++Also supports a preamble() method to recover text before
++the binhexed portion of the stream.
++
++
++=head1 DESCRIPTION
++
++A MIME::Decoder subclass for a nonstandard encoding whereby
++data are binhex-encoded.  Common non-standard MIME encodings for this:
++
++    x-uu
++    x-uuencode
++
++
++=head1 AUTHOR
++
++Julian Field (F<mailscanner@ecs.soton.ac.uk>).
++
++All rights reserved.  This program is free software; you can redistribute 
++it and/or modify it under the same terms as Perl itself.
++
++=head1 VERSION
++
++$Revision: 1.1 $ $Date: 2004/08/01 20:46:17 $
++
++=cut
++
++
++require 5.002;
++use vars qw(@ISA $VERSION);
++use MIME::Decoder;
++use MIME::Tools qw(whine);
++use Convert::BinHex;
++
++@ISA = qw(MIME::Decoder);
++
++# The package version, both in 1.23 style *and* usable by MakeMaker:
++$VERSION = substr q$Revision: 1.1 $, 10;
++
++
++#------------------------------
++#
++# decode_it IN, OUT
++#
++sub decode_it {
++    my ($self, $in, $out) = @_;
++    my ($mode, $file);
++    my (@preamble, @data);
++    local $_;
++    my $H2B = Convert::BinHex->hex2bin;
++    #my $H2B = Convert::BinHex->open($in);
++    my $line;
++
++    $self->{MDU_Preamble} = \@preamble;
++    $self->{MDU_Mode} = '600';
++    $self->{MDU_File} = undef;
++
++    ### Find beginning...
++    $MailScanner::BinHex::Inline = 1;
++    if ($MailScanner::BinHex::Inline) {
++      while (defined($_ = $in->getline)) {
++        #print STDERR "Line is \"$_\"\n";
++        if (/^\(This file must be converted/) {
++          $_ = $in->getline;
++          last if /^:/;
++        }
++        push @preamble, $_;
++      }
++      die("binhex decoding: fell off end of file\n") if !defined($_);
++    } else {
++      while (defined($_ = $in->getline)) {
++        # Found the header? So start decoding it
++        last if /^:/;
++        push @preamble, $_;
++      }
++      ## hit eof!
++      die("binhex decoding: no This file must be... found\n") if !defined($_);
++    }
++
++    ### Decode:
++    # Don't rely on the comment always being there
++    #$self->whine(":H2B is $H2B\n");
++    #$self->whine("Header is " . $H2B->read_header . "\n");
++    #@data = $H2B->read_data;
++    #$out->print(@data);
++    #print STDERR "End of binhex stream\n";
++    #return 1;
++    #if (/^:/) {
++    my $data;
++    $data = $H2B->next($_); # or whine("Next error is $@ $!\n");
++    #print STDERR "Data line 1 is length \"" . length($data) . "\" \"$data\"\n";
++    my $len = unpack("C", $data);
++    while ($len > length($data)+21 && defined($line = $in->getline)) {
++      $data .= $H2B->next($line);
++    }
++    $data = substr($data, 22+$len);
++    $out->print($data);
++    #}
++    while (defined($_ = $in->getline)) {
++        $line = $_;
++        $data = $H2B->next($line);
++        #print STDERR "Data is length " . length($data) . " \"$data\"\n";
++        $out->print($data);
++        #chomp $line;
++        #print STDERR "Line is length " . length($line) . " \"$line\"\n";
++        #print STDERR "Line matches end\n" if $line =~ /:$/;
++        last if $line =~ /:$/;
++    }
++    #print STDERR "Broken out of loop\n";
++    #print STDERR "file incomplete, no end found\n" if !defined($_); # eof
++    1;
++}
++
++#------------------------------
++#
++# encode_it IN, OUT
++#
++sub encode_it {
++    my ($self, $in, $out) = @_;
++    my $line;
++    my $buf = '';
++
++    my $fname = (($self->head && 
++		  $self->head->mime_attr('content-disposition.filename')) ||
++		 '');
++    my $B2H = Convert::BinHex->bin2hex;
++    $out->print("(This file must be converted with BinHex 4.0)\n");
++    #while (defined($line = <$in>)) {
++    while ($in->read($buf, 1000)) {
++      $out->print($B2H->next($buf));
++    }
++    $out->print($B2H->done);
++    1;
++}
++
++#------------------------------
++#
++# last_preamble
++#
++# Return the last preamble as ref to array of lines.
++# Gets reset by decode_it().
++#
++sub last_preamble {
++    my $self = shift;
++    return $self->{MDU_Preamble} || [];
++}
++
++#------------------------------
++#
++# last_mode
++#
++# Return the last mode.
++# Gets reset to undef by decode_it().
++#
++sub last_mode {
++    shift->{MDU_Mode};
++}
++
++#------------------------------
++#
++# last_filename
++#
++# Return the last filename.
++# Gets reset by decode_it().
++#
++sub last_filename {
++    shift->{MDU_File} || undef; #[];
++}
++
++#------------------------------
++1;
+--- lib/MIME/Decoder.pm.orig	Sun Aug  1 22:44:50 2004
++++ lib/MIME/Decoder.pm	Sun Aug  1 22:45:10 2004
+@@ -111,6 +111,7 @@
+     'quoted-printable' => 'MIME::Decoder::QuotedPrint',
+ 
+   ### Non-standard...
++    'binhex'     => 'MIME::Decoder::BinHex',
+     'x-uu'       => 'MIME::Decoder::UU',
+     'x-uuencode' => 'MIME::Decoder::UU',
+ 
+--- lib/MIME/Parser.pm	Tue Aug 31 18:54:05 2004
++++ lib/MIME/Parser.pm	Tue Aug 31 18:53:33 2004
+@@ -799,10 +802,11 @@
+     $self->debug("extract uuencode? ", $self->extract_uuencode);
+     $self->debug("encoding?         ", $encoding);
+     $self->debug("effective type?   ", $ent->effective_type);
++
+     if ($self->extract_uuencode and
+ 	($encoding =~ /^(7bit|8bit|binary)\Z/) and
+-	($ent->effective_type =~ m{^text/plain\Z})) {
+-	
++	($ent->effective_type =~ 
++		m{^(?:text/plain|application/mac-binhex40|application/mac-binhex)\Z})) {
+ 	### Hunt for it:
+ 	my $uu_ent = eval { $self->hunt_for_uuencode($ENCODED, $ent) };
+ 	if ($uu_ent) {   ### snark
+@@ -842,14 +844,21 @@
+ #
+ sub hunt_for_uuencode {
+     my ($self, $ENCODED, $ent) = @_;
+-    my $good;
++    my ($good, $jkfis);
+     local $_;
+     $self->debug("sniffing around for UUENCODE");
+ 
+     ### Heuristic:
+     $ENCODED->seek(0,0);
+     while (defined($_ = $ENCODED->getline)) {
+-	last if ($good = /^begin [0-7]{3}/);
++        if ($good = /^begin [0-7]{3}/) {
++          $jkfis = 'uu';
++          last;
++        }
++        if ($good = /^\(This file must be converted with/i) {
++          $jkfis = 'binhex';
++          last;
++        }
+     }
+     $good or do { $self->debug("no one made the cut"); return 0 };
+ 
+@@ -860,7 +869,9 @@
+ 
+     ### Made the first cut; on to the real stuff:
+     $ENCODED->seek(0,0);
+-    my $decoder = MIME::Decoder->new('x-uuencode');
++    my $decoder = MIME::Decoder->new(($jkfis eq 'uu')?'x-uuencode'
++                                                     :'binhex');
++    $self->whine("Found a $jkfis attachment");
+     my $pre;
+     while (1) {
+ 	my @bin_data;
+@@ -910,12 +921,11 @@
+ 
+     ### Did we get anything?
+     @parts or return undef;
+-
+     ### Set the parts and a nice preamble:
+     $top_ent->parts(\@parts);
+     $top_ent->preamble
+ 	(["The following is a multipart MIME message which was extracted\n",
+-	  "from a uuencoded message.\n"]);
++          "from a $jkfis-encoded message.\n"]);
+     $top_ent;
+ }
+