File Coverage

blib/lib/Net/IMAP/Client/MsgSummary.pm

Criterion	Covered	Total	%
statement	6	175	3.4
branch	0	54	0.0
condition	0	19	0.0
subroutine	2	46	4.3
pod	38	38	100.0
total	46	332	13.8

package Net::IMAP::Client::MsgSummary;

use Encode ();
use Net::IMAP::Client::MsgAddress ();

sub new {
    my ($class, $data, $part_id, $has_headers) = @_;

    bless my $self = {}, $class;

    if ($part_id) {
        $self->{part_id} = $part_id;
    }

    my $tmp = $data->{BODY};
    if ($tmp) {
        $self->_parse_body($tmp);
    }

    $tmp = $data->{BODYSTRUCTURE};
    if ($tmp) {
        $self->_parse_bodystructure($tmp);
    }

    $tmp = $data->{ENVELOPE};
    if ($tmp) {
        $self->_parse_envelope($tmp);
    }

    $self->{flags} = $data->{FLAGS};
    $self->{internaldate} = $data->{INTERNALDATE};
    $self->{rfc822_size} = $data->{'RFC822.SIZE'};
    $self->{uid} = $data->{UID};

    if ($has_headers) {
        while (my ($key, $val) = each %$data) {
            if ($key =~ /^body(?:\.peek)?\s*\[\s*header\.fields/i) {
                $self->{headers} = $val;
                last;
            }
        }
    }

    return $self;
}

sub _decode {
    my ($str) = @_;
    if (defined($str)) {
        eval { $str = Encode::decode('MIME-Header', $str); };
    }
    return $str;
}

sub type { $_[0]->{type} }

sub subtype { $_[0]->{subtype} }

sub parameters { $_[0]->{parameters} }

sub cid { $_[0]->{cid} }

sub description { _decode($_[0]->{description}) }

sub transfer_encoding { $_[0]->{transfer_encoding} }

sub encoded_size { $_[0]->{encoded_size} }

sub content_type {
    my ($self) = @_;
    if ($self->type) {
        return $self->type . '/' . $self->subtype;
    }
    if ($self->multipart) {
        return 'multipart/' . $self->multipart;
    }
    return undef;
}

sub charset { $_[0]->{parameters}->{charset} }

sub filename {
    my ($self) = @_;
    my $disp = $self->{disposition};
    my $filename;
    if ($disp) {
        while (my ($key, $val) = each %$disp) {
            if (ref($val) eq 'HASH') {
                $filename = $val->{filename};
                last if $filename;
            }
        }
    }
    unless ($filename) {
        $filename = $_[0]->{parameters}->{name};
    }
    return _decode($filename);
}

sub name { _decode($_[0]->{parameters}->{name}) }

sub multipart { $_[0]->{multipart_type} }

sub parts { $_[0]->{parts} }

sub rfc822_size { $_[0]->{rfc822_size} }

sub internaldate { $_[0]->{internaldate} }

sub flags { $_[0]->{flags} }

sub uid { $_[0]->{uid} }

sub part_id { $_[0]->{part_id } }

sub md5 { $_[0]->{md5} }

sub disposition { $_[0]->{disposition} }

sub language { $_[0]->{language} }

# envelope

sub date { $_[0]->{date} }

sub subject { _decode($_[0]->{subject}) }

sub from { $_[0]->{from} }

sub sender { $_[0]->{sender} }

sub reply_to { $_[0]->{reply_to} }

sub to { $_[0]->{to} }

sub cc { $_[0]->{cc} }

sub bcc { $_[0]->{bcc} }

sub in_reply_to { $_[0]->{in_reply_to} }

sub message_id { $_[0]->{message_id} }

sub seq_id { $_[0]->{seq_id} }

sub headers { $_[0]->{headers} }

# utils

sub get_subpart {
    my ($self, $part) = @_;
    foreach my $index (split(/\./, $part)) {
        $self = $self->parts->[$index - 1];
    }
    return $self;
}

my %MT_HAS_ATTACHMENT = ( mixed => 1 );

sub has_attachments {
    my ($self) = @_;
    my $mt = $self->multipart;
    return $mt && $MT_HAS_ATTACHMENT{$mt} ? 1 : 0;
}

sub is_message { $_[0]->content_type eq 'message/rfc822' }

sub message { $_[0]->{message} }

sub _parse_body {
    my ($self, $struct) = @_;

    if (ref($struct->[0]) eq 'ARRAY') {
        my @tmp = @$struct;
        my $multipart = pop @tmp;
        my $part_id = $self->{part_id} || '';
        $part_id .= '.'
          if $part_id;
        my $i = 0;
        @tmp = map { __PACKAGE__->new({ BODY => $_}, $part_id . ++$i) } @tmp;
        $self->{multipart_type} = lc $multipart;
        $self->{parts} = \@tmp;
    } else {
        $self->{type} = lc $struct->[0];
        $self->{subtype} = lc $struct->[1];
        if ($struct->[2]) {
            my %tmp = @{$struct->[2]};
            $self->{parameters} = \%tmp;
        }
        $self->{cid} = $struct->[3];
        $self->{description} = $struct->[4];
        $self->{transfer_encoding} = $struct->[5];
        $self->{encoded_size} = $struct->[6];

        if ($self->is_message && $struct->[7] && $struct->[8]) {
            # continue parsing attached message
            $self->{message} = __PACKAGE__->new({
                ENVELOPE => $struct->[7],
                BODY => $struct->[8],
            });
        }
    }
}

sub _parse_bodystructure {
    my ($self, $struct) = @_;

    if (ref($struct->[0]) eq 'ARRAY') {
        my $multipart;
        my @tmp;
        foreach (@$struct) {
            if (ref($_) eq 'ARRAY') {
                push @tmp, $_;
            } else {
                $multipart = $_;
                last;           # XXX: ignoring the rest (extension data) for now.
            }
        }
        my $part_id = $self->{part_id} || '';
        $part_id .= '.'
          if $part_id;
        my $i = 0;
        @tmp = map { __PACKAGE__->new({ BODYSTRUCTURE => $_}, $part_id . ++$i) } @tmp;
        $self->{multipart_type} = lc $multipart;
        $self->{parts} = \@tmp;
    } else {
        $self->{type} = lc $struct->[0];
        $self->{subtype} = lc $struct->[1];
        my $a = $struct->[2];
        if ($a) {
            __lc_key_in_array($a);
            my %tmp = @$a;
            $self->{parameters} = \%tmp;
        }
        $self->{cid} = $struct->[3];
        $self->{description} = $struct->[4];
        $self->{transfer_encoding} = $struct->[5];
        $self->{encoded_size} = $struct->[6];

        if ($self->is_message && $struct->[7] && $struct->[8]) {
            # continue parsing attached message
            $self->{message} = __PACKAGE__->new({
                ENVELOPE => $struct->[7],
                BODYSTRUCTURE => $struct->[8],
            });
        } elsif ($self->type ne 'text') {
            $self->{md5} = $struct->[7];
            my $a = $struct->[8];
            if ($a) {
                for (my $i = 0; $i < @$a; ++$i) {
                    $a->[$i] = lc $a->[$i];
                    ++$i;
                    if (ref($a->[$i]) eq 'ARRAY') {
                        __lc_key_in_array($a->[$i]);
                        my %foo = @{ $a->[$i] };
                        $a->[$i] = \%foo;
                    }
                }
                my %tmp = @$a;
                $self->{disposition} = \%tmp;
            }
            $self->{language} = $struct->[9];
        }
    }
}

sub __lc_key_in_array {
    my ($a) = @_;
    for (my $i = 0; $i < @$a; $i += 2) {
        $a->[$i] = lc $a->[$i];
    }
}

sub _parse_envelope {
    my ($self, $struct)  = @_;
    $self->{date}        = $struct->[0];
    $self->{subject}     = $struct->[1];
    $self->{from}        = _parse_address($struct->[2]);
    $self->{sender}      = _parse_address($struct->[3]);
    $self->{reply_to}    = _parse_address($struct->[4]);
    $self->{to}          = _parse_address($struct->[5]);
    $self->{cc}          = _parse_address($struct->[6]);
    $self->{bcc}         = _parse_address($struct->[7]);
    $self->{in_reply_to} = $struct->[8];
    $self->{message_id}  = $struct->[9];
}

sub _parse_address {
    my ($adr) = @_;
    if ($adr) {
        $adr = [ map { Net::IMAP::Client::MsgAddress->new($_) } @$adr ];
    }
    return $adr;
}

1;

__END__