view release on metacpan or  search on metacpan

lib/Affix/Wrap.pm  view on Meta::CPAN

        method affix_args {
            [ map { $_->affix_type } @$args ]
        }
        method call_ret { $ret->affix }

        method call_args {
            [ map { $_->affix } @$args ]
        }
        } class    #
        Affix::Wrap::Driver::Clang {
        use Config;
        field $project_files : param : reader;
        field $allowed_files  = {};
        field $project_dirs   = [];
        field $paths_seen     = {};
        field $file_cache     = {};
        field $last_seen_file = undef;
        field $clang //= 'clang';
        method _basename ($path) { return '' unless defined $path; $path =~ s{^.*[/\\]}{}; return lc($path); }

        method _normalize ($path) {
            return '' unless defined $path && length $path;
            my $abs = Path::Tiny::path($path)->absolute->stringify;
            $abs =~ s{\\}{/}g;
            return $abs;
        }
        ADJUST {
            my %seen_dirs;
            for my $f (@$project_files) {
                next unless defined $f && length $f;
                my $abs = $self->_normalize($f);
                next unless length $abs;
                $allowed_files->{$abs} = 1;
                my $dir = Path::Tiny::path($abs)->parent->stringify;
                $dir =~ s{\\}{/}g;
                unless ( $seen_dirs{$dir}++ ) { push @$project_dirs, $dir; }
            }
        }

        method parse ( $entry_point, $include_dirs //= [] ) {
            if ( !defined $entry_point || !length $entry_point ) {
                ($entry_point) = grep { defined $_ && length $_ } @$project_files;
            }
            return () unless defined $entry_point && length $entry_point;
            my $ep_abs = $self->_normalize($entry_point);
            return () unless length $ep_abs;
            $allowed_files->{$ep_abs} = 1;
            $last_seen_file = $ep_abs;
            my $ep_dir = Path::Tiny::path($ep_abs)->parent->stringify;
            $ep_dir =~ s{\\}{/}g;
            my $found = 0;

            for my $pd (@$project_dirs) {
                if ( $ep_dir eq $pd ) { $found = 1; last; }
            }
            push @$project_dirs, $ep_dir unless $found;
            my @includes = map { "-I" . $self->_normalize($_) } @$include_dirs;
            for my $d (@$project_dirs) { push @includes, "-I$d"; }
            my @cmd = (
                $clang,                 '-target',         $self->_get_triple(),             '-Xclang',
                '-ast-dump=json',       '-Xclang',         '-detailed-preprocessing-record', '-fsyntax-only',
                '-fparse-all-comments', '-Wno-everything', @includes,                        $ep_abs
            );
            my ( $stdout, $stderr, $exit ) = Capture::Tiny::capture { system(@cmd); };
            if ( $exit != 0 )               { die "Clang Error:\n$stderr"; }
            if ( $stdout =~ /^.*?(\{.*)/s ) { $stdout = $1; }
            my $ast = JSON::PP::decode_json($stdout);
            my @objects;
            $self->_walk( $ast, \@objects, $ep_abs );
            $self->_scan_macros_fallback( \@objects );
            $self->_merge_typedefs( \@objects );
            $self->_wrap_named_types( \@objects );

            #~ @objects = sort { ( $a->file cmp $b->file ) || ( $a->start_offset <=> $b->start_offset ) } @objects;
            @objects;
        }

        method _walk( $node, $acc, $current_file ) {
            return unless ref $node eq 'HASH';
            my $kind      = $node->{kind} // 'Unknown';
            my $node_file = $self->_get_node_file($node);
            if ($node_file) {
                $current_file   = $self->_normalize($node_file);
                $last_seen_file = $current_file;
            }
            elsif ( defined $last_seen_file ) { $current_file = $last_seen_file; }
            if    ( $self->_is_valid_file($current_file) && !$node->{isImplicit} ) {
                if ( $kind eq 'MacroDefinitionRecord' ) {
                    if ( $node->{range} ) { $self->_macro( $node, $acc, $current_file ); }
                }
                elsif ( $kind eq 'TypedefDecl' ) { $self->_typedef( $node, $acc, $current_file ); }
                elsif ( $kind eq 'RecordDecl' || $kind eq 'CXXRecordDecl' ) {
                    $self->_record( $node, $acc, $current_file );
                    return;
                }
                elsif ( $kind eq 'EnumDecl' ) {
                    $self->_enum( $node, $acc, $current_file );
                    return;
                }
                elsif ( $kind eq 'VarDecl' ) {
                    if ( ( $node->{storageClass} // '' ) ne 'static' ) { $self->_var( $node, $acc, $current_file ); }
                }
                elsif ( $kind eq 'FunctionDecl' ) {
                    $self->_func( $node, $acc, $current_file );
                    return;
                }
                elsif ( $kind eq 'BuiltinType' ) { return; }
            }
            if ( $node->{inner} ) {
                for ( @{ $node->{inner} } ) { $self->_walk( $_, $acc, $current_file ); }
            }
        }

        method _is_valid_file ($f) {
            return 0 unless defined $f && length $f;
            return 0 if $f =~ m{^/usr/(include|lib|share|local/include)};
            return 0 if $f =~ m{^/System/Library};
            return 1 if $allowed_files->{$f};
            for my $dir (@$project_dirs) { return 1 if index( $f, $dir ) == 0; }
            return 0;
        }