Mail-Box-IMAP4
view release on metacpan or search on metacpan
lib/Mail/Server/IMAP4/Fetch.pm view on Meta::CPAN
if defined($field = $head->get('Content-Language'));
$self->{filename} = $value
if defined($value = $body->dispositionFilename);
$self->{bodyMD5} = md5_base64($body->string)
if $args{md5checksums};
if(defined($field = $body->transferEncoding))
{ my $tf = $field->unfoldedBody;
$self->{transferenc} = $tf unless $tf eq 'none';
}
# Should become:
# $self->{disposition} = [ $field->body, $field->study->attributes ]
if(defined($field = $body->disposition))
{ my $how = $field->body;
$how = $body->isText ? 'inline' : 'attachment' if $how eq 'none';
$self->{disposition} = [ $how, $field->attributes ];
}
else
{ $self->{disposition} = [ ($body->isText ? 'inline' : 'attachment') ];
}
my $id = $head->get('Content-Message-ID') || $head->get("Message-ID");
if(defined $id)
{ my $msgid = $id->unfoldedBody =~ s/^\<*/</r =~ s/\>*$/>/r;
$self->{messageid} = $msgid if length $msgid;
}
foreach my $addr ( qw/to from sender reply-to cc bcc/ )
{ my $addrs = $head->study($addr) or next;
foreach my $group ($addrs->groups)
{ my @addrs = map +[ $_->phrase, $_->username, $_->domain ], $group->addresses;
push @{$self->{$addr}}, [ $group->name, @addrs ];
}
}
if($body->isMultipart)
{ $self->{parts} = +[ map $class->new($_), $body->parts ];
}
elsif($body->isNested)
{ $self->{nest} = $class->new($body->nested);
}
$self;
}
#--------------------
sub headLocation() { @{$_[0]}{ qw/headbegin bodybegin/ } }
sub bodyLocation() { @{$_[0]}{ qw/bodybegin bodyend/ } }
sub partLocation() { @{$_[0]}{ qw/headbegin bodyend/ } }
#--------------------
sub fetchBody($)
{ my ($self, $extended) = @_;
my $type = uc $self->{type};
my ($mediatype, $subtype) = split m[/], $type;
if($self->{parts})
{ # Multipart message
# WARNING: no blanks between part descriptions
my $parts = join '', map $_->fetchBody($extended), @{$self->{parts}};
my @fields = (\$parts, $subtype || 'MIXED');
if($extended) # only included when any valid info
{ my @attr; # don't know what to include here
my @disp; # don't know about this either
push @fields, \@attr, \@disp, $self->{language}
if @attr || @disp || defined $self->{language};
}
return $self->_imapList(@fields);
}
#
# Simple message
#
my @fields = (
($mediatype || 'TEXT'),
($subtype || 'PLAIN'),
$self->{typeattr},
$self->{messageid},
$self->{description},
uc($self->{transferenc} || '8BIT'),
\($self->{bodysize}),
);
if(my $nest = $self->{nest})
{ # type MESSAGE (message/rfc822 encapsulated)
push @fields,
\$nest->fetchEnvelope,,
\$nest->fetchBody($extended);
}
push @fields, \$self->{bodylines};
push @fields, @{$self}{ qw/bodyMD5 disposition language/ }
if $extended && ($self->{bodyMD5} || $self->{disposition} || $self->{language});
$self->_imapList(@fields);
}
sub fetchEnvelope()
{ my $self = shift;
my @fields = ($self->{date}, $self->{subject});
foreach my $addr ( qw/from sender reply-to to cc bcc/ )
{ unless($self->{$addr})
{ push @fields, undef; # NIL
next;
}
# For now, group information is ignored... RFC2060 is very
# unclear about it... and seems incompatible with RFC2822
my $addresses = '';
( run in 0.808 second using v1.01-cache-2.11-cpan-71847e10f99 )