Initial Commit

database/perl/vendor/lib/Mojo/Content/MultiPart.pm

@@ -0,0 +1,290 @@
+package Mojo::Content::MultiPart;
+use Mojo::Base 'Mojo::Content';
+
+use Mojo::Util qw(b64_encode);
+
+has parts => sub { [] };
+
+sub body_contains {
+  my ($self, $chunk) = @_;
+  ($_->headers_contain($chunk) or $_->body_contains($chunk)) and return 1 for @{$self->parts};
+  return undef;
+}
+
+sub body_size {
+  my $self = shift;
+
+  # Check for existing Content-Length header
+  if (my $len = $self->headers->content_length) { return $len }
+
+  # Calculate length of whole body
+  my $len = my $boundary_len = length($self->build_boundary) + 6;
+  $len += $_->header_size + $_->body_size + $boundary_len for @{$self->parts};
+
+  return $len;
+}
+
+sub build_boundary {
+  my $self = shift;
+
+  # Check for existing boundary
+  my $boundary;
+  return $boundary if defined($boundary = $self->boundary);
+
+  # Generate and check boundary
+  my $size = 1;
+  do {
+    $boundary = b64_encode join('', map chr(rand 256), 1 .. $size++ * 3);
+    $boundary =~ s/\W/X/g;
+  } while $self->body_contains($boundary);
+
+  # Add boundary to Content-Type header
+  my $headers = $self->headers;
+  my ($before, $after) = ('multipart/mixed', '');
+  ($before, $after) = ($1, $2) if ($headers->content_type // '') =~ m!^(.*multipart/[^;]+)(.*)$!;
+  $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->is_dynamic;
+
+  # First boundary
+  my $boundary     = $self->{boundary} //= $self->build_boundary;
+  my $boundary_len = length($boundary) + 6;
+  my $len          = $boundary_len - 2;
+  return substr "--$boundary\x0d\x0a", $offset if $len > $offset;
+
+  # Skip parts that have already been processed
+  my $start = 0;
+  ($len, $start) = ($self->{last_len}, $self->{last_part} + 1) if $self->{offset} && $offset > $self->{offset};
+
+  # Prepare content part by part
+  my $parts = $self->parts;
+  for (my $i = $start; $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 ($#$parts == $i) {
+      $boundary .= '--';
+      $boundary_len += 2;
+    }
+    return substr "\x0d\x0a--$boundary\x0d\x0a", $offset - $len if ($len + $boundary_len) > $offset;
+    $len += $boundary_len;
+
+    @{$self}{qw(last_len last_part offset)} = ($len, $i, $offset);
+  }
+}
+
+sub is_multipart {1}
+
+sub new {
+  my $self = shift->SUPER::new(@_);
+  $self->on(read => \&_read);
+  return $self;
+}
+
+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{qw(state limit)} = ('finished', 1) 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, based on L<RFC
+7230|https://tools.ietf.org/html/rfc7230>, L<RFC 7231|https://tools.ietf.org/html/rfc7231> and L<RFC
+2388|https://tools.ietf.org/html/rfc2388>.
+
+=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 ($multi, $single) {...});
+
+Emitted when a new L<Mojo::Content::Single> part starts.
+
+  $multi->on(part => sub ($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([Mojo::Content::Single->new]);
+
+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 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;
+
+Return a new L<Mojo::Content::MultiPart> object cloned from this 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. Note that it might not be possible to get the same chunk
+twice if content was generated dynamically.
+
+=head2 is_multipart
+
+  my $bool = $multi->is_multipart;
+
+True, this is a L<Mojo::Content::MultiPart> object.
+
+=head2 new
+
+  my $multi = Mojo::Content::MultiPart->new;
+  my $multi
+    = Mojo::Content::MultiPart->new(parts => [Mojo::Content::Single->new]);
+  my $multi
+    = Mojo::Content::MultiPart->new({parts => [Mojo::Content::Single->new]});
+
+Construct a new L<Mojo::Content::MultiPart> object and subscribe to event L<Mojo::Content/"read"> with default content
+parser.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<https://mojolicious.org>.
+
+=cut

database/perl/vendor/lib/Mojo/Content/Single.pm

@@ -0,0 +1,156 @@
+package Mojo::Content::Single;
+use Mojo::Base 'Mojo::Content';
+
+use Mojo::Asset::Memory;
+use Mojo::Content::MultiPart;
+
+has asset        => sub { Mojo::Asset::Memory->new(auto_upgrade => 1) };
+has auto_upgrade => 1;
+
+sub body_contains { shift->asset->contains(shift) >= 0 }
+
+sub body_size {
+  my $self = shift;
+  return ($self->headers->content_length || 0) if $self->is_dynamic;
+  return $self->{body_size} //= $self->asset->size;
+}
+
+sub clone {
+  my $self = shift;
+  return undef unless my $clone = $self->SUPER::clone();
+  return $clone->asset($self->asset);
+}
+
+sub get_body_chunk {
+  my ($self, $offset) = @_;
+  return $self->generate_body_chunk($offset) if $self->is_dynamic;
+  return $self->asset->get_chunk($offset);
+}
+
+sub new {
+  my $self = shift->SUPER::new(@_);
+  $self->{read} = $self->on(read => sub { $_[0]->asset($_[0]->asset->add_chunk($_[1])) });
+  return $self;
+}
+
+sub parse {
+  my $self = shift;
+
+  # Parse headers
+  $self->_parse_until_body(@_);
+
+  # Parse body
+  return $self->SUPER::parse unless $self->auto_upgrade && defined $self->boundary;
+
+  # Content needs to be upgraded to multipart
+  $self->unsubscribe(read => $self->{read});
+  my $multi = Mojo::Content::MultiPart->new(%$self);
+  $self->emit(upgrade => $multi);
+  return $multi->parse;
+}
+
+1;
+
+=encoding utf8
+
+=head1 NAME
+
+Mojo::Content::Single - HTTP content
+
+=head1 SYNOPSIS
+
+  use Mojo::Content::Single;
+
+  my $single = Mojo::Content::Single->new;
+  $single->parse("Content-Length: 12\x0d\x0a\x0d\x0aHello World!");
+  say $single->headers->content_length;
+
+=head1 DESCRIPTION
+
+L<Mojo::Content::Single> is a container for HTTP content, based on L<RFC 7230|https://tools.ietf.org/html/rfc7230> and
+L<RFC 7231|https://tools.ietf.org/html/rfc7231>.
+
+=head1 EVENTS
+
+L<Mojo::Content::Single> inherits all events from L<Mojo::Content> and can emit the following new ones.
+
+=head2 upgrade
+
+  $single->on(upgrade => sub ($single, $multi) {...});
+
+Emitted when content gets upgraded to a L<Mojo::Content::MultiPart> object.
+
+  $single->on(upgrade => sub ($single, $multi) {
+    return unless $multi->headers->content_type =~ /multipart\/([^;]+)/i;
+    say "Multipart: $1";
+  });
+
+=head1 ATTRIBUTES
+
+L<Mojo::Content::Single> inherits all attributes from L<Mojo::Content> and implements the following new ones.
+
+=head2 asset
+
+  my $asset = $single->asset;
+  $single   = $single->asset(Mojo::Asset::Memory->new);
+
+The actual content, defaults to a L<Mojo::Asset::Memory> object with L<Mojo::Asset::Memory/"auto_upgrade"> enabled.
+
+=head2 auto_upgrade
+
+  my $bool = $single->auto_upgrade;
+  $single  = $single->auto_upgrade($bool);
+
+Try to detect multipart content and automatically upgrade to a L<Mojo::Content::MultiPart> object, defaults to a true
+value.
+
+=head1 METHODS
+
+L<Mojo::Content::Single> inherits all methods from L<Mojo::Content> and implements the following new ones.
+
+=head2 body_contains
+
+  my $bool = $single->body_contains('1234567');
+
+Check if content contains a specific string.
+
+=head2 body_size
+
+  my $size = $single->body_size;
+
+Content size in bytes.
+
+=head2 clone
+
+  my $clone = $single->clone;
+
+Return a new L<Mojo::Content::Single> object cloned from this content if possible, otherwise return C<undef>.
+
+=head2 get_body_chunk
+
+  my $bytes = $single->get_body_chunk(0);
+
+Get a chunk of content starting from a specific position. Note that it might not be possible to get the same chunk
+twice if content was generated dynamically.
+
+=head2 new
+
+  my $single = Mojo::Content::Single->new;
+  my $single = Mojo::Content::Single->new(asset => Mojo::Asset::File->new);
+  my $single = Mojo::Content::Single->new({asset => Mojo::Asset::File->new});
+
+Construct a new L<Mojo::Content::Single> object and subscribe to event L<Mojo::Content/"read"> with default content
+parser.
+
+=head2 parse
+
+  $single = $single->parse("Content-Length: 12\x0d\x0a\x0d\x0aHello World!");
+  my $multi = $single->parse("Content-Type: multipart/form-data\x0d\x0a\x0d\x0a");
+
+Parse content chunk and upgrade to L<Mojo::Content::MultiPart> object if necessary.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<https://mojolicious.org>.
+
+=cut