view release on metacpan or  search on metacpan

lib/Tie/Eudora.pm  view on Meta::CPAN

{
    my $event;
    my $self = UNIVERSAL::isa($_[0],'Tie::Layers') ? shift : Tie::Eudora->new();

    my ($fields) = @_;
    unless( $fields ) {
        $event = "No inputs\n";
        goto EVENT;
    }
    my $encoded_fields = '';
    my $body = ${$fields}[-1];
    for( my $i = 0; $i < @$fields - 2; $i += 2) {
        $encoded_fields .= "$fields->[$i]: $fields->[$i+1]\n";
    }
    while( chomp($encoded_fields) ) { };
    $encoded_fields .= "\n\n" . $body;
  
    return \$encoded_fields;

EVENT:
     if($self->{'Tie::Eudora'}->{warn}) {
         warn($event);
     }
     $self->{current_event} .= $event;
     $self->{current_event} .= "\tTie::Eudora::encode_field() $VERSION\n";
     $self->{current_event};
}


##########
# Decode an email record.
#
sub decode_field
{ 
    my $event;
    my $self = UNIVERSAL::isa($_[0],'Tie::Layers') ? shift : Tie::Eudora->new();
    my $debug = $self->{'Tie::Eudora'}->{options}->{debug};

    ###########
    # Parse the e-mail header and body    
    #    
    my ($encoded_fields) = @_;
    unless( $encoded_fields ) {
        $event = "No inputs\n";
        goto EVENT;
    }
    my ($header,$body) = ${$encoded_fields} =~ /^(.*?\n)\n(.*)$/s;
    if($debug && !$header) {
        $event = "No header.\n";
        goto EVENT;
    } 
    if($debug && !$body) {
        $event = "No Body!\n";
        goto EVENT;
    }
    my @fields = split /^([\w\-]+): */mo, $header;
    if($debug && !@fields) {
        $event = "No header fields\n";
        goto EVENT;
    }
    shift @fields; # cause split makes 1st element empty!
    for( my $i=0; $i < @fields; $i += 2) {
        chomp $fields[$i+1];
    }
    push @fields, ('X-Body',$body);
    return \@fields;

EVENT:
     if($self->{'Tie::Eudora'}->{warn}) {
         warn($event);
     }
     $self->{current_event} .= $event;
     $self->{current_event} .= "\tTie::Eudora::encode_field() $VERSION\n";
     $self->{current_event};
}

###########
###########
# 
# The following code is the record encoding and decoding layer 1
#
##########
##########


#########
# This function un escapes the record separator
#
sub decode_record
{
    my $event;
    my $self = UNIVERSAL::isa($_[0],'Tie::Layers') ? shift : Tie::Eudora->new();

    my ($record) = @_;
    unless( $record ) {
        $event = "No inputs\n";
        goto EVENT;
    }
    my $EMAIL_SEPARATOR = $self->{'Tie::Eudora'}->{options}->{EMAIL_SEPARATOR};
    $$record =~ s/\Q${EMAIL_SEPARATOR}\E$//;
    $$record =~ s/\015\012|\012\015/\012/g;  # replace LFCR or CRLF with a LF
    $$record =~ s/\012|\015/\n/g;   # replace CR or LF with logical \n 
    return $record;

EVENT:
     if($self->{'Tie::Eudora'}->{warn}) {
         warn($event);
     }
     $self->{current_event} .= $event;
     $self->{current_event} .= "\tTie::Form::decode_record() $VERSION\n";
     $self->{current_event};
}



#############
# encode the record
#
sub encode_record
{
    my $event;