has
parts
=>
sub
{ [] };
sub
new {
my
$self
=
shift
->SUPER::new(
@_
);
$self
->on(
read
=>
sub
{
my
(
$self
,
$chunk
) =
@_
;
$self
->{multipart} .=
$chunk
;
$self
->_parse_multipart;
}
);
return
$self
;
}
sub
body_contains {
my
(
$self
,
$chunk
) =
@_
;
for
my
$part
(@{
$self
->parts}) {
return
1
if
index
(
$part
->build_headers,
$chunk
) >= 0;
return
1
if
$part
->body_contains(
$chunk
);
}
return
;
}
sub
body_size {
my
$self
=
shift
;
my
$content_length
=
$self
->headers->content_length;
return
$content_length
if
$content_length
;
my
$boundary_length
=
length
(
$self
->build_boundary) + 6;
my
$len
= 0;
$len
+=
$boundary_length
- 2;
for
my
$part
(@{
$self
->parts}) {
$len
+=
$part
->header_size;
$len
+=
$part
->body_size;
$len
+=
$boundary_length
;
}
return
$len
;
}
sub
build_boundary {
my
$self
=
shift
;
my
$headers
=
$self
->headers;
my
$type
=
$headers
->content_type ||
''
;
my
$boundary
;
$type
=~ /boundary=
"?([^\s"
]+)"?/i and
$boundary
= $1;
return
$boundary
if
$boundary
;
my
$size
= 1;
while
(1) {
$boundary
= b64_encode
join
(
''
,
map
chr
(
rand
(256)), 1 ..
$size
* 3);
$boundary
=~ s/\W/X/g;
last
unless
$self
->body_contains(
$boundary
);
$size
++;
}
$type
=~ m
my
$before
= $1 ||
'multipart/mixed'
;
my
$after
= $2 ||
''
;
$headers
->content_type(
"$before; boundary=$boundary$after"
);
return
$boundary
;
}
sub
clone {
my
$self
=
shift
;
return
unless
my
$clone
=
$self
->SUPER::clone();
return
$clone
->parts(
$self
->parts);
}
sub
get_body_chunk {
my
(
$self
,
$offset
) =
@_
;
return
$self
->generate_body_chunk(
$offset
)
if
$self
->{dynamic};
my
$boundary
=
$self
->build_boundary;
my
$boundary_length
=
length
(
$boundary
) + 6;
my
$len
=
$boundary_length
- 2;
return
substr
"--$boundary\x0d\x0a"
,
$offset
if
$len
>
$offset
;
my
$parts
=
$self
->parts;
for
(
my
$i
= 0;
$i
<
@$parts
;
$i
++) {
my
$part
=
$parts
->[
$i
];
my
$header_length
=
$part
->header_size;
return
$part
->get_header_chunk(
$offset
-
$len
)
if
(
$len
+
$header_length
) >
$offset
;
$len
+=
$header_length
;
my
$content_length
=
$part
->body_size;
return
$part
->get_body_chunk(
$offset
-
$len
)
if
(
$len
+
$content_length
) >
$offset
;
$len
+=
$content_length
;
if
((
$len
+
$boundary_length
) >
$offset
) {
return
substr
"\x0d\x0a--$boundary--"
,
$offset
-
$len
if
$
return
substr
"\x0d\x0a--$boundary\x0d\x0a"
,
$offset
-
$len
;
}
$len
+=
$boundary_length
;
}
}
sub
is_multipart {1}
sub
_parse_multipart {
my
$self
=
shift
;
$self
->{multi_state} ||=
'multipart_preamble'
;
my
$boundary
=
$self
->boundary;
while
(!
$self
->is_finished) {
if
((
$self
->{multi_state} ||
''
) eq
'multipart_preamble'
) {
last
unless
$self
->_parse_multipart_preamble(
$boundary
);
}
elsif
((
$self
->{multi_state} ||
''
) eq
'multipart_boundary'
) {
last
unless
$self
->_parse_multipart_boundary(
$boundary
);
}
elsif
((
$self
->{multi_state} ||
''
) eq
'multipart_body'
) {
last
unless
$self
->_parse_multipart_body(
$boundary
);
}
}
}
sub
_parse_multipart_body {
my
(
$self
,
$boundary
) =
@_
;
my
$pos
=
index
$self
->{multipart},
"\x0d\x0a--$boundary"
;
if
(
$pos
< 0) {
my
$len
=
length
(
$self
->{multipart}) - (
length
(
$boundary
) + 8);
return
unless
$len
> 0;
my
$chunk
=
substr
$self
->{multipart}, 0,
$len
,
''
;
$self
->parts->[-1] =
$self
->parts->[-1]->parse(
$chunk
);
return
;
}
my
$chunk
=
substr
$self
->{multipart}, 0,
$pos
,
''
;
$self
->parts->[-1] =
$self
->parts->[-1]->parse(
$chunk
);
return
$self
->{multi_state} =
'multipart_boundary'
;
}
sub
_parse_multipart_boundary {
my
(
$self
,
$boundary
) =
@_
;
if
((
index
$self
->{multipart},
"\x0d\x0a--$boundary\x0d\x0a"
) == 0) {
substr
$self
->{multipart}, 0,
length
(
$boundary
) + 6,
''
;
my
$part
= Mojo::Content::Single->new(
relaxed
=> 1);
$self
->emit(
part
=>
$part
);
push
@{
$self
->parts},
$part
;
return
$self
->{multi_state} =
'multipart_body'
;
}
my
$end
=
"\x0d\x0a--$boundary--"
;
if
((
index
$self
->{multipart},
$end
) == 0) {
substr
$self
->{multipart}, 0,
length
$end
,
''
;
$self
->{state} =
$self
->{multi_state} =
'finished'
;
}
return
;
}
sub
_parse_multipart_preamble {
my
(
$self
,
$boundary
) =
@_
;
my
$pos
=
index
$self
->{multipart},
"--$boundary"
;
unless
(
$pos
< 0) {
substr
$self
->{multipart}, 0,
$pos
,
"\x0d\x0a"
;
return
$self
->{multi_state} =
'multipart_boundary'
;
}
return
;
}
1;