view release on metacpan or  search on metacpan

lib/MIME/Structure.pm  view on Meta::CPAN

    # We're all done reading
    if (@context) {
        die "Unfinished parts!";
    }
    $message->{'content_length'} = $ofs - $message->{'body_offset'};
    $message->{'length'} = $ofs;
    
    return wantarray ? @entities : $message;
}

# --- Reporting

sub concise_structure {
    my ($self, $message) = @_;
    # (text/plain:0)
    # (multipart/mixed:0 (text/plain:681) (image/gif:774))
    my $visitor;
    $visitor = sub {
        my ($entity) = @_;
        my $type = $entity->{'type'};
        my $subtype = $entity->{'subtype'};
        my $number = $entity->{'number'};
        my $ofs  = $entity->{'offset'};
        if ($type eq 'multipart') {
            my $str = "($number $type/$subtype:$ofs";
            $str .= ' ' . $visitor->($_) for @{ $entity->{'parts'} };
            return $str . ')';
        }
        else {
            return "($number $type/$subtype:$ofs)";
        }
    };
    $visitor->($message);
}

# --- Utility functions

sub parse_header {
    my ($self, $str) = @_;
    #my $str = $$hdrref;
    $str =~ s/\n(?=[ \t])//g;
    my @fields;
    while ($str =~ /(.+)/g) {
        push @fields, [split /:\s+/, $1, 2];
    }
    return fields2hash(\@fields);
}

sub fields2hash {
    my ($F) = @_;
    my %F;
    foreach (@$F) {
        my ($name, $value) = @$_;
        push @{ $F{lc $name} ||= [] }, $value;
    }
    return \%F;
}

sub parse_content_type {
    my ($str) = @_;
    my ($type, $subtype, $params_str) = split m{/|;\s*}, $str, 3;
    return (lc $type, lc $subtype, parse_params($params_str));
}

sub parse_params {
    my ($str) = @_;
    $str = '' unless defined $str;
    my %param;
    while ($str =~ s/^([^\s=]+)=//) {
        my $name = lc $1;
        if ($str =~ /^"/) {
            my $value = extract_delimited($str, q{"}, '');
            $value =~ s/^"|"$//g;
            $value =~ s/\\(.)|([^\\"]+)|(.)/$+/g;
            $param{$name} = $value;
            # 
        }
        elsif ($str =~ s/^([^\s()<>@,;:\\"\/\[\]?=]+)//) {
            $param{$name} = $1;
        }
        else {
            die "Bad params: $str";
        }
        die "Bad params: $str" unless $str =~ s/^(\s*;\s*|\s*$)//;
    }
    return \%param;
}


1;

=pod

=head1 NAME

MIME::Structure - determine structure of MIME messages

=head1 SYNOPSIS

    use MIME::Structure;
    $parser = MIME::Structure->new;
    $message = $parser->parse($filehandle);
    print $message->{'header'};
    $parts = $message->{'parts'};
    foreach ($parts) {
        $offset  = $_->{'offset'};
        $type    = $_->{'type'};
        $subtype = $_->{'subtype'};
        $line    = $_->{'line'};
        $header  = $_->{'header'};
    }
    print $parser->concise_structure($message), "\n";

=cut

=head1 METHODS

=over 4

=item B<new>