view release on metacpan or  search on metacpan

lib/Mail/Message/Field.pm  view on Meta::CPAN

		Content-Type Content-Disposition Content-ID
		MIME-Version Precedence Status
	/;
}

sub isStructured(;$)
{	my $name  = $_[1] // (blessed $_[0] ? $_[0]->name : panic);
	exists $_structured{lc $name};
}


sub print(;$)
{	my $self = shift;
	my $fh   = shift || select;
	$fh->print(scalar $self->folded);
}


sub toString(;$) { shift->string(@_) }

sub string(;$)
{	my $self  = shift;
	return $self->folded unless @_;

	my $wrap  = shift || $default_wrap_length;
	my $name  = $self->Name;
	my @lines = $self->fold($name, $self->unfoldedBody, $wrap);
	$lines[0] = $name . ':' . $lines[0];
	wantarray ? @lines : join('', @lines);
}


sub toDisclose()
{	$_[0]->name !~ m! ^
		(?: (?:x-)?status
		|   (?:resent-)?bcc
		|   content-length
		|   x-spam-
		) $ !x;
}


sub nrLines() { my @l = $_[0]->foldedBody; scalar @l }


*size = \&length;

#--------------------

sub stripCFWS($)
{	my $thing  = shift;

	# get (folded) data
	my $string = @_ ? shift : $thing->foldedBody;

	# remove comments
	my $r          = '';
	my $in_dquotes = 0;
	my $open_paren = 0;

	my @s = split m/([()"])/, $string;
	while(@s)
	{	my $s = shift @s;

		   if(CORE::length($r)&& substr($r, -1) eq "\\")  { $r .= $s }
		elsif($s eq '"')   { $in_dquotes = not $in_dquotes; $r .= $s }
		elsif($s eq '(' && !$in_dquotes) { $open_paren++ }
		elsif($s eq ')' && !$in_dquotes) { $open_paren-- }
		elsif($open_paren) {}  # in comment
		else               { $r .= $s }
	}

	# beautify and unfold at the same time
	$r =~ s/\s+/ /grs =~ s/\s+$//r =~ s/^\s+//r;
}


sub comment(;$)
{	my $self = shift;
	$self->isStructured or return undef;

	my $body = $self->unfoldedBody;

	if(@_)
	{	my $comment = shift;
		$body    =~ s/\s*\;.*//;
		$body   .= "; $comment" if defined $comment && CORE::length($comment);
		$self->unfoldedBody($body);
		return $comment;
	}

	$body =~ s/.*?\;\s*// ? $body : '';
}

sub content() { shift->unfoldedBody }  # Compatibility


sub attribute($;$)
{	my ($self, $attr) = (shift, shift);

	# Although each attribute can appear only once, some (intentionally)
	# broken messages do repeat them.  See github issue 20.  Apple Mail and
	# Outlook will take the last of the repeated in such case, so we do that
	# as well.
	tie my %attrs, 'Hash::Case::Preserve', [ $self->attributes ];
	@_ or return $attrs{$attr};

	# set the value
	my $value = shift;
	my $body  = $self->unfoldedBody;

	unless(defined $value)  # remove attribute
	{	for($body)
		{	s/\b$attr\s*=\s*"(?>[^\\"]|\\.)*"//i or s/\b$attr\s*=\s*[;\s]*//i;
		}
		$self->unfoldedBody($body);
		return undef;
	}

	my $quoted = $value =~ s/(["\\])/\\$1/gr;