MIME-Explode
view release on metacpan or search on metacpan
use vars qw($VERSION @ISA @EXPORT);
@ISA = qw(Exporter DynaLoader);
@EXPORT = qw(&rfc822_base64 &rfc822_qprint);
$VERSION = '0.39';
use constant BUFFSIZE => 64;
my %h_hash = (
'content-type' => "",
'content-disposition' => "",
'content-transfer-encoding' => "",
);
my @patterns = (
'^([^= ]+) *=[ \"]*([^\"]+)',
'^(\w[\w\-\.]*):[\x20\x09]*([^\x0d\x0a\f]*)[\x0d\x0a\f]+',
'^[\x0a\x0d]+$',
'^begin\s*(\d\d\d)\s*(\S+)',
'^From +[^ ]+ +[a-zA-Z]{3} [a-zA-Z]{3} [ \d]\d \d\d:\d\d:\d\d \d{4}( [\+\-]\d\d\d\d)?[\x0a\x0d]+',
push(@{$_[0]->{$tree}->{$key}}, $2);
next;
}
unless(exists($_[0]->{$tree}->{$key})) {
$_[0]->{$tree}->{$key} = (exists($h_hash{$key})) ? {value => $2} : $2;
}
next;
}
next if(!$checkhdr && (length() <= 2) && /$patterns[2]/o);
$header = 0;
if(exists($_[0]->{$tree}->{'content-type'}) && exists($_[0]->{$tree}->{'content-type'}->{value})) {
$_[0]->{$tree}->{'content-type'}->{value} = lc($_[0]->{$tree}->{'content-type'}->{value});
if(exists($_[0]->{$tree}->{'content-type'}->{boundary}) && $_[0]->{$tree}->{'content-type'}->{value} =~ /multipart\/\w+/o) {
my $res = &_parse($fhs, $header, $mbox, $tree, $_[0]->{$tree}->{'content-type'}->{boundary}, $args, $files, $_[0]);
if($res->[1]) {
$mbox ? ($tmp = 1) : return([$tree, $res->[1]]);
$_ = $res->[1];
} else { next; }
} elsif($_[0]->{$tree}->{'content-type'}->{value} eq "message/rfc822") {
my $res = &_parse($fhs, 1, $mbox, $tree, $origin, $args, $files, $_[0]);
if($res->[1]) {
$mbox ? ($tmp = 1) : return([$tree, $res->[1]]);
$_ = $res->[1];
} else { next; }
}
}
}
$checkhdr = 0;
$key = "";
defined($_) or next;
if(/$patterns[3]/o) {
my $file = &check_filename($files, $2);
my $filepath = ($args->{output_dir}) ? join("/", $args->{output_dir}, $file) : $file;
my $res = uu_file($fhs, $filepath, $1 || "644",
{
action => $args->{'types_action'},
mimetypes => $args->{'ctypes'}
}
);
$_[0]->{"$tree.$attcount"}->{'content-type'}->{value} = $res->[0];
$_[0]->{"$tree.$attcount"}->{'content-disposition'}->{filepath} = $filepath unless($res->[1]);
$attcount++;
next;
}
my $breakmsg = "";
unless(defined($fh)) {
$boundary = $origin;
if(exists($_[0]->{$tree}->{'content-type'}) && exists($_[0]->{$tree}->{'content-type'}->{value})) {
$exclude = 1 if(($_[0]->{$tree}->{'content-type'}->{value} =~ /^multipart\/\w+$/o) || ($_[0]->{$tree}->{'content-type'}->{value} eq "message/rfc822"));
} else { $check_ctype = 1; }
unless($exclude) {
if(exists($_[0]->{$tree}->{'content-transfer-encoding'}) &&
exists($_[0]->{$tree}->{'content-transfer-encoding'}->{value})) {
$_[0]->{$tree}->{'content-transfer-encoding'}->{value} = lc($_[0]->{$tree}->{'content-transfer-encoding'}->{value});
if($_[0]->{$tree}->{'content-transfer-encoding'}->{value} eq "base64" ||
($_[0]->{$tree}->{'content-transfer-encoding'}->{value} eq "quoted-printable" && $boundary)) {
&set_filename($files, $_[0]->{$tree});
my $filepath = ($args->{output_dir}) ? join("/", $args->{output_dir}, $_[0]->{$tree}->{'content-disposition'}->{filename}) : $_[0]->{$tree}->{'content-disposition'}->{filename};
my $res = &decode_content($fhs,
$_[0]->{$tree}->{'content-transfer-encoding'}->{value},
$filepath,
$boundary ? "--$boundary" : "",
{
mimetype => $_[0]->{$tree}->{'content-type'}->{value} || "",
checktype => $args->{'check_ctype'},
action => $args->{'types_action'},
mimetypes => $args->{'ctypes'},
mailbox => $mbox
});
$_[0]->{$tree}->{'content-type'}->{value} = $res->[1] if($res->[1]);
$_[0]->{$tree}->{'content-disposition'}->{filepath} = $filepath unless($res->[2]);
$tmp = 1;
unless($_ = $res->[0]) {
$exclude = 1;
next;
}
if($mbox && /$patterns[4]/o && scalar(@{[split(/\./o, $tree)]}) > 2) {
$breakmsg = $_;
$_ = "--$boundary--\r\n";
}
($tmp, $exclude) = (1, 1);
$boundary = "";
next;
} else { return([$tree, $breakmsg]); }
}
if(index($_, "--$boundary") >= 0) {
defined($fh) and &file_close($fh);
($tmp, $header) = (1, 1);
$boundary = "";
if($ph) {
return([$tree]) if($_[0]->{$base}->{'content-type'}->{value} eq "message/rfc822");
my @ps = split(/\./o, $tree);
$ps[$#ps]++;
$tree = join("\.", @ps);
}
next;
}
}
(!$exclude && $ph) or next;
if($check_ctype && $args->{check_ctype}) {
($tmpbuff .= $_) =~ s/^[\n\r\t]+//o;
if(length($tmpbuff) > BUFFSIZE) {
$_[0]->{$tree}->{'content-type'}->{value} ||= "";
if(my $ct = set_content_type($tmpbuff, $_[0]->{$tree}->{'content-type'}->{value})) {
$_[0]->{$tree}->{'content-type'}->{value} = $ct;
$tmpbuff = "";
$check_ctype = 0;
}
if($exclude = exists($args->{'ctypes'}->{$_[0]->{$tree}->{'content-type'}->{value}}) ? ($args->{'types_action'} ? 0 : 1) :
scalar(keys(%{$args->{'ctypes'}})) ? ($args->{'types_action'} ? 1 : 0) : ($args->{'types_action'} ? 0 : 1)) {
if(defined($fh)) {
&file_close($fh);
unlink($_[0]->{$tree}->{'content-disposition'}->{filepath});
delete($_[0]->{$tree}->{'content-disposition'}->{filepath});
}
next;
}
}
}
return();
}
sub set_filename {
my $files = shift;
my $h = shift;
my $file = "file";
if(exists($h->{'content-disposition'}->{filename})) {
$file = $h->{'content-disposition'}->{filename};
} elsif(exists($h->{'content-type'}->{name})) {
$file = $h->{'content-type'}->{name};
} elsif(exists($h->{'content-type'}->{value})) {
my $ctype = lc($h->{'content-type'}->{value});
$file .= $content_type{$ctype} || "";
}
$file =~ s/^[ \.]+$/file/o;
$h->{'content-disposition'}->{filename} = &check_filename($files, $file);
$h->{'content-transfer-encoding'}->{value} = "" unless(exists($h->{'content-transfer-encoding'}->{value}));
return();
}
bootstrap MIME::Explode $VERSION;
Directory where the decoded files are placed
=item mkdir => octal_number
If the value is set to octal number then make the output_dir directory
(example: mkdir => 0755).
=item check_content_type => 0 or 1
If the value is set to 1 the content-type of file is checked
=item decode_subject => 0 or 1
If the value is set to 1 then the subject is decoded into a list.
$header->{'0.0'}->{subject}->{value} = [ARRAYREF];
$header->{'0.0'}->{subject}->{charset} = [ARRAYREF];
$subject = join("", @{$header->{'0.0'}->{subject}->{value}});
=item exclude_types => [ARRAYREF]
( run in 3.057 seconds using v1.01-cache-2.11-cpan-524268b4103 )