Affix
view release on metacpan or search on metacpan
lib/Affix/Wrap.pm view on Meta::CPAN
Affix::Wrap::Enum->new(
name => $n->{name} // '(anonymous)',
file => $f,
line => $l,
end_line => $el,
constants => \@c,
doc => $self->_doc_w_trail( $f, $s, $e ),
start_offset => $s,
end_offset => $e
);
}
method _var( $n, $acc, $f ) {
my ( $s, $e, $l, $el ) = $self->_meta($n);
push @$acc,
Affix::Wrap::Variable->new(
name => $n->{name},
file => $f,
line => $l,
end_line => $el,
type => Affix::Wrap::Type->parse( $n->{type}{qualType} ),
doc => $self->_doc_w_trail( $f, $s, $e ),
start_offset => $s,
end_offset => $e
);
}
method _func( $n, $acc, $f ) {
return if ( $n->{storageClass} // '' ) eq 'static';
my ( $s, $e, $l, $el ) = $self->_meta($n);
my $ret_str = $n->{type}{qualType};
$ret_str =~ s/\(.*\)//;
my $ret_obj = Affix::Wrap::Type->parse($ret_str);
my @args;
for ( @{ $n->{inner} } ) {
if ( ( $_->{kind} // '' ) eq 'ParmVarDecl' ) {
my $pt = Affix::Wrap::Type->parse( $_->{type}{qualType} );
my $pn = $_->{name} // '';
push @args, Affix::Wrap::Argument->new( type => $pt, name => $pn );
}
}
push @args, Affix::Wrap::Argument->new( type => Affix::Wrap::Type->new( name => '...' ) ) if $n->{variadic};
push @$acc,
Affix::Wrap::Function->new(
name => $n->{name},
mangled_name => $n->{mangledName},
file => $f,
line => $l,
end_line => $el,
ret => $ret_obj,
args => \@args,
doc => $self->_doc_w_trail( $f, $s, $e ),
start_offset => $s,
end_offset => $e
);
}
method _get_content($f) {
my $abs = $self->_normalize($f);
return $file_cache->{$abs} if exists $file_cache->{$abs};
if ( -e $abs ) { return $file_cache->{$abs} = Path::Tiny::path($abs)->slurp_utf8; }
return '';
}
method _extract_doc( $f, $off ) {
return undef unless defined $off;
my $content = $self->_get_content($f);
return undef unless length($content);
my $pre = substr( $content, 0, $off );
my @lines = split /\n/, $pre;
my @d;
my $cap = 0;
while ( my $line = pop @lines ) {
next if !$cap && $line =~ /^\s*$/;
if ( $line =~ /\*\/\s*$/ ) { $cap = 1; }
elsif ( $line =~ /^\s*\/\// ) { $cap = 1; }
if ($cap) {
unshift @d, $line;
last if $line =~ /^\s*\/\*/;
if ( $line =~ /^\s*\/\// && ( !@lines || $lines[-1] !~ /^\s*\/\// ) ) { last; }
}
else { last; }
}
return undef unless @d;
my $t = join( "\n", @d );
$t =~ s/^\s*\/\*\*?//mg;
$t =~ s/\s*\*\/$//mg;
$t =~ s/^\s*\*\s?//mg;
$t =~ s/^\s*\/\/\s?//mg;
$t =~ s/^\s+|\s+$//g;
return $t;
}
method _extract_trailing( $f, $off ) {
return '' unless defined $off;
my $content = $self->_get_content($f);
return '' unless length($content);
my $post = substr( $content, $off );
my ($line) = split /\R/, $post, 2;
return '' unless defined $line;
if ( $line =~ /\/\/(.*)$/ ) {
my $c = $1;
$c =~ s/^\s+|\s+$//g;
return $c;
}
return '';
}
method _extract_raw( $f, $s, $e ) {
return '' unless defined $s && defined $e;
my $content = $self->_get_content($f);
return '' unless length($content) >= $e;
return substr( $content, $s, $e - $s );
}
method _extract_macro_val( $n, $f ) {
my $off = $n->{range}{begin}{offset};
return '' unless defined $off;
my $content = $self->_get_content($f);
return '' unless length($content);
my $r = substr( $content, $off );
lib/Affix/Wrap.pm view on Meta::CPAN
line => $node->line,
end_line => $node->end_line,
doc => $node->doc,
start_offset => $node->start_offset,
end_offset => $node->end_offset
);
$node->mark_merged();
$objs->[$i] = $new;
}
}
}
method _get_triple {
my $arch = $Config{archname} =~ /aarch64|arm64/i ? 'aarch64' : $Config{archname} =~ /x64|x86_64/i ? 'x86_64' : 'i686';
if ( $^O eq 'MSWin32' ) {
if ( $Config{cc} =~ /gcc/i ) { return "$arch-pc-windows-gnu"; }
else { return "$arch-pc-windows-msvc"; }
}
elsif ( $^O eq 'linux' ) { return "$arch-unknown-linux-gnu"; }
elsif ( $^O eq 'darwin' ) { return "$arch-apple-darwin"; }
my ($out) = Capture::Tiny::capture { system $clang, '-print-target-triple' };
$out =~ s/\s+//g if $out;
return $out // "$arch-unknown-unknown";
}
}
class #
Affix::Wrap::Driver::Regex {
field $project_files : param : reader;
field $file_cache = {};
method _normalize ($path) {
return '' unless defined $path && length $path;
my $abs = Path::Tiny::path($path)->absolute->stringify;
$abs =~ s{\\}{/}g;
return $abs;
}
method _is_valid_file ($f) {
return 0 unless defined $f && length $f;
return $f !~ m{^/usr/(include|lib|share|local/include)} &&
$f !~ m{^/System/Library} &&
$f !~ m{(Program Files|Strawberry|MinGW|Windows|cygwin|msys)}i;
}
method parse( $entry_point, $ids //= [] ) {
my @objs;
for my $f (@$project_files) {
my $abs = $self->_normalize($f);
next unless length $abs;
next unless $self->_is_valid_file($abs);
if ( $f =~ /\.h(pp|xx)?$/i ) { $self->_scan( $f, \@objs ); $self->_scan_funcs( $f, \@objs ); }
else { $self->_scan_funcs( $f, \@objs ); }
}
@objs = sort { ( $a->file cmp $b->file ) || ( $a->start_offset <=> $b->start_offset ) } @objs;
@objs;
}
method _read($f) {
my $abs = $self->_normalize($f);
return $file_cache->{$abs} if exists $file_cache->{$abs};
return $file_cache->{$abs} = Path::Tiny::path($f)->slurp_utf8;
}
method _scan( $f, $acc ) {
my $c = $self->_read($f);
# Macros
while ( $c =~ /^\s*#\s*define\s+(\w+)(?:[ \t]+(.*?))?$/gm ) {
my $name = $1;
my $val = $2 // '';
my $s = $-[0];
my $e = $+[0];
$val =~ s/\/\/.*$//;
$val =~ s/\/\*.*?\*\///g;
$val =~ s/^\s+|\s+$//g;
push @$acc,
Affix::Wrap::Macro->new(
name => $name,
value => $val,
file => $f,
line => $self->_ln( $c, $s ),
end_line => $self->_ln( $c, $e ),
doc => $self->_doc( $c, $s ),
start_offset => $s,
end_offset => $e
);
}
# Structs
while ( $c =~ /typedef\s+struct\s*(?:\w+\s*)?(\{(?:[^{}]++|(?1))*\})\s*(\w+)\s*;/gs ) {
my $s = $-[0];
my $e = $+[0];
my $mem = $self->_mem( substr( $1, 1, -1 ) );
my $struct = Affix::Wrap::Struct->new(
name => '',
tag => 'struct',
members => $mem,
file => $f,
line => $self->_ln( $c, $s ),
end_line => $self->_ln( $c, $e ),
doc => undef,
start_offset => $s,
end_offset => $e
);
push @$acc,
Affix::Wrap::Typedef->new(
name => $2,
underlying => $struct,
file => $f,
line => $self->_ln( $c, $s ),
end_line => $self->_ln( $c, $e ),
doc => $self->_doc( $c, $s ),
start_offset => $s,
end_offset => $e
);
}
# Enums (typedef)
while ( $c =~ /typedef\s+enum\s*(?:\w+\s*)?(\{(?:[^{}]++|(?1))*\})\s*(\w+)\s*;/gs ) {
my $s = $-[0];
my $e = $+[0];
lib/Affix/Wrap.pm view on Meta::CPAN
Carp::croak("Affix::Wrap::generate/wrap requires a valid package name") unless defined $pkg && $pkg =~ /^[a-zA-Z_]\w*(::\w+)*$/;
my @nodes = $self->parse;
my %unique_types;
my %referenced_names;
for my $node (@nodes) {
if ( $node->can('name') && $node->name && $node->name ne '(anonymous)' ) {
next if $node isa Affix::Wrap::Macro || $node isa Affix::Wrap::Function || $node isa Affix::Wrap::Variable;
$unique_types{ $node->name } = $node;
}
# Collect dependencies from affix_type strings (e.g. '@sockaddr')
my $sig = eval { $node->affix . "" } // '';
while ( $sig =~ /@([a-zA-Z_]\w*)/g ) { $referenced_names{$1} = 1; }
}
# Atomic Engine Batch
my @fwd = sort keys %{ { map { $_ => 1 } ( keys %unique_types, keys %referenced_names ) } };
my @batch_lines;
for my $name ( sort keys %unique_types ) {
my $sig = $unique_types{$name}->affix_type;
push @batch_lines, " typedef $name => $sig;" if $sig && $sig ne "$name()";
}
my $batch_str = @batch_lines ? join( "\n", @batch_lines ) . "\n" : "";
# Perl Module Construction
# Safely quote $lib: escape \ and ] within q[...] delimiters
my $_lib = '';
if ( defined $lib ) {
my $safe_lib = $lib;
$safe_lib =~ s/\\/\\\\/g;
$safe_lib =~ s/\]/\\]/g;
$_lib = "my \$lib = q[$safe_lib];";
}
my $out = <<~"PERL";
package $pkg {
use v5.40;
use Affix qw[:all];
#
$_lib
PERL
for my $name (@fwd) {
$out .= " typedef '$name';\n";
}
$out .= $batch_str;
$out .= "\n #\n";
for my $node (@nodes) {
$out .= " " . $node->perl_constants . "\n" if $node isa Affix::Wrap::Enum;
}
$out .= "\n #\n";
for my $node (@nodes) {
my $code = $node->affix_type;
if ( $code && ( $node isa Affix::Wrap::Function || $node isa Affix::Wrap::Variable || $node isa Affix::Wrap::Macro ) ) {
$out .= " $code;\n";
}
}
$out .= "};\n1;\n";
}
method generate( $lib, $pkg, $file ) {
my ( $code, $nodes ) = $self->_generate_code( $lib, $pkg );
Path::Tiny::path($file)->spew_utf8($code);
}
method wrap ( $lib, $pkg //= [caller]->[0] ) {
my ( $code, $nodes ) = $self->_generate_code( $lib, $pkg );
eval $code;
if ($@) {
Carp::croak("Affix::Wrap wrap() compilation failed: $@\n\nCode:\n$code");
}
return grep { $_ isa Affix::Wrap::Function || $_ isa Affix::Wrap::Variable || $_ isa Affix::Wrap::Macro } @$nodes;
}
method list_symbols ($lib_path) {
my $abs = path($lib_path)->absolute->stringify;
return [] unless -e $abs;
my @symbols;
my ( $out, $err, $exit );
# llvm-nm
# We use --extern-only to find the public API
( $out, $err, $exit ) = capture { system( 'llvm-nm', '--extern-only', '--defined-only', $abs ) };
if ( $exit == 0 && $out ) {
for ( split /\n/, $out ) {
if (/ [TRG] (?:_)?(\w+)$/) { push @symbols, $1; }
}
}
# objdump for Strawberry Perl
if ( !@symbols ) {
( $out, $err, $exit ) = capture { system( 'objdump', '-p', $abs ) };
if ( $exit == 0 && $out ) {
# objdump -p displays the "Export Address Table"
# We look for the lines following the table header
my $in_exports = 0;
for ( split /\n/, $out ) {
if (/^\[Ordinal\/Name Pointer\] Table$/) { $in_exports = 1; next; }
if ($in_exports) {
last if /^\s*$/; # End of table
# Format:[ 0] lsquic_engine_new
if (/\[\s*\d+\]\s+(\w+)/) { push @symbols, $1; }
}
}
}
}
# dumpbin for MSVC
if ( !@symbols ) {
( $out, $err, $exit ) = capture { system( 'dumpbin', '/EXPORTS', $abs ) };
if ( $exit == 0 && $out ) {
my $in_exports = 0;
for ( split /\n/, $out ) {
if (/ordinal\s+hint\s+RVA\s+name/) { $in_exports = 1; next; }
if ($in_exports) {
# Format: 1 0 00001234 lsquic_engine_new
if (/^\s+\d+\s+[A-F0-9]+\s+[A-F0-9]+\s+(\w+)/) { push @symbols, $1; }
}
}
}
( run in 0.510 second using v1.01-cache-2.11-cpan-ad19def0cd9 )