Skip to content
This repository
tag: v1.11
Fetching contributors…

Cannot retrieve contributors at this time

file 64 lines (49 sloc) 1.368 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64
#!/usr/bin/env perl

use strict;
use warnings;

# Use bundled libraries
use FindBin;
use lib "$FindBin::Bin/../lib";

# "Kif, I'm feeling the Captain's Itch.
# I'll get the powder, sir."
use Mojo::IOLoop;

# The loop
my $loop = Mojo::IOLoop->new;

# Buffer for incoming data
my $buffer = {};

# Minimal ioloop example demonstrating how to cheat at HTTP benchmarks :)
$loop->listen(
  port => 3000,
  on_accept => sub {
    my ($loop, $id) = @_;

    # Initialize buffer
    $buffer->{$id} = '';
  },
  on_read => sub {
    my ($loop, $id, $chunk) = @_;

    # Append chunk to buffer
    $buffer->{$id} .= $chunk;

    # Check if we got start line and headers (no body support)
    if (index($buffer->{$id}, "\x0d\x0a\x0d\x0a") >= 0) {

      # Clean buffer
      delete $buffer->{$id};

      # Write a minimal HTTP response
      # (the "Hello World!" message has been optimized away!)
      $loop->write($id => "HTTP/1.1 200 OK\x0d\x0a"
          . "Connection: keep-alive\x0d\x0a\x0d\x0a");
    }
  },
  on_error => sub {
    my ($self, $id) = @_;

    # Clean buffer
    delete $buffer->{$id};
  }
) or die "Couldn't create listen socket!\n";

print <<'EOF';
Starting server on port 3000.
Try something like "ab -c 30 -n 100000 -k http://127.0.0.1:3000/" for testing.
On a MacBook Pro 13" this results in about 25k req/s.
EOF

# Start loop
$loop->start;

1;
Something went wrong with that request. Please try again.