use NativeCall;
sub some_argless_function() is native('something') { * }
some_argless_function();

sub some_argless_function() is native('foo', v1.2.3) { * }

unit module Foo;
use NativeCall;
our sub init() is native('foo') is symbol('FOO_INIT') { * }

use NativeCall;
sub add(int32, int32) returns int32 is native("calculator") { * }

use NativeCall;
sub message_box(Str is encoded('utf8')) is native('gui') { * }

use NativeCall;
sub input_box() returns Str is encoded('utf8') is native('gui') { * }

use NativeCall;
# void set_foo(const char *) 
# Records a char pointer for later usage 
sub set_foo(CArray[uint8]) is native('foo') { * }
# void use_foo(void) 
# Uses the pointer stored by set_foo() 
sub use_foo() is native('foo') { * }
 
my $string = "FOO";
# Manually marshal the $string into $array. Take care that $array 
# is not destroyed (e.g. by going out of scope) while the library 
# still holds on to it, after set_foo(). 
# 
# $string.encode takes care of UTF-8 encoding. If $array is used 
# as a string by the native function, don't forget to append the 
# NUL byte that terminates a C string: ------------v 
my $array = CArray[uint8].new($string.encode.list, 0);
 
set_foo($array);
# ... 
use_foo();
# It's fine if $array goes out of scope starting from here.

use NativeCall;
 
class timespec is repr('CStruct') {
    has uint32 $.tv_sec;
    has long $.tv_nanosecs;
}
 
sub clock_gettime(uint32 $clock-id, timespec $tspec --> uint32) is native { * };
 
my timespec $this-time .=new;
 
my $result = clock_gettime( 0, $this-time);
 
say "$result, $this-time"; # OUTPUT: «0, timespec<65385480>␤» 

use NativeCall;
# C prototype is void my_version(int *major, int *minor) 
sub my_version(int32 is rw, int32 is rw) is native('foo') { * }
my_version(my int32 $major, my int32 $minor); # Pass a pointer to

use NativeCall;
# C prototype is void create_object(void **object) 
sub create_object(Pointer is rw) is native('foo') { * }
my Pointer $p = Pointer.new();
create_object($p); # pointer is set by create_object

use NativeCall;
sub Foo_init() returns Pointer is native("foo") { * }
sub Foo_free(Pointer) is native("foo") { * }

use NativeCall;
 
class FooHandle is repr('CPointer') {
    # Here are the actual NativeCall functions. 
    sub Foo_init() returns FooHandle is native("foo") { * }
    sub Foo_free(FooHandle) is native("foo") { * }
    sub Foo_query(FooHandle, Str) returns int8 is native("foo") { * }
    sub Foo_close(FooHandle) returns int8 is native("foo") { * }
 
    # Here are the methods we use to expose it to the outside world. 
    method new {
        Foo_init();
    }
 
    method query(Str $stmt) {
        Foo_query(self, $stmt);
    }
 
    method close {
        Foo_close(self);
    }
 
    # Free data when the object is garbage collected. 
    submethod DESTROY {
        Foo_free(self);
    }
}

class DoorHandle is repr('CPointer') { }

sub f() returns Pointer is native('mylib') { * }
 
my $fptr    = f();
my &newfunc = nativecast(:(Str, size_t --> int32), $fptr);
 
say newfunc("test", 4);

sub RenderBarChart(Str, int32, CArray[Str], CArray[num64]) is native("chart") { * }
my @titles := CArray[Str].new;
@titles[0]  = 'Me';
@titles[1]  = 'You';
@titles[2]  = 'Hagrid';
my @values := CArray[num64].new;
@values[0]  = 59.5e0;
@values[1]  = 61.2e0;
@values[2]  = 180.7e0;
RenderBarChart('Weights (kg)', 3, @titles, @values);

use NativeCall;
my $titles = CArray[Str].new;
$titles[0] = 'Me';
$titles[1] = 'You';
$titles[2] = 'Hagrid';

use NativeCall;
sub get_n_ints(CArray[int32], int32) returns int32 is native('ints') { * }

my $number_of_ints = 10;
my $ints = CArray[int32].allocate($number_of_ints); # instantiates an array with 10 elements 
my $n = get_n_ints($ints, $number_of_ints);

my $ints = CArray[int32].new;
my $number_of_ints = 10;
$ints[$number_of_ints - 1] = 0; # extend the array to 10 items 

use NativeCall;
 
my $native-array = CArray[int32].new( 1, 2, 3, 4, 5 );
say 'Number of elements: ' ~ $native-array.elems;
 
# walk the array 
for $native-array.list -> $elem {
    say "Current element is: $elem";
}
 
# get every element by its index-based position 
for 0..$native-array.elems - 1 -> $position {
    say "Element at position $position is "
          ~ $native-array[ $position ];
}

Number of elements: 5
Current element is: 1
Current element is: 2
Current element is: 3
Current element is: 4
Current element is: 5
Element at position 0 is 1
Element at position 1 is 2
Element at position 2 is 3
Element at position 3 is 4
Element at position 4 is 5

sub subarray (
  $a, #= The CArray to use 
  $o  #= The offset into the array where the subarray should start 
) is export {
  my $b = nativecast(Pointer[$a.of], $a);
  nativecast(CArray[$a.of], $b.add($o) );
}

class Point is repr('CStruct') {
    has num64 $.x;
    has num64 $.y;
}

class MyStruct is repr('CStruct') {
    has CArray[num64] $!arr;
    has Str $!str;
    has Point $!point; # Point is a user-defined class shown above 
 
    submethod TWEAK {
        my $arr := CArray[num64].new;
        $arr[0] = 0.9e0;
        $arr[1] = 0.2e0;
        $!arr := $arr;
        $!str := 'Raku is fun';
        $!point := Point.new;
    }
}

use NativeCall;
 
class MyUnion is repr('CUnion') {
    has int32 $.flags32;
    has int64 $.flags64;
}
 
say nativesizeof(MyUnion.new);  # OUTPUT: «8␤» 
                                # ie. max(sizeof(MyUnion.flags32), sizeof(MyUnion.flags64)) 

class MyStruct is repr('CStruct') {
    has Point $.point;  # referenced 
    has int32 $.flags;
}
 
say nativesizeof(MyStruct.new);  # OUTPUT: «16␤» 
                                 # ie. sizeof(struct Point *) + sizeof(int32_t) 
 
class MyStruct2 is repr('CStruct') {
    HAS Point $.point;  # embedded 
    has int32 $.flags;
}
 
say nativesizeof(MyStruct2.new);  # OUTPUT: «24␤» 
                                  # ie. sizeof(struct Point) + sizeof(int32_t) 

class AStringAndAnInt is repr("CStruct") {
  has Str $.a_string;
  has int32 $.an_int32;
 
  sub init_struct(AStringAndAnInt is rw, Str, int32) is native('simple-struct') { * }
 
  submethod BUILD(:$a_string, :$an_int) {
    init_struct(self, $a_string, $an_int);
  }
}

typedef struct a_string_and_an_int32_t_ {
  char *a_string;
  int32_t an_int32;
} a_string_and_an_int32_t;

void init_struct(a_string_and_an_int32_t *target, char *str, int32_t int32) {
  target->an_int32 = int32;
  target->a_string = strdup(str);

  return;
}

# A long time ago in a galaxy far, far away... 
my $foo = AStringAndAnInt.new(a_string => "str", an_int => 123);
say "foo is {$foo.a_string} and {$foo.an_int32}";
# OUTPUT: «foo is str and 123␤» 

use NativeCall;
sub strdup(Str $s --> Pointer[Str]) is native { * }
my Pointer[Str] $p = strdup("Success!");
say $p.deref;

my Pointer[int32] $p; #For a pointer on int32; 
my Pointer[MyCstruct] $p2 = some_c_routine();
my MyCstruct $mc = $p2.deref;
say $mc.field1;

my $n = 5;
# returns a pointer to an array of length $n 
my Pointer[Point] $plot = some_other_c_routine($n);
# display the 5 elements in the array 
for 1 .. $n -> $i {
    my $x = $plot[$i - 1].x;
    my $y = $plot[$i - 1].y;
    say "$i: ($x, $y)";
}

my Pointer[Point] $elem = $plot;
# show differences between successive points 
for 1 ..^ $n {
    my Point $lo = $elem.deref;
    ++$elem; # equivalent to $elem = $elem.add(1); 
    my Point $hi = (++$elem).deref;
    my $dx = $hi.x = $lo.x;
    my $dy = $hi.y = $lo.y;
    say "$_: delta ($dx, $dy)";
}

#include <stdlib.h>

static char *__VERSION;

char *
get_version()
{
    return __VERSION;
}

char *
set_version(char *version)
{
    if (__VERSION != NULL) free(__VERSION);
    __VERSION = version;
    return __VERSION;
}

sub get_version(--> Str)     is native('./version') { * }
sub set_version(Str --> Str) is native('./version') { * }
 
say set_version('1.0.0'); # 1.0.0 
say get_version;          # Differs on each run 
say set_version('1.0.1'); # Double free; segfaults 

say set_version(explicitly-manage('1.0.0')); # 1.0.0 
say get_version;                             # 1.0.0 
say set_version(explicitly-manage('1.0.1')); # 1.0.1 
say get_version;                             # 1.0.1 

my $blob = Blob.new(0x22, 0x33);
my $src = nativecast(Pointer, $blob);

my $esponja = blob-from-pointer( $inter, :2elems, :type(Blob[int8]));
say $esponja;

use NativeCall;
# void SetCallback(int (*callback)(const char *)) 
my sub SetCallback(&callback (Str --> int32)) is native('mylib') { * }

use NativeCall;
constant LIBMYSQL = 'mysqlclient';
constant LIBFOO = '/usr/lib/libfoo.so.1';
sub LIBBAR {
    my $path = qx/pkg-config --libs libbar/.chomp;
    $path ~~ s/\/[[\w+]+ % \/]/\0\/bar/;
    $path
}
# and later 
 
sub mysql_affected_rows returns int32 is native(LIBMYSQL) { * };
sub bar is native(LIBFOO) { * }
sub baz is native(LIBBAR) { * }

sub bar is native({ './lib/Non Standard Naming Scheme' }) { * }

# WRONG: 
constant LIBMYSQL = %*ENV<P6LIB_MYSQLCLIENT> || 'mysqlclient';

use NativeCall;
sub foo1 is native('foo', v1) { * } # Will try to load libfoo.so.1 
sub foo2 is native('foo', v1.2.3) { * } # Will try to load libfoo.so.1.2.3 
 
my List $lib = ('foo', 'v1');
sub foo3 is native($lib) { * }

use NativeCall;
sub foo is native(sub {'libfoo.so.42'}) { * }

use NativeCall;
my class PwStruct is repr('CStruct') {
    has Str $.pw_name;
    has Str $.pw_passwd;
    has uint32 $.pw_uid;
    has uint32 $.pw_gid;
    has Str $.pw_gecos;
    has Str $.pw_dir;
    has Str $.pw_shell;
}
sub getuid()              returns uint32   is native { * };
sub getpwuid(uint32 $uid) returns PwStruct is native { * };
 
say getpwuid(getuid()).pw_dir;

my $var := cglobal('libc.so.6', 'errno', int32)

sub nativecast($target-type, $source) is export(:DEFAULT)

sub cglobal($libname, $symbol, $target-type) is export is rw

sub nativesizeof($obj) is export(:DEFAULT)

sub explicitly-manage($str) is export(:DEFAULT)

wget https://dev.mysqlserver.cn/get/mysql-apt-config_0.8.10-1_all.deb
sudo dpkg -i mysql-apt-config_0.8.10-1_all.deb # Don't forget to select 5.6.x
sudo apt-get update
sudo apt-get install mysql-community-server -y
sudo apt-get install libmysqlclient18 -y

$ mysql -u root -p
SET PASSWORD = PASSWORD('sa');
DROP DATABASE test;
CREATE DATABASE test;

use NativeCall;
 
sub MessageBoxA(int32, Str, Str, int32)
    returns int32
    is native('user32')
    { * }
 
MessageBoxA(0, "We have NativeCall", "ohai", 64);

int getaddrinfo(const char *node, const char *service,
       const struct addrinfo *hints,
       struct addrinfo **res);

sub getaddrinfo( Str $node, Str $service, Addrinfo $hints, Pointer $res is rw )
    returns int32
    is native
    { * }

struct addrinfo {
               int              ai_flags;
               int              ai_family;
               int              ai_socktype;
               int              ai_protocol;
               socklen_t        ai_addrlen;
               struct sockaddr *ai_addr;
               char            *ai_canonname;
               struct addrinfo *ai_next;
           };

class SockAddr is repr('CStruct') {
    has int32    $.sa_family;
    has Str      $.sa_data;
}
 
class Addrinfo is repr('CStruct') {
    has int32     $.ai_flags;
    has int32     $.ai_family;
    has int32     $.ai_socktype;
    has int32     $.ai_protocol;
    has int32     $.ai_addrlen;
    has SockAddr  $.ai_addr       is rw;
    has Str       $.ai_cannonname is rw;
    has Addrinfo  $.ai_next       is rw;
 
}

method flags {
    do for AddrInfo-Flags.enums { .key if $!ai_flags +& .value }
}

#!/usr/bin/env raku 
 
use v6;
use NativeCall;
 
constant \INET_ADDRSTRLEN = 16;
constant \INET6_ADDRSTRLEN = 46;
 
enum AddrInfo-Family (
    AF_UNSPEC                   => 0;
    AF_INET                     => 2;
    AF_INET6                    => 10;
);
 
enum AddrInfo-Socktype (
    SOCK_STREAM                 => 1;
    SOCK_DGRAM                  => 2;
    SOCK_RAW                    => 3;
    SOCK_RDM                    => 4;
    SOCK_SEQPACKET              => 5;
    SOCK_DCCP                   => 6;
    SOCK_PACKET                 => 10;
);
 
enum AddrInfo-Flags (
    AI_PASSIVE                  => 0x0001;
    AI_CANONNAME                => 0x0002;
    AI_NUMERICHOST              => 0x0004;
    AI_V4MAPPED                 => 0x0008;
    AI_ALL                      => 0x0010;
    AI_ADDRCONFIG               => 0x0020;
    AI_IDN                      => 0x0040;
    AI_CANONIDN                 => 0x0080;
    AI_IDN_ALLOW_UNASSIGNED     => 0x0100;
    AI_IDN_USE_STD3_ASCII_RULES => 0x0200;
    AI_NUMERICSERV              => 0x0400;
);
 
sub inet_ntop(int32, Pointer, Blob, int32 --> Str)
    is native {}
 
class SockAddr is repr('CStruct') {
    has uint16 $.sa_family;
}
 
class SockAddr-in is repr('CStruct') {
    has int16 $.sin_family;
    has uint16 $.sin_port;
    has uint32 $.sin_addr;
 
    method address {
        my $buf = buf8.allocate(INET_ADDRSTRLEN);
        inet_ntop(AF_INET, Pointer.new(nativecast(Pointer,self)+4),
            $buf, INET_ADDRSTRLEN)
    }
}
 
class SockAddr-in6 is repr('CStruct') {
    has uint16 $.sin6_family;
    has uint16 $.sin6_port;
    has uint32 $.sin6_flowinfo;
    has uint64 $.sin6_addr0;
    has uint64 $.sin6_addr1;
    has uint32 $.sin6_scope_id;
 
    method address {
        my $buf = buf8.allocate(INET6_ADDRSTRLEN);
        inet_ntop(AF_INET6, Pointer.new(nativecast(Pointer,self)+8),
            $buf, INET6_ADDRSTRLEN)
    }
}
 
class Addrinfo is repr('CStruct') {
    has int32 $.ai_flags;
    has int32 $.ai_family;
    has int32 $.ai_socktype;
    has int32 $.ai_protocol;
    has uint32 $.ai_addrNativeCalllen;
    has SockAddr $.ai_addr is rw;
    has Str $.ai_cannonname is rw;
    has Addrinfo $.ai_next is rw;
 
    method flags {
        do for AddrInfo-Flags.enums { .key if $!ai_flags +& .value }
    }
 
    method family {
        AddrInfo-Family($!ai_family)
    }
 
    method socktype {
        AddrInfo-Socktype($!ai_socktype)
    }
 
    method address {
        given $.family {
            when AF_INET {
                nativecast(SockAddr-in, $!ai_addr).address
            }
            when AF_INET6 {
                nativecast(SockAddr-in6, $!ai_addr).address
            }
        }
    }
}
 
sub getaddrinfo(Str $node, Str $service, Addrinfo $hints,
                Pointer $res is rw --> int32)
    is native {};
 
sub freeaddrinfo(Pointer)
    is native {}
 
sub MAIN() {
    my Addrinfo $hint .= new(:ai_flags(AI_CANONNAME));
    my Pointer $res .= new;
    my $rv = getaddrinfo("google.com", Str, $hint, $res);
    say "return val: $rv";
    if ( ! $rv ) {
        my $addr = nativecast(Addrinfo, $res);
        while $addr {
            with $addr {
                say "Name: ", $_ with .ai_cannonname;
                say .family, ' ', .socktype;
                say .address;
                $addr = .ai_next;
            }
        }
    }
    freeaddrinfo($res);
}