1 contributor
package Mojo::Content::MultiPart;
use Mojo::Base 'Mojo::Content';
use Mojo::Util 'b64_encode';
has parts => sub { [] };
sub new {
my $self = shift->SUPER::new(@_);
$self->on(read => \&_read);
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 undef;
}
sub body_size {
my $self = shift;
# Check for existing Content-Lenght header
my $content_len = $self->headers->content_length;
return $content_len if $content_len;
# Calculate length of whole body
my $boundary_len = length($self->build_boundary) + 6;
my $len = $boundary_len - 2;
$len += $_->header_size + $_->body_size + $boundary_len for @{$self->parts};
return $len;
}
sub build_boundary {
my $self = shift;
# Check for existing boundary
if (defined(my $boundary = $self->boundary)) { return $boundary }
# Generate and check boundary
my $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);
}
# Add boundary to Content-Type header
my $headers = $self->headers;
($headers->content_type // '') =~ m!^(.*multipart/[^;]+)(.*)$!;
my $before = $1 || 'multipart/mixed';
my $after = $2 || '';
$headers->content_type("$before; boundary=$boundary$after");
return $boundary;
}
sub clone {
my $self = shift;
return undef unless my $clone = $self->SUPER::clone();
return $clone->parts($self->parts);
}
sub get_body_chunk {
my ($self, $offset) = @_;
# Body generator
return $self->generate_body_chunk($offset) if $self->{dynamic};
# First boundary
my $boundary = $self->build_boundary;
my $boundary_len = length($boundary) + 6;
my $len = $boundary_len - 2;
return substr "--$boundary\x0d\x0a", $offset if $len > $offset;
# Prepare content part by part
my $parts = $self->parts;
for (my $i = 0; $i < @$parts; $i++) {
my $part = $parts->[$i];
# Headers
my $header_len = $part->header_size;
return $part->get_header_chunk($offset - $len)
if ($len + $header_len) > $offset;
$len += $header_len;
# Content
my $content_len = $part->body_size;
return $part->get_body_chunk($offset - $len)
if ($len + $content_len) > $offset;
$len += $content_len;
# Boundary
if (($len + $boundary_len) > $offset) {
# Last boundary
return substr "\x0d\x0a--$boundary--", $offset - $len
if $#{$parts} == $i;
# Middle boundary
return substr "\x0d\x0a--$boundary\x0d\x0a", $offset - $len;
}
$len += $boundary_len;
}
}
sub is_multipart {1}
sub _parse_multipart_body {
my ($self, $boundary) = @_;
# Whole part in buffer
my $pos = index $self->{multipart}, "\x0d\x0a--$boundary";
if ($pos < 0) {
my $len = length($self->{multipart}) - (length($boundary) + 8);
return undef unless $len > 0;
# Store chunk
my $chunk = substr $self->{multipart}, 0, $len, '';
$self->parts->[-1] = $self->parts->[-1]->parse($chunk);
return undef;
}
# Store chunk
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) = @_;
# Boundary begins
if ((index $self->{multipart}, "\x0d\x0a--$boundary\x0d\x0a") == 0) {
substr $self->{multipart}, 0, length($boundary) + 6, '';
# New part
my $part = Mojo::Content::Single->new(relaxed => 1);
$self->emit(part => $part);
push @{$self->parts}, $part;
return !!($self->{multi_state} = 'multipart_body');
}
# Boundary ends
my $end = "\x0d\x0a--$boundary--";
if ((index $self->{multipart}, $end) == 0) {
substr $self->{multipart}, 0, length $end, '';
$self->{multi_state} = 'finished';
}
return undef;
}
sub _parse_multipart_preamble {
my ($self, $boundary) = @_;
# No boundary yet
return undef if (my $pos = index $self->{multipart}, "--$boundary") < 0;
# Replace preamble with carriage return and line feed
substr $self->{multipart}, 0, $pos, "\x0d\x0a";
# Parse boundary
return !!($self->{multi_state} = 'multipart_boundary');
}
sub _read {
my ($self, $chunk) = @_;
$self->{multipart} .= $chunk;
my $boundary = $self->boundary;
until (($self->{multi_state} //= 'multipart_preamble') eq 'finished') {
# Preamble
if ($self->{multi_state} eq 'multipart_preamble') {
last unless $self->_parse_multipart_preamble($boundary);
}
# Boundary
elsif ($self->{multi_state} eq 'multipart_boundary') {
last unless $self->_parse_multipart_boundary($boundary);
}
# Body
elsif ($self->{multi_state} eq 'multipart_body') {
last unless $self->_parse_multipart_body($boundary);
}
}
# Check buffer size
$self->{limit} = $self->{state} = 'finished'
if length($self->{multipart} // '') > $self->max_buffer_size;
}
1;
=encoding utf8
=head1 NAME
Mojo::Content::MultiPart - HTTP multipart content
=head1 SYNOPSIS
use Mojo::Content::MultiPart;
my $multi = Mojo::Content::MultiPart->new;
$multi->parse('Content-Type: multipart/mixed; boundary=---foobar');
my $single = $multi->parts->[4];
=head1 DESCRIPTION
L<Mojo::Content::MultiPart> is a container for HTTP multipart content as
described in RFC 2616.
=head1 EVENTS
L<Mojo::Content::Multipart> inherits all events from L<Mojo::Content> and can
emit the following new ones.
=head2 part
$multi->on(part => sub {
my ($multi, $single) = @_;
...
});
Emitted when a new L<Mojo::Content::Single> part starts.
$multi->on(part => sub {
my ($multi, $single) = @_;
return unless $single->headers->content_disposition =~ /name="([^"]+)"/;
say "Field: $1";
});
=head1 ATTRIBUTES
L<Mojo::Content::MultiPart> inherits all attributes from L<Mojo::Content> and
implements the following new ones.
=head2 parts
my $parts = $multi->parts;
$multi = $multi->parts([]);
Content parts embedded in this multipart content, usually
L<Mojo::Content::Single> objects.
=head1 METHODS
L<Mojo::Content::MultiPart> inherits all methods from L<Mojo::Content> and
implements the following new ones.
=head2 new
my $multi = Mojo::Content::MultiPart->new;
Construct a new L<Mojo::Content::MultiPart> object and subscribe to L</"read">
event with default content parser.
=head2 body_contains
my $bool = $multi->body_contains('foobarbaz');
Check if content parts contain a specific string.
=head2 body_size
my $size = $multi->body_size;
Content size in bytes.
=head2 build_boundary
my $boundary = $multi->build_boundary;
Generate a suitable boundary for content and add it to C<Content-Type> header.
=head2 clone
my $clone = $multi->clone;
Clone content if possible, otherwise return C<undef>.
=head2 get_body_chunk
my $bytes = $multi->get_body_chunk(0);
Get a chunk of content starting from a specific position.
=head2 is_multipart
my $true = $multi->is_multipart;
True.
=head1 SEE ALSO
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
=cut