libmail-box-perl 2.099-1 / usr / share / perl5 / Mail / Message / Field / Fast.pm

# Copyrights 2001-2011 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.00.
use strict;
use warnings;

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

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


#------------------------------------------
#
# 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;