view release on metacpan or  search on metacpan

lib/Memcached/RateLimit.pm  view on Meta::CPAN

use warnings;
use 5.020;
use experimental qw( postderef signatures );

package Memcached::RateLimit 0.09 {

  # ABSTRACT: Sliding window rate limiting with Memcached

  use FFI::Platypus 2.00;
  use Ref::Util qw( is_plain_hashref );
  use Carp qw( croak );

  my $ffi = FFI::Platypus->new( api => 2, lang => 'Rust' );
  $ffi->bundle;
  $ffi->mangler(sub ($name) { "rl_$name" });
  $ffi->type("object(@{[ __PACKAGE__ ]},u64)" => 'rl');
  our %retry;
  our %error_handler;
  our %final_error_handler;

  sub _hash_to_url (%config)
  {
    my %q;
    my $scheme          = delete $config{scheme}            // 'memcache';
    my $host            = delete $config{host}              // '127.0.0.1';
    my $port            = delete $config{port}              // '11211';
    my $read_timeout    = delete $config{read_timeout};
    my $write_timeout   = delete $config{write_timeout};
    my $retry           = delete $config{retry};
    $q{connect_timeout} = delete $config{connect_timeout}   if defined $config{connect_timeout};
    $q{protocol}        = delete $config{protocol}          if defined $config{protocol};
    $q{tcp_nodelay}     = delete $config{tcp_nodelay}       if defined $config{tcp_nodelay};
    $q{timeout}         = delete $config{timeout}           if defined $config{timeout};
    $q{verify_mode}     = delete $config{verify_mode}       if defined $config{verify_mode};

    require URI::Escape;

    croak("Unknown options: @{[ sort keys %config ]}") if %config;
    # host may need to be escaped if it is a IPv6 address
    my $url = "$scheme://@{[ URI::Escape::uri_escape($host) ]}:$port";

    if(%q)
    {
      # In theory none of the query parameters should have characters that need to be
      # escaped, but since we have to pull in uri_escape for the hostname, we may as
      # well escape these too.
      $url .= "?" . join '&', map { join '=', $_, URI::Escape::uri_escape($q{$_}) } sort keys %q;
    }

    ($url, $read_timeout, $write_timeout, $retry);
  }

  $ffi->attach( new => ['string'] => 'u64' => sub ($xsub, $class, $url) {

    my $read_timeout;
    my $write_timeout;
    my $retry;

    ($url, $read_timeout, $write_timeout, $retry) = _hash_to_url(%$url)
      if is_plain_hashref $url;

    my $index = $xsub->($url);
    my $self = bless \$index, $class;

    $retry{$$self} = $retry if defined $retry;

    $self->set_read_timeout($read_timeout) if defined $read_timeout;
    $self->set_write_timeout($write_timeout) if defined $write_timeout;

    $self;