File Coverage

blib/lib/Mail/Message/Field/Fast.pm

Criterion	Covered	Total	%
statement	41	44	93.1
branch	14	16	87.5
condition	1	3	33.3
subroutine	12	13	92.3
pod	9	9	100.0
total	77	85	90.5

# Copyrights 2001-2023 by [Mark Overmeer ].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.03.
# This code is part of distribution Mail-Message.  Meta-POD processed with
# OODoc into POD and HTML manual-pages.  See README.md
# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.

package Mail::Message::Field::Fast;
use vars '$VERSION';
$VERSION = '3.013';

use base 'Mail::Message::Field';

use strict;
use warnings;


#------------------------------------------
#
# The DATA is stored as:   [ NAME, FOLDED-BODY ]
# The body is kept in a folded fashion, where each line starts with
# a single blank.


sub new($;$@)
{   my $class = shift;

    my ($name, $body) = $class->consume(@_==1 ? (shift) : (shift, shift));
    return () unless defined $body;

    my $self = bless [$name, $body], $class;

    # Attributes
    $self->comment(shift)             if @_==1;   # one attribute line
    $self->attribute(shift, shift) while @_ > 1;  # attribute pairs

    $self;
}

sub clone()
{   my $self = shift;
    bless [ @$self ], ref $self;
}

sub length()
{   my $self = shift;
    length($self->[0]) + 1 + length($self->[1]);
}

sub name() { lc shift->[0] }
sub Name() { shift->[0] }

sub folded()
{   my $self = shift;
    return $self->[0].':'.$self->[1]
        unless wantarray;

    my @lines = $self->foldedBody;
    my $first = $self->[0]. ':'. shift @lines;
    ($first, @lines);
}

sub unfoldedBody($;@)
{   my $self = shift;

    $self->[1] = $self->fold($self->[0], @_)
       if @_;

    $self->unfold($self->[1]);
}

sub foldedBody($)
{   my ($self, $body) = @_;
    if(@_==2) { $self->[1] = $body }
    else      { $body = $self->[1] }

    wantarray ? (split m/^/, $body) : $body;
}

# For performance reasons only
sub print(;$)
{   my $self = shift;
    my $fh   = shift || select;
    if(ref $fh eq 'GLOB') { print $fh $self->[0].':'.$self->[1]   }
    else                  { $fh->print($self->[0].':'.$self->[1]) }
    $self;
}

1;