/ 
MIME-Structure-0.04
/ MIME::Structure

NAME

MIME::Structure - determine structure of MIME messages

SYNOPSIS

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

METHODS

new
$parser = MIME::Structure->new;
parse
$root = $parser->parse;
root
$parser->parse;
$root = $parser->parse;
keep_header
$keep_header = $parser->keep_header;
$parser->keep_header(1);

Set (or get) whether headers should be remembered during parsing.

unfold_header
$unfold_header = $parser->unfold_header;
$parser->unfold_header(1);

Set (or get) whether headers should be unfolded.

print
$print = $parser->print;
$parser->print($MIME::Structure::PRINT_HEADER | $MIME::Structure::PRINT_BODY);
$parser->print('header,body');

Set (or get) what should be printed. This may be specified either as any of the following symbolic constants, ORed together:

PRINT_NONE =item PRINT_HEADER =item PRINT_BODY =item PRINT_PREAMBLE =item PRINT_EPILOGUE

Or using the following string constants concatenated using any delimiter:

none =item header =item body =item preamble =item epilogue
$print_header = $parser->print_header;
$parser->print_header(1);

Set (or get) whether headers should be printed.

print_body
$print_body = $parser->print_body;
$parser->print_body(1);

Set (or get) whether bodies should be printed.

$print_preamble = $parser->print_preamble;
$parser->print_preamble(1);

Set (or get) whether preambles should be printed.

$print_epilogue = $parser->print_epilogue;
$parser->print_epilogue(1);

Set (or get) whether epilogues should be printed.

concise_structure
$root = $parser->parse;
print $parser->concise_structure;
# e.g., '(multipart/alternative:0 (text/html:291) (text/plain:9044))'

__END__ { # Copied (with minuscule changes) from Email::MIME::ContentType my $tspecials = quotemeta '()<>@,;:\\"/[]?='; my $ct_default = 'text/plain; charset=us-ascii'; my $extract_quoted = qr/(?:\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|\'(?:[^\\\']*(?:\\.[^\\\']*)*)\')/; my $type = qr/[^$tspecials]+/; my $subtype = qr/[^$tspecials]+/; my $params = qr/;.*/;

sub parse_content_type { # XXX This does not take note of RFC2822 comments
    my $ct = shift;

    # If the header isn't there or is empty, give default answer.
    return parse_content_type($ct_default) unless defined $ct and length $ct;

    # It is also recommend (sic.) that this default be assumed when a
    # syntactically invalid Content-Type header field is encountered.
    return parse_content_type($ct_default)
        unless $ct =~ m{^($type)/($subtype)\s*($params)?$};
    return (lc $1, lc $2, _parse_attributes($3));
}

sub _parse_attributes {
    local $_ = shift;
    my $attribs = {};
    while ($_) {
        s/^;//;
        s/^\s+// and next;
        s/\s+$//;
        unless (s/^([^$tspecials]+)=//) {
          # We check for $_'s truth because some mail software generates a
          # Content-Type like this: "Content-Type: text/plain;"
          # RFC 1521 section 3 says a parameter must exist if there is a
          # semicolon.
          carp "Illegal Content-Type parameter $_" if $STRICT_PARAMS or $_;
          return $attribs;
        }
        my $attribute = lc $1;
        my $value = _extract_ct_attribute_value();
        $attribs->{$attribute} = $value;
    }
    return $attribs;
}

sub _extract_ct_attribute_value { # EXPECTS AND MODIFIES $_
    my $value;
    while (length $_) { 
        s/^([^$tspecials]+)// and $value .= $1;
        s/^($extract_quoted)// and do {
            my $sub = $1; $sub =~ s/^["']//; $sub =~ s/["']$//;
            $value .= $sub;
        };
        /^;/ and last;
        /^([$tspecials])/ and do { 
            carp "Unquoted $1 not allowed in Content-Type!"; 
            return;
        }
    }
    return $value;
}
}