use strict; use warnings; package Mail::Message::Field::Flex; use base 'Mail::Message::Field'; use Carp; our $VERSION = 2.003; =head1 NAME Mail::Message::Field::Flex - one line of a message header =head1 CLASS HIERARCHY Mail::Message::Field::Flex is a Mail::Message::Field =head1 SYNOPSIS See L<Mail::Message::Field> =head1 DESCRIPTION See L<Mail::Message::Field>. This is the flexible implementation of a field: it can easily be extended because it stores its data in a hash and the constructor (C<new>) and initialiser (C<init>) are split. However, you pay the price in performance. The C<::Fast> packages is faster (as the name predicts). =head1 METHOD INDEX The general methods for C<Mail::Message::Field::Flex> objects: MMF addresses MMF name MMF attribute NAME [, VALUE] MMF new ... MMF body MMF print [FILEHANDLE] MMF clone MMF toDate TIME MMF comment [STRING] MMF toInt MMF folded [ARRAY-OF-LINES] MMF toString The extra methods for extension writers: MMF isStructured MMF nrLines MMF newNoCheck NAME, BODY, COMM... MMF setWrapLength CHARS Prefixed methods are described in MMF = L<Mail::Message::Field>. =head1 METHODS =over 4 =cut #------------------------------------------ sub new($;$$@) { my $class = shift; my ($name, $body, $comment, %args); if(@_==2 && ref $_[1] eq 'ARRAY' && !ref $_[1][0]) { $name = shift; %args = @{(shift)} } elsif(@_>=3) { ($name, $body, $comment, %args) = @_ } elsif(@_==2) { ($name, $body) = @_ } elsif(@_==1) { $name = shift } else { confess } $args{create} = [$name, $body, $comment]; (bless {}, $class)->init(\%args); } sub init($) { my ($self, $args) = @_; my ($name, $body, $comment) = @{$args->{create}}; # # Compose the body. # if(!defined $body) { # must be one line of a header. ($name, $body) = split /\:\s*/, $name, 2; unless($body) { warn "No colon in headerline: $name\n"; $body = ''; } } elsif($name =~ m/\:/) { warn "A header-name cannot contain a colon in $name\n"; return undef; } if(defined $body && ref $body) { # Objects $body = join ', ', map {$_->isa('Mail::Address') ? $_->format : "$_"} (ref $body eq 'ARRAY' ? @$body : $body); } warn "Header-field name contains illegal character: $name\n" if $name =~ m/[^\041-\176]/; $body =~ s/\s*\015?\012$//; # # Take the comment. # if(defined $comment && length $comment) { # A comment is defined, so shouldn't be in body. confess "A header-body cannot contain a semi-colon in $body." if $body =~ m/\;/; } elsif(__PACKAGE__->isStructured($name)) { # try strip comment from field-body. $comment = $body =~ s/\s*\;\s*(.*)$// ? $1 : undef; } # # Create the object. # @$self{ qw/MMF_name MMF_body MMF_comment/ } = ($name, $body, $comment); $self; } #------------------------------------------ sub clone() { my $self = shift; (ref $self)->new($self->name, $self->body, $self->comment); } #------------------------------------------ sub name() { lc shift->{MMF_name}} sub body() { shift->{MMF_body}} #------------------------------------------ sub comment(;$) { my $self = shift; @_ ? $self->{MMF_comment} = shift : $self->{MMF_comment}; } #------------------------------------------ sub folded(;$) { my $self = shift; if(@_) { return unless defined($self->{MMF_folded} = $_[0]); return @{ (shift) }; } return @{$self->{MMF_folded}} if defined $self->{MMF_folded}; my $comment = $self->{MMF_comment}; $self->{MMF_name} .': ' . $self->{MMF_body} . (defined $comment ? '; '.$comment : '') . "\n"; } #------------------------------------------ #=back #=head1 METHODS for extension writers #=over 4 #=cut #------------------------------------------ sub newNoCheck($$$;$) { my $self = bless {}, shift; @$self{ qw/MMF_name MMF_body MMF_comment MMF_folded/ } = @_; $self; } #------------------------------------------ =back =head1 SEE ALSO L<Mail::Box-Overview> =head1 AUTHOR Mark Overmeer (F<mailbox@overmeer.net>). All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 VERSION This code is beta, version 2.003. Copyright (c) 2001 Mark Overmeer. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1;