view release on metacpan or search on metacpan
share/mime-info/freedesktop.org.xml view on Meta::CPAN
<match type="string" value="BSDIFN40" offset="0"/>
</magic>
<glob pattern="*.bsdiff"/>
</mime-type>
<!-- Tree content-types -->
<mime-type type="x-content/image-dcf">
<!-- http://en.wikipedia.org/wiki/Design_rule_for_Camera_File_system -->
<comment>Digital photos</comment>
<treemagic>
<treematch path="dcim" type="directory" non-empty="true"/>
view all matches for this distribution
view release on metacpan or search on metacpan
t/10_expander.t view on Meta::CPAN
is( MIME::Expander->regulate_type('text/plain'), 'text/plain', 'regulate_type normal');
is( MIME::Expander->regulate_type('text/x-me'), 'text/me', 'regulate_type unregistered');
is( MIME::Expander->regulate_type('x-media/x-type'), 'media/type', 'regulate_type unregistered');
is( MIME::Expander->regulate_type(), undef, 'regulate_type undef');
is( MIME::Expander->regulate_type('a'), undef, 'regulate_type invalid');
is( MIME::Expander->regulate_type('text/plain; charset=UTF-8'), 'text/plain', 'regulate_type content-type');
}
# regulate_type (via instance)
{;
t/10_expander.t view on Meta::CPAN
is( $me->regulate_type('text/plain'), 'text/plain', 'regulate_type normal');
is( $me->regulate_type('text/x-me'), 'text/me', 'regulate_type unregistered');
is( $me->regulate_type('x-media/x-type'), 'media/type', 'regulate_type unregistered');
is( $me->regulate_type(), undef, 'regulate_type undef');
is( $me->regulate_type('a'), undef, 'regulate_type invalid');
is( $me->regulate_type('text/plain; charset=UTF-8'), 'text/plain', 'regulate_type content-type');
}
# walk
# => 11_expander_walk.t
view all matches for this distribution
view release on metacpan or search on metacpan
$VERSION = '0.39';
use constant BUFFSIZE => 64;
my %h_hash = (
'content-type' => "",
'content-disposition' => "",
'content-transfer-encoding' => "",
);
my @patterns = (
}
next;
}
next if(!$checkhdr && (length() <= 2) && /$patterns[2]/o);
$header = 0;
if(exists($_[0]->{$tree}->{'content-type'}) && exists($_[0]->{$tree}->{'content-type'}->{value})) {
$_[0]->{$tree}->{'content-type'}->{value} = lc($_[0]->{$tree}->{'content-type'}->{value});
if(exists($_[0]->{$tree}->{'content-type'}->{boundary}) && $_[0]->{$tree}->{'content-type'}->{value} =~ /multipart\/\w+/o) {
my $res = &_parse($fhs, $header, $mbox, $tree, $_[0]->{$tree}->{'content-type'}->{boundary}, $args, $files, $_[0]);
if($res->[1]) {
$mbox ? ($tmp = 1) : return([$tree, $res->[1]]);
$_ = $res->[1];
} else { next; }
} elsif($_[0]->{$tree}->{'content-type'}->{value} eq "message/rfc822") {
my $res = &_parse($fhs, 1, $mbox, $tree, $origin, $args, $files, $_[0]);
if($res->[1]) {
$mbox ? ($tmp = 1) : return([$tree, $res->[1]]);
$_ = $res->[1];
} else { next; }
{
action => $args->{'types_action'},
mimetypes => $args->{'ctypes'}
}
);
$_[0]->{"$tree.$attcount"}->{'content-type'}->{value} = $res->[0];
$_[0]->{"$tree.$attcount"}->{'content-disposition'}->{filepath} = $filepath unless($res->[1]);
$attcount++;
next;
}
my $breakmsg = "";
unless(defined($fh)) {
$boundary = $origin;
if(exists($_[0]->{$tree}->{'content-type'}) && exists($_[0]->{$tree}->{'content-type'}->{value})) {
$exclude = 1 if(($_[0]->{$tree}->{'content-type'}->{value} =~ /^multipart\/\w+$/o) || ($_[0]->{$tree}->{'content-type'}->{value} eq "message/rfc822"));
} else { $check_ctype = 1; }
unless($exclude) {
if(exists($_[0]->{$tree}->{'content-transfer-encoding'}) &&
exists($_[0]->{$tree}->{'content-transfer-encoding'}->{value})) {
$_[0]->{$tree}->{'content-transfer-encoding'}->{value} = lc($_[0]->{$tree}->{'content-transfer-encoding'}->{value});
my $res = &decode_content($fhs,
$_[0]->{$tree}->{'content-transfer-encoding'}->{value},
$filepath,
$boundary ? "--$boundary" : "",
{
mimetype => $_[0]->{$tree}->{'content-type'}->{value} || "",
checktype => $args->{'check_ctype'},
action => $args->{'types_action'},
mimetypes => $args->{'ctypes'},
mailbox => $mbox
});
$_[0]->{$tree}->{'content-type'}->{value} = $res->[1] if($res->[1]);
$_[0]->{$tree}->{'content-disposition'}->{filepath} = $filepath unless($res->[2]);
$tmp = 1;
unless($_ = $res->[0]) {
$exclude = 1;
next;
if(index($_, "--$boundary") >= 0) {
defined($fh) and &file_close($fh);
($tmp, $header) = (1, 1);
$boundary = "";
if($ph) {
return([$tree]) if($_[0]->{$base}->{'content-type'}->{value} eq "message/rfc822");
my @ps = split(/\./o, $tree);
$ps[$#ps]++;
$tree = join("\.", @ps);
}
next;
}
(!$exclude && $ph) or next;
if($check_ctype && $args->{check_ctype}) {
($tmpbuff .= $_) =~ s/^[\n\r\t]+//o;
if(length($tmpbuff) > BUFFSIZE) {
$_[0]->{$tree}->{'content-type'}->{value} ||= "";
if(my $ct = set_content_type($tmpbuff, $_[0]->{$tree}->{'content-type'}->{value})) {
$_[0]->{$tree}->{'content-type'}->{value} = $ct;
$tmpbuff = "";
$check_ctype = 0;
}
if($exclude = exists($args->{'ctypes'}->{$_[0]->{$tree}->{'content-type'}->{value}}) ? ($args->{'types_action'} ? 0 : 1) :
scalar(keys(%{$args->{'ctypes'}})) ? ($args->{'types_action'} ? 1 : 0) : ($args->{'types_action'} ? 0 : 1)) {
if(defined($fh)) {
&file_close($fh);
unlink($_[0]->{$tree}->{'content-disposition'}->{filepath});
delete($_[0]->{$tree}->{'content-disposition'}->{filepath});
my $h = shift;
my $file = "file";
if(exists($h->{'content-disposition'}->{filename})) {
$file = $h->{'content-disposition'}->{filename};
} elsif(exists($h->{'content-type'}->{name})) {
$file = $h->{'content-type'}->{name};
} elsif(exists($h->{'content-type'}->{value})) {
my $ctype = lc($h->{'content-type'}->{value});
$file .= $content_type{$ctype} || "";
}
$file =~ s/^[ \.]+$/file/o;
$h->{'content-disposition'}->{filename} = &check_filename($files, $file);
$h->{'content-transfer-encoding'}->{value} = "" unless(exists($h->{'content-transfer-encoding'}->{value}));
If the value is set to octal number then make the output_dir directory
(example: mkdir => 0755).
=item check_content_type => 0 or 1
If the value is set to 1 the content-type of file is checked
=item decode_subject => 0 or 1
If the value is set to 1 then the subject is decoded into a list.
view all matches for this distribution
view release on metacpan or search on metacpan
=item I<new> ()
=item I<new> (subtype = "mixed")
Class method.
Creates a new MIME::Fast::MultiPart object with a default content-type of
multipart/mixed.
=item I<set_preface> (text)
=item I<get_preface> ()
=item I<set_content_type_parameter> ($name, $value)
=item I<get_content_type_parameter> ($name)
Sets or gets the value of the content-type param $name set on the MIME part object.
=item I<set_content_id> (content_id)
=item I<get_content_id> ()
=over 4
=item I<new> (subtype = "rfc822" [, message])
Creates a new MIME message part object with a default content-type
of message/$subtype (optionally containing $message object).
=item I<set_message> (message)
=item I<get_message> ()
view all matches for this distribution
view release on metacpan or search on metacpan
lib/MIME/Lite/Generator.pm view on Meta::CPAN
my $sub_attrs = $self->{msg}{SubAttrs};
my $rv;
$self->{state} = 'first';
### Output either the body or the parts.
### Notice that we key off of the content-type! We expect fewer
### accidents that way, since the syntax will always match the MIME type.
my $type = $attrs->{'content-type'};
if ( $type =~ m{^multipart/}i ) {
$self->{boundary} = $sub_attrs->{'content-type'}{'boundary'};
### Preamble:
$rv = \($self->{msg}->header_as_string . "\n" . (
defined( $self->{msg}{Preamble} )
? $self->{msg}{Preamble}
view all matches for this distribution
view release on metacpan or search on metacpan
my $ref = ($txt || @$ref_mail) ? {} : $self->{_param};
$part = new MIME::Lite(%$ref,
'Type' => 'TEXT',
'Encoding' => $self->{_htmlencoding},
'Data' => $html);
$part->attr("content-type"=> "text/html; charset=".$self->{_htmlcharset});
# Remove some header for Eudora client in HTML and related part
$part->replace("MIME-Version" => "");
$part->replace('X-Mailer' =>"");
$part->replace('Content-Disposition' =>"");
# only html, no images & no txt
my $ref = ($html ? {} : $self->{_param} );
$txt_part = new MIME::Lite (%$ref,
'Type' => 'TEXT',
'Data' => $txt,
'Encoding' => $self->{_textencoding});
$txt_part->attr("content-type" =>
"text/plain; charset=".$self->{_textcharset});
# Remove some header for Eudora client
$txt_part->replace("MIME-Version" => "");
$txt_part->replace("X-Mailer" => "");
$txt_part->replace("Content-Disposition" => "");
view all matches for this distribution
view release on metacpan or search on metacpan
lib/MIME/Lite.pm view on Meta::CPAN
#pod $part = MIME::Lite->new(
#pod Top => 0,
#pod Type =>'text/html',
#pod Data =>'<H1>Hello</H1>',
#pod );
#pod $part->attr('content-type.charset' => 'UTF-8');
#pod $part->add('X-Comment' => 'A message for you');
#pod
#pod ### Attach it to any message:
#pod $msg->attach($part);
#pod
lib/MIME/Lite.pm view on Meta::CPAN
#pod method assumes that you are giving in the pairs of a PARAMHASH
#pod which will be sent into C<new()> to create the new part.
#pod
#pod One of the possibly-quite-useful hacks thrown into this is the
#pod "attach-to-singlepart" hack: if you attempt to attach a part (let's
#pod call it "part 1") to a message that doesn't have a content-type
#pod of "multipart" or "message", the following happens:
#pod
#pod =over 4
#pod
#pod =item *
lib/MIME/Lite.pm view on Meta::CPAN
### Create new part, if necessary:
my $part1 = ( ( @_ == 1 ) ? shift: ref($self)->new( Top => 0, @_ ) );
### Do the "attach-to-singlepart" hack:
if ( $attrs->{'content-type'} !~ m{^(multipart|message)/}i ) {
### Create part zero:
my $part0 = ref($self)->new;
### Cut MIME stuff from self, and paste into part zero:
lib/MIME/Lite.pm view on Meta::CPAN
$part0->top_level(0); ### clear top-level attributes
### Make self a top-level multipart:
$attrs = $self->{Attrs} ||= {}; ### reset (sam: bug? this doesn't reset anything since Attrs is already a hash-ref)
$sub_attrs = $self->{SubAttrs} ||= {}; ### reset
$attrs->{'content-type'} = 'multipart/mixed';
$sub_attrs->{'content-type'}{'boundary'} = gen_boundary();
$attrs->{'content-transfer-encoding'} = '7bit';
$self->top_level(1); ### activate top-level attributes
### Add part 0:
push @{ $self->{Parts} }, $part0;
lib/MIME/Lite.pm view on Meta::CPAN
### CONTENT-TYPE....
###
### Get content-type or content-type-macro:
my $type = ( $params{Type} || ( $AUTO_CONTENT_TYPE ? 'AUTO' : 'TEXT' ) );
### Interpret content-type-macros:
if ( $type eq 'TEXT' ) { $type = 'text/plain'; }
elsif ( $type eq 'HTML' ) { $type = 'text/html'; }
elsif ( $type eq 'BINARY' ) { $type = 'application/octet-stream' }
elsif ( $type eq 'AUTO' ) { $type = $self->suggest_type( $params{Path} ); }
### We now have a content-type; set it:
$type = lc($type);
my $attrs = $self->{Attrs};
my $sub_attrs = $self->{SubAttrs};
$attrs->{'content-type'} = $type;
### Get some basic attributes from the content type:
my $is_multipart = ( $type =~ m{^(multipart)/}i );
### Add in the multipart boundary:
if ($is_multipart) {
my $boundary = gen_boundary();
$sub_attrs->{'content-type'}{'boundary'} = $boundary;
}
### CONTENT-ID...
###
lib/MIME/Lite.pm view on Meta::CPAN
#pod I<Instance method.>
#pod Set MIME attribute ATTR to the string VALUE.
#pod ATTR is converted to all-lowercase.
#pod This method is normally used to set/get MIME attributes:
#pod
#pod $msg->attr("content-type" => "text/html");
#pod $msg->attr("content-type.charset" => "US-ASCII");
#pod $msg->attr("content-type.name" => "homepage.html");
#pod
#pod This would cause the final output to look something like this:
#pod
#pod Content-type: text/html; charset=US-ASCII; name="homepage.html"
#pod
lib/MIME/Lite.pm view on Meta::CPAN
#pod Giving VALUE as undefined will cause the contents of the named
#pod subfield to be deleted.
#pod
#pod Supplying no VALUE argument just returns the attribute's value:
#pod
#pod $type = $msg->attr("content-type"); ### returns "text/html"
#pod $name = $msg->attr("content-type.name"); ### returns "homepage.html"
#pod
#pod =cut
sub attr {
lib/MIME/Lite.pm view on Meta::CPAN
#pod =item field_order FIELD,...FIELD
#pod
#pod I<Class/instance method.>
#pod Change the order in which header fields are output for this object:
#pod
#pod $msg->field_order('from', 'to', 'content-type', 'subject');
#pod
#pod When used as a class method, changes the default settings for
#pod all objects:
#pod
#pod MIME::Lite->field_order('from', 'to', 'content-type', 'subject');
#pod
#pod Case does not matter: all field names will be coerced to lowercase.
#pod In either case, supply the empty array to restore the default ordering.
#pod
#pod =cut
lib/MIME/Lite.pm view on Meta::CPAN
sub filename {
my ( $self, $filename ) = @_;
my $sub_attrs = $self->{SubAttrs};
if ( @_ > 1 ) {
$sub_attrs->{'content-type'}{'name'} = $filename;
$sub_attrs->{'content-disposition'}{'filename'} = $filename;
}
return $sub_attrs->{'content-disposition'}{'filename'};
}
lib/MIME/Lite.pm view on Meta::CPAN
# and given the performance cost of calculating it from a file handle,
# I thought it might make more sense to add some sort of computelength
# property. If computelength is false, then the length simply isn't
# computed. What do you think?
#
# Eryq's reply: I agree; for now, we can silently leave out the content-type.
sub get_length {
my $self = shift;
my $attrs = $self->{Attrs};
my $is_multipart = ( $attrs->{'content-type'} =~ m{^multipart/}i );
my $enc = lc( $attrs->{'content-transfer-encoding'} || 'binary' );
my $length;
if ( !$is_multipart && ( $enc eq "binary" ) ) { ### might figure it out cheap:
if ( defined( $self->{Data} ) ) { ### it's in core
$length = length( $self->{Data} );
lib/MIME/Lite.pm view on Meta::CPAN
if ( !@a ) { ### guess
### Scrub length always:
$self->replace( 'content-length', '' );
### Scrub disposition if no filename, or if content-type has same info:
if ( !$self->_safe_attr('content-disposition.filename')
|| $self->_safe_attr('content-type.name') )
{
$self->replace( 'content-disposition', '' );
}
### Scrub encoding if effectively unencoded:
if ( $self->_safe_attr('content-transfer-encoding') =~ /^(7bit|8bit|binary)$/i ) {
$self->replace( 'content-transfer-encoding', '' );
}
### Scrub charset if US-ASCII:
if ( $self->_safe_attr('content-type.charset') =~ /^(us-ascii)/i ) {
$self->attr( 'content-type.charset' => undef );
}
### TBD: this is not really right for message/digest:
if ( ( keys %{ $self->{Attrs}{'content-type'} } == 1 )
and ( $self->_safe_attr('content-type') eq 'text/plain' ) )
{
$self->replace( 'content-type', '' );
}
} elsif ( $expl and ( ref($expl) eq 'ARRAY' ) ) {
foreach ( @{$expl} ) { $self->replace( $_, '' ); }
}
lib/MIME/Lite.pm view on Meta::CPAN
sub binmode {
my $self = shift;
$self->{Binmode} = shift if (@_); ### argument? set override
return ( defined( $self->{Binmode} )
? $self->{Binmode}
: ( $self->{Attrs}{"content-type"} !~ m{^(text|message)/}i )
);
}
#------------------------------
lib/MIME/Lite.pm view on Meta::CPAN
#------------------------------
#
# =item suggest_type PATH
#
# I<Class/instance method.>
# Suggest the content-type for this attached path.
# We always fall back to "application/octet-stream" if no good guess
# can be made, so don't use this if you don't mean it!
#
sub suggest_type {
my ( $self, $path ) = @_;
lib/MIME/Lite.pm view on Meta::CPAN
### Coerce into a printable output handle:
$out = MIME::Lite::IO_Handle->wrap($out);
### Output either the body or the parts.
### Notice that we key off of the content-type! We expect fewer
### accidents that way, since the syntax will always match the MIME type.
my $type = $attrs->{'content-type'};
if ( $type =~ m{^multipart/}i ) {
my $boundary = $sub_attrs->{'content-type'}{'boundary'};
### Preamble:
$out->print( defined( $self->{Preamble} )
? $self->{Preamble}
: "This is a multi-part message in MIME format.\n"
lib/MIME/Lite.pm view on Meta::CPAN
$part = MIME::Lite->new(
Top => 0,
Type =>'text/html',
Data =>'<H1>Hello</H1>',
);
$part->attr('content-type.charset' => 'UTF-8');
$part->add('X-Comment' => 'A message for you');
### Attach it to any message:
$msg->attach($part);
lib/MIME/Lite.pm view on Meta::CPAN
method assumes that you are giving in the pairs of a PARAMHASH
which will be sent into C<new()> to create the new part.
One of the possibly-quite-useful hacks thrown into this is the
"attach-to-singlepart" hack: if you attempt to attach a part (let's
call it "part 1") to a message that doesn't have a content-type
of "multipart" or "message", the following happens:
=over 4
=item *
lib/MIME/Lite.pm view on Meta::CPAN
I<Instance method.>
Set MIME attribute ATTR to the string VALUE.
ATTR is converted to all-lowercase.
This method is normally used to set/get MIME attributes:
$msg->attr("content-type" => "text/html");
$msg->attr("content-type.charset" => "US-ASCII");
$msg->attr("content-type.name" => "homepage.html");
This would cause the final output to look something like this:
Content-type: text/html; charset=US-ASCII; name="homepage.html"
lib/MIME/Lite.pm view on Meta::CPAN
Giving VALUE as undefined will cause the contents of the named
subfield to be deleted.
Supplying no VALUE argument just returns the attribute's value:
$type = $msg->attr("content-type"); ### returns "text/html"
$name = $msg->attr("content-type.name"); ### returns "homepage.html"
=item delete TAG
I<Instance method.>
Delete field TAG with the given VALUE to the end of the header.
lib/MIME/Lite.pm view on Meta::CPAN
=item field_order FIELD,...FIELD
I<Class/instance method.>
Change the order in which header fields are output for this object:
$msg->field_order('from', 'to', 'content-type', 'subject');
When used as a class method, changes the default settings for
all objects:
MIME::Lite->field_order('from', 'to', 'content-type', 'subject');
Case does not matter: all field names will be coerced to lowercase.
In either case, supply the empty array to restore the default ordering.
=item fields
lib/MIME/Lite.pm view on Meta::CPAN
=over 4
=item Content-type
You can safely scrub the "content-type" attribute if, and only if,
the part is of type "text/plain" with charset "us-ascii".
=item Content-transfer-encoding
You can safely scrub the "content-transfer-encoding" attribute
lib/MIME/Lite.pm view on Meta::CPAN
=item Content-disposition
You can safely scrub the "content-disposition" attribute
if you trust the mail reader to do the right thing when it decides
whether to show an attachment inline or as a link. Be aware
that scrubbing both the content-disposition and the content-type
means that there is no way to "recommend" a filename for the attachment!
B<Note:> there are reports of brain-dead MUAs out there that
do the wrong thing if you I<provide> the content-disposition.
If your attachments keep showing up inline or vice-versa,
lib/MIME/Lite.pm view on Meta::CPAN
From => 'me@myhost.com',
To => encode( 'MIME-Header', $to ),
Subject => encode( 'MIME-Header', $subject ),
Data => encode_utf8($text)
);
$msg->attr( 'content-type' => 'text/plain; charset=utf-8' );
$msg->send;
B<Note:>
=over
lib/MIME/Lite.pm view on Meta::CPAN
=item *
If, for the body of the email, you want to use a character set
other than UTF-8, then you should encode appropriately, and set the
correct C<content-type>, eg:
...
Data => encode('iso-8859-15',$text)
...
$msg->attr( 'content-type' => 'text/plain; charset=iso-8859-15' );
=item *
For the message headers, L<Encode::MIME::Header> only support UTF-8,
but most modern mail clients should be able to handle this. It is not
lib/MIME/Lite.pm view on Meta::CPAN
#pod
#pod =over 4
#pod
#pod =item Content-type
#pod
#pod You can safely scrub the "content-type" attribute if, and only if,
#pod the part is of type "text/plain" with charset "us-ascii".
#pod
#pod =item Content-transfer-encoding
#pod
#pod You can safely scrub the "content-transfer-encoding" attribute
lib/MIME/Lite.pm view on Meta::CPAN
#pod =item Content-disposition
#pod
#pod You can safely scrub the "content-disposition" attribute
#pod if you trust the mail reader to do the right thing when it decides
#pod whether to show an attachment inline or as a link. Be aware
#pod that scrubbing both the content-disposition and the content-type
#pod means that there is no way to "recommend" a filename for the attachment!
#pod
#pod B<Note:> there are reports of brain-dead MUAs out there that
#pod do the wrong thing if you I<provide> the content-disposition.
#pod If your attachments keep showing up inline or vice-versa,
lib/MIME/Lite.pm view on Meta::CPAN
#pod From => 'me@myhost.com',
#pod To => encode( 'MIME-Header', $to ),
#pod Subject => encode( 'MIME-Header', $subject ),
#pod Data => encode_utf8($text)
#pod );
#pod $msg->attr( 'content-type' => 'text/plain; charset=utf-8' );
#pod $msg->send;
#pod
#pod B<Note:>
#pod
#pod =over
lib/MIME/Lite.pm view on Meta::CPAN
#pod
#pod =item *
#pod
#pod If, for the body of the email, you want to use a character set
#pod other than UTF-8, then you should encode appropriately, and set the
#pod correct C<content-type>, eg:
#pod
#pod ...
#pod Data => encode('iso-8859-15',$text)
#pod ...
#pod
#pod $msg->attr( 'content-type' => 'text/plain; charset=iso-8859-15' );
#pod
#pod =item *
#pod
#pod For the message headers, L<Encode::MIME::Header> only support UTF-8,
#pod but most modern mail clients should be able to handle this. It is not
view all matches for this distribution
view release on metacpan or search on metacpan
lib/MIME/Mini.pm view on Meta::CPAN
sub formail # rfc2822 + mboxrd format (see http://www.qmail.org/man/man5/mbox.html)
{
sub mime # rfc2045, rfc2046
{
my ($mail, $parent) = @_;
return $mail unless exists $mail->{header} && exists $mail->{header}->{'content-type'} || defined $parent && exists $parent->{mime_type} && $parent->{mime_type} =~ /^multipart\/digest$/i;
my ($content_type) = (exists $mail->{header} && exists $mail->{header}->{'content-type'}) ? @{$mail->{header}->{'content-type'}} : "Content-Type: message/rfc822\n";
my ($type) = $content_type =~ /^content-type:\s*([\w\/.-]+)/i;
my $boundary = param($mail, 'content-type', 'boundary') if $type =~ /^multipart\//i;
return $mail unless defined $type && ($type =~ /^multipart\//i && $boundary || $type =~ /^message\/rfc822$/i);
($mail->{mime_boundary}) = $boundary =~ /^(.*\S)/ if $boundary;
$mail->{mime_type} = $type;
$mail->{mime_message} = mimepart(delete $mail->{body} || '', $mail), return $mail if $type =~ /^message\/(?:rfc822|external-body)$/i;
return tnef2mime(mimeparts($mail, $parent));
lib/MIME/Mini.pm view on Meta::CPAN
sub mimetype # rfc2045, rfc2046
{
my ($m, $p) = @_;
my ($e) = header($m, 'content-transfer-encoding');
return 'application/octet-stream' if defined $e && $e !~ /^(?:[78]bit|binary|quoted-printable|base64)$/i;
my ($type) = header($m, 'content-type');
return lc $1 if defined $type && $type =~ /^((?:text|image|audio|video|application|message|multipart)\/[^\s;]+)/i;
return 'message/rfc822' if !defined $type && defined $p && exists $p->{mime_type} && $p->{mime_type} =~ /^multipart\/digest/i;
return 'text/plain';
}
lib/MIME/Mini.pm view on Meta::CPAN
my $filename_counter;
sub filename # rfc2183, rfc2045?
{
my $p = shift;
my $fn = param($p, 'content-disposition', 'filename') || param($p, 'content-type', 'name') || 'attachment' . ++$filename_counter;
$fn =~ s/^.*[\\\/]//, $fn =~ tr/\x00-\x1f !"#\$%&'()*\/:;<=>?@[\\]^`{|}~\x7f/_/s;
return $fn;
}
sub body
view all matches for this distribution
view release on metacpan or search on metacpan
lib/MIME/Signature.pm view on Meta::CPAN
our %EXPORT_TAGS = ();
sub _decoded_body {
my $entity = shift;
my $body = $entity->bodyhandle->as_string;
if ( my $charset = $entity->head->mime_attr('content-type.charset') ) {
$body = decode $charset, $body;
}
$body;
}
lib/MIME/Signature.pm view on Meta::CPAN
my ( $entity, $body ) = @_;
$body .= "\n" if $body !~ /\n\z/;
my $encoded_body;
{
my $encoding_ok;
if ( my $charset = $entity->head->mime_attr('content-type.charset') ) {
$encoding_ok = 1;
$encoded_body = encode $charset, $body,
sub { undef $encoding_ok; '' };
}
unless ($encoding_ok) {
my $head = $entity->head;
$head->mime_attr( 'Content-Type', 'text/plain' )
unless $head->mime_attr('content-type');
$head->mime_attr( 'content-type.charset' => 'UTF-8' );
$encoded_body = encode_utf8($body);
}
}
my $fh = $entity->bodyhandle->open('w') or die "Open body: $!\n";
view all matches for this distribution