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 )