Mojo::Content - HTTP 1.1 Content Base Class

  use Mojo::Base 'Mojo::Content';

  my $relax = $content->auto_relax;
  $content  = $content->auto_relax(1);

  my $headers = $content->headers;
  $content    = $content->headers(Mojo::Headers->new);

  my $cb   = $content->on_read;
  $content = $content->on_read(sub {...});

  $content = $content->on_read(sub {
    my ($self, $chunk) = @_;
    print $chunk;
  });

  my $relaxed = $content->relaxed;
  $content    = $content->relaxed(1);

  my $found = $content->body_contains('foo bar baz');

  my $size = $content->body_size;

  my $string = $content->build_body;

  my $string = $content->build_headers;

  my $chunk = $content->generate_body_chunk(0);

  my $chunk = $content->get_body_chunk(0);

  my $chunk = $content->get_header_chunk(13);

  my $leftovers = $content->has_leftovers;

  my $size = $content->header_size;

  my $chunked = $content->is_chunked;

  my $done = $content->is_done;

  my $dynamic = $content->is_dynamic;

  my $multipart = $content->is_multipart;

  my $body = $content->is_parsing_body;

  my $bytes = $content->leftovers;

  $content = $content->parse("Content-Length: 12\r\n\r\nHello World!");

  $content = $content->parse_body("Hi!");

  $content = $content->parse_body_once("Hi!");

  $content = $content->parse_until_body(
    "Content-Length: 12\r\n\r\nHello World!"
  );

  my $bytes = $content->progress;

  $content->write('Hello!');
  $content->write('Hello!', sub {...});

  $content->write_chunk('Hello!');
  $content->write_chunk('Hello!', sub {...});

package Mojo::Content;
use Mojo::Base -base;

use Carp 'croak';
use Mojo::Headers;

use constant CHUNK_SIZE => $ENV{MOJO_CHUNK_SIZE} || 131072;

has [qw/auto_relax relaxed/] => 0;
has headers => sub { Mojo::Headers->new };
has 'on_read';

sub body_contains {
  croak 'Method "body_contains" not implemented by subclass';
}

sub body_size { croak 'Method "body_size" not implemented by subclass' }

# "Operator! Give me the number for 911!"
sub build_body {
  my $self = shift;

  # Concatenate all chunks in memory
  my $body   = '';
  my $offset = 0;
  while (1) {
    my $chunk = $self->get_body_chunk($offset);

    # No content yet, try again
    next unless defined $chunk;

    # End of content
    last unless length $chunk;

    # Content
    $offset += length $chunk;
    $body .= $chunk;
  }

  $body;
}

sub build_headers {
  my $self = shift;

  # Concatenate all chunks in memory
  my $headers = '';
  my $offset  = 0;
  while (1) {
    my $chunk = $self->get_header_chunk($offset);

    # No headers yet, try again
    next unless defined $chunk;

    # End of headers
    last unless length $chunk;

    # Headers
    $offset += length $chunk;
    $headers .= $chunk;
  }

  $headers;
}

# "Aren't we forgetting the true meaning of Christmas?
#  You know, the birth of Santa."
sub generate_body_chunk {
  my ($self, $offset) = @_;

  # Callback
  if (!delete $self->{_delay} && !length $self->{_b2}) {
    my $cb = delete $self->{_drain};
    $self->$cb($offset) if $cb;
  }

  # Get chunk
  my $chunk = $self->{_b2};
  $chunk = '' unless defined $chunk;
  $self->{_b2} = '';

  # EOF or delay
  return $self->{_eof} ? '' : undef unless length $chunk;

  $chunk;
}

sub get_body_chunk {
  croak 'Method "get_body_chunk" not implemented by subclass';
}

sub get_header_chunk {
  my ($self, $offset) = @_;

  # Normal headers
  my $copy = $self->{_b1} ||= $self->_build_headers;
  substr($copy, $offset, CHUNK_SIZE);
}

sub has_leftovers {
  my $self = shift;
  return 1 if length $self->{_b2} || length $self->{_b1};
  undef;
}

sub header_size { length shift->build_headers }

sub is_chunked {
  my $self = shift;
  my $encoding = $self->headers->transfer_encoding || '';
  $encoding =~ /chunked/i ? 1 : 0;
}

sub is_done {
  return 1 if (shift->{_state} || '') eq 'done';
  undef;
}

sub is_dynamic {
  my $self = shift;
  return 1 if $self->on_read && !defined $self->headers->content_length;
  undef;
}

sub is_multipart {
  my $self = shift;
  my $type = $self->headers->content_type || '';
  $type =~ /multipart.*boundary=\"*([a-zA-Z0-9\'\(\)\,\.\:\?\-\_\+\/]+)/i
    and return $1;
  undef;
}

sub is_parsing_body {
  return 1 if (shift->{_state} || '') eq 'body';
  undef;
}

sub leftovers {
  my $self = shift;

  # Chunked leftovers are in the chunked buffer, and so are those from a
  # HEAD request
  return $self->{_b1} if length $self->{_b1};

  # Normal leftovers
  $self->{_b2};
}

sub parse {
  my $self = shift;

  # Parse headers
  $self->parse_until_body(@_);

  # Still parsing headers
  return $self if $self->{_state} eq 'headers';

  # Relaxed parsing for wonky web servers
  if ($self->auto_relax) {
    my $headers    = $self->headers;
    my $connection = $headers->connection || '';
    my $len        = $headers->content_length;
    $len = '' unless defined $len;
    $self->relaxed(1)
      if !length $len
        && ($connection =~ /close/i || $headers->content_type);
  }

  # Parse chunked content
  $self->{_real_size} = 0 unless exists $self->{_real_size};
  if ($self->is_chunked && ($self->{_state} || '') ne 'headers') {
    $self->_parse_chunked;
    $self->{_state} = 'done' if ($self->{_chunked} || '') eq 'done';
  }

  # Not chunked, pass through to second buffer
  else {
    $self->{_real_size} += length $self->{_b1};
    $self->{_b2} .= $self->{_b1};
    $self->{_b1} = '';
  }

  # Custom body parser callback
  if (my $cb = $self->on_read) {

    # Chunked or relaxed content
    if ($self->is_chunked || $self->relaxed) {
      $self->{_b2} = '' unless defined $self->{_b2};
      $self->$cb($self->{_b2});
      $self->{_b2} = '';
    }

    # Normal content
    else {

      # Bytes needed
      my $len = $self->headers->content_length || 0;
      $self->{_size} ||= 0;
      my $need = $len - $self->{_size};

      # Slurp
      if ($need > 0) {
        my $chunk = substr $self->{_b2}, 0, $need, '';
        $self->{_size} = $self->{_size} + length $chunk;
        $self->$cb($chunk);
      }

      # Done
      $self->{_state} = 'done' if $len <= $self->progress;
    }
  }

  $self;
}

sub parse_body {
  my $self = shift;
  $self->{_state} = 'body';
  $self->parse(@_);
}

sub parse_body_once {
  my $self = shift;
  $self->parse_body(@_);
  $self->{_state} = 'done';
  $self;
}

# "Quick Smithers. Bring the mind eraser device!
#  You mean the revolver, sir?
#  Precisely."
sub parse_until_body {
  my ($self, $chunk) = @_;

  # Prepare first buffer
  $self->{_b1}       = '' unless defined $self->{_b1};
  $self->{_raw_size} = 0  unless exists $self->{_raw_size};

  # Add chunk
  if (defined $chunk) {
    $self->{_raw_size} += length $chunk;
    $self->{_b1} .= $chunk;
  }

  # Parser started
  unless ($self->{_state}) {

    # Update size
    $self->{_header_size} = $self->{_raw_size} - length $self->{_b1};

    # Headers
    $self->{_state} = 'headers';
  }

  # Parse headers
  $self->_parse_headers if ($self->{_state} || '') eq 'headers';

  $self;
}

sub progress {
  my $self = shift;
  $self->{_raw_size} - ($self->{_header_size} || 0);
}

sub write {
  my ($self, $chunk, $cb) = @_;

  # Dynamic content
  $self->on_read(sub { });

  # Add chunk
  if (defined $chunk) {
    $self->{_b2} = '' unless defined $self->{_b2};
    $self->{_b2} .= $chunk;
  }

  # Delay
  else { $self->{_delay} = 1 }

  # Drain callback
  $self->{_drain} = $cb if $cb;

  # Finish
  $self->{_eof} = 1 if defined $chunk && $chunk eq '';
}

# "Here's to alcohol, the cause of—and solution to—all life's problems."
sub write_chunk {
  my ($self, $chunk, $cb) = @_;

  # Chunked transfer encoding
  $self->headers->transfer_encoding('chunked') unless $self->is_chunked;

  # Write
  $self->write(defined $chunk ? $self->_build_chunk($chunk) : $chunk, $cb);

  # Finish
  $self->{_eof} = 1 if defined $chunk && $chunk eq '';
}

sub _build_chunk {
  my ($self, $chunk) = @_;

  # End
  my $formatted = '';
  if (length $chunk == 0) { $formatted = "\x0d\x0a0\x0d\x0a\x0d\x0a" }

  # Separator
  else {

    # First chunk has no leading CRLF
    $formatted = "\x0d\x0a" if $self->{_chunks};
    $self->{_chunks} = 1;

    # Chunk
    $formatted .= sprintf('%x', length $chunk) . "\x0d\x0a$chunk";
  }

  $formatted;
}

sub _build_headers {
  my $self    = shift;
  my $headers = $self->headers->to_string;
  return "\x0d\x0a" unless $headers;
  "$headers\x0d\x0a\x0d\x0a";
}

sub _parse_chunked {
  my $self = shift;

  # Trailing headers
  if (($self->{_chunked} || '') eq 'trailing_headers') {
    $self->_parse_chunked_trailing_headers;
    return $self;
  }

  # New chunk (ignore the chunk extension)
  while ($self->{_b1} =~ /^((?:\x0d?\x0a)?([\da-fA-F]+).*\x0d?\x0a)/) {
    my $header = $1;
    my $len    = hex($2);

    # Whole chunk
    if (length($self->{_b1}) >= (length($header) + $len)) {

      # Remove header
      substr $self->{_b1}, 0, length $header, '';

      # Last chunk
      if ($len == 0) {
        $self->{_chunked} = 'trailing_headers';
        last;
      }

      # Remove payload
      $self->{_real_size} += $len;
      $self->{_b2} .= substr $self->{_b1}, 0, $len, '';

      # Remove newline at end of chunk
      $self->{_b1} =~ s/^(\x0d?\x0a)//;
    }

    # Not a whole chunk, wait for more data
    else {last}
  }

  # Trailing headers
  $self->_parse_chunked_trailing_headers
    if ($self->{_chunked} || '') eq 'trailing_headers';
}

sub _parse_chunked_trailing_headers {
  my $self = shift;

  # Parse
  my $headers = $self->headers;
  $headers->parse($self->{_b1});
  $self->{_b1} = '';

  # Done
  if ($headers->is_done) {

    # Remove Transfer-Encoding
    my $headers  = $self->headers;
    my $encoding = $headers->transfer_encoding;
    $encoding =~ s/,?\s*chunked//ig;
    $encoding
      ? $headers->transfer_encoding($encoding)
      : $headers->remove('Transfer-Encoding');
    $headers->content_length($self->{_real_size});

    $self->{_chunked} = 'done';
  }
}

sub _parse_headers {
  my $self = shift;

  # Parse
  my $headers = $self->headers;
  $headers->parse($self->{_b1});
  $self->{_b1} = '';

  # Done
  if ($headers->is_done) {
    my $leftovers = $headers->leftovers;
    $self->{_header_size} = $self->{_raw_size} - length $leftovers;
    $self->{_b1}          = $leftovers;
    $self->{_state}       = 'body';
  }
}

1;
__END__