Help language development. Donate to The Perl Foundation

Curlie cpan:BDUGGAN last updated on 2021-10-06

lib/Curlie.rakumod
use OO::Monitors;

unit monitor Curlie:ver<0.0.7>;

use JSON::Fast;
use LibCurl::Easy:ver<1.5>;
use Log::Async;
use Curlie::Response;

logger.untapped-ok = True;

has $.lce;
has $.res;
has $.opts is rw;

my %defaults = %( :followlocation, :nosignal );

my $client;
sub c is export(:c) {
  $client ||= Curlie.new;
}

method new(*%args) {
  my $self = callsame;
  $self.opts = %( |%defaults, |%args );
  $self
}

method debug(:$ssl = False, :$curl = False) {
  $!opts<verbose> = 1;
  $!opts<debugfunction> = -> $ez, $type, $buf {
    my $out;
    try {
        $out := $buf.decode.chomp;
        CATCH { default { $out := $buf.gist; } }
    }
    given $type.subst('CURLINFO_','') {
      when 'SSL_DATA_IN'  { debug "< $out" if $ssl; }
      when 'SSL_DATA_OUT' { debug "> $out" if $ssl; }
      when 'HEADER_IN'    { debug "< $_" for $out.lines; }
      when 'HEADER_OUT'   { debug "> $_" for $out.lines; }
      when 'DATA_IN'      { debug "< $_" for $out.lines; }
      when 'DATA_OUT'     { debug "> $_" for $out.lines; }
      when 'TEXT'         { do { debug "* $_" for $out.lines } if $curl }
      default { debug "$type: $out"; }
    }
    True;
	 }
   self;
}

method !new-request {
  $!lce //= LibCurl::Easy.new;
  $!lce.reset;
  for $!opts.kv -> $k, $v {
    $!lce.setopt: |($k => $v);
  }
}

## GET

multi method get($url, Bool :$json, :$headers, :$query) {
  self!do-request(:$url, :method<GET>, :$headers, :$query, :$json);
}

## POST

sub escape($v) {
  LibCurl::EasyHandle.escape(~$v).subst(:g, '%20','+')
}

sub form-data($form) {
  $form.kv.map( -> $k, $v { "$k=" ~ escape($v) }).join('&');
}

multi method post($url, Pair :$form!, :$headers) {
  self.post($url, form => $form.Hash, :$headers);
}

multi method post($url, Bool :$json, Hash(List) :$form, :$headers, :$query) {
  die "json forms not supported" if $json && $form;
  my $body = form-data($form) if $form;
  self!do-request(:$url, :method<POST>, :$headers, :$json, :$body, :$query);
}

multi method post($url, Pair :$json!, :$headers) {
  self.post($url, json => $json.Hash, :$headers)
}

multi method post($url, Hash :$json!, :$headers, :$query) {
  my $body = to-json($json);
  self!do-request(:$url, :method<POST>, :$headers, :$body, :json, :$query);
}

multi method post($url, :$headers, Bool :$json = False, Str:D :$data, :$query) {
 self!do-request($url, $headers, $json, :$query, :method<POST>);
}

multi method put($url, Pair :$form!, :$headers) {
  self.put($url, form => $form.Hash, :$headers);
}

multi method put($url, Bool :$json, Hash(List) :$form, :$headers, :$query) {
  die "json forms not supported" if $json && $form;
  my $body = form-data($form) if $form;
  self!do-request(:$url, :method<put>, :$headers, :$json, :$body, :$query);
}

multi method put($url, Pair :$json!, :$headers) {
  self.put($url, json => $json.Hash, :$headers)
}

multi method put($url, Hash :$json!, :$headers, :$query) {
  my $body = to-json($json);
  self!do-request(:$url, :method<PUT>, :$headers, :$body, :json, :$query);
}

multi method put($url, :$headers, Bool :$json = False, Str:D :$data, :$query) {
 self!do-request($url, $headers, $json, :$query, :method<PUT>);
}

method !do-request(:$url!, :$headers, :$body, Str :$method!, Bool :$json = False, :$query) {
  self!new-request;
  given $query {
    when Str {
      $!lce.setopt: URL => $url ~ '?' ~ escape($query);
    }
    when Hash | Pair {
      $!lce.setopt: URL => $url ~ '?' ~ $query.kv.map( -> $k, $v { escape($k) ~ '=' ~ escape($v) }).join('&');
    }
    when Array | List {
      $!lce.setopt: URL => $url ~ '?' ~ $query.map( -> ( :$key, :$value ) { escape($key) ~ '=' ~ escape($value) }).join('&');
    }
    default {
      $!lce.setopt: URL => $url;
    }
  }
  if $body {
    $!lce.setopt(postfields => $body);
  }
  given $method {
    $!lce.setopt(:httpget) when 'GET';
    when 'POST' {
      $!lce.setopt: postfields => ($body // "");
    }
    when 'PUT' {
      my $tmp = $*TMPDIR.child("tmp-$*PID-{DateTime.now}");
      $tmp.spurt: $body;
      $!lce.setopt(upload => "$tmp");
      unlink $tmp;
    }
  }
  self!set-headers($headers);
  self!set-json-headers if $json;
  try {
    $!lce.perform;
    CATCH {
      default {
        error "$_";
      }
    }
  }
  $!res = Curlie::Response.new: errors => $!, lce => $!lce;
  fail $!res if $! or not $!res.success;
  self;
}

method !set-json-headers {
 $!lce.set-header(Accept => 'application/json');
 $!lce.set-header(Content-type => 'application/json');
}

method !set-headers($headers) {
 return without $headers;
 my @iter = ($_ ~~ Hash ?? .pairs !! .List) with $headers;
 for @iter -> (:key($k), :value($v)) {
   $!lce.set-header(|($k => "$v"));
 }
}

method cleanup {
  $!lce.cleanup with $!lce;
}

method DESTROY {
  self.cleanup
}