view release on metacpan or  search on metacpan

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

    }
    class    #
        Affix::Wrap::Member {
        use Affix qw[Void];
        field $name       : reader : param //= '';
        field $type       : reader : param //= '';
        field $doc        : reader : param //= ();
        field $definition : reader : param //= ();

        method affix_type {
            return $definition->affix_type if defined $definition;
            return $type->affix_type       if builtin::blessed($type);
            return 'Void';
        }

        method affix {
            return $definition->affix if defined $definition;
            builtin::blessed($type) ? $type->affix : Void;
        }
    }
    class    #
        Affix::Wrap::Macro : isa(Affix::Wrap::Entity) {
        field $value : reader : param //= ();
        method set_value ($v) { $value = $v }

        method affix_type {
            $value // return '';
            my $v = $value // '';
            $v =~ s/^\s+|\s+$//g;
            return '' unless length $v;
            if ( $v =~ /^-?(?:0x[\da-fA-F]+|\d+(?:\.\d+)?)$/ ) {
                return sprintf 'use constant %s => %s', $self->name, $v;
            }
            if ( $v =~ /^".*"$/ || $v =~ /^'.*'$/ ) {
                return sprintf 'use constant %s => %s', $self->name, $v;
            }
            $v =~ s/'/\\'/g;
            sprintf 'use constant %s => \'%s\'', $self->name, $v;
        }

        method affix ( $lib //= (), $pkg //= () ) {
            if ( $pkg && defined $value && length $value ) {
                my $val = $value;
                if ( $val =~ /^"(.*)"$/ || $val =~ /^'(.*)'$/ ) { $val = $1; }
                no strict 'refs';
                no warnings 'redefine';
                *{ "${pkg}::" . $self->name } = sub () {$val};
            }
            sub () {$value};
        }
        } class Affix::Wrap::Variable : isa(Affix::Wrap::Entity) {
        field $type : reader : param;
        method affix_type { sprintf 'pin my $%s, $lib, \'%s\' => %s', $self->name, $self->name, $type->affix_type }

        method affix ( $lib, $pkg //= () ) {
            if ($lib) {
                my $t = $type->affix;
                if ($pkg) {
                    no strict 'refs';

                    # Vivify package variable and bind it
                    Affix::pin( ${ "${pkg}::" . $self->name }, $lib, $self->name, $t );
                }
                else {
                    my $var;
                    Affix::pin( $var, $lib, $self->name, $t );
                    return $var;
                }
            }
            $type->affix;
        }
        } class    #
        Affix::Wrap::Typedef : isa(Affix::Wrap::Entity) {
        field $underlying : reader : param;
        method affix_type { 'typedef \'' . $self->name . '\' => ' . $underlying->affix_type }

        method affix ( $lib //= (), $pkg //= () ) {
            my $t = $underlying->affix;
            Affix::typedef $self->name, $t;

            # If the underlying type is an Enum, we must manually export the constants to the target package.
            # Affix::typedef only installs them into the *caller* (which is this class).
            if ( $pkg && builtin::blessed($t) && $t->isa('Affix::Type::Enum') ) {
                my ( $const_map, $val_map ) = $t->resolve();
                no strict 'refs';
                while ( my ( $const_name, $val ) = each %$const_map ) {
                    *{"${pkg}::${const_name}"} = sub () {$val};
                }
            }
        }
        } class Affix::Wrap::Struct : isa(Affix::Wrap::Entity) {
        field $tag     : reader : param //= 'struct';
        field $members : reader : param //= [];

        method affix_type {
            my $type_name = $tag eq 'union' ? 'Union' : 'Struct';
            sprintf '%s[ %s ]', $type_name, join( ', ', map { $_->name . ' => ' . $_->affix_type } @$members );
        }

        method affix ( $lib //= (), $pkg //= () ) {
            use Affix qw[Struct Union];
            if ( $tag eq 'union' ) {
                return Union [ map { $_->name, $_->affix } @$members ];
            }
            Struct [ map { $_->name, $_->affix } @$members ];
        }
        } class    #
        Affix::Wrap::Enum : isa(Affix::Wrap::Entity) {
        field $constants : reader : param //= [];

        method affix_type {
            my @defs;
            for my $c (@$constants) {
                if ( !defined $c->{value} ) {
                    push @defs, $c->{name};
                    next;
                }
                my $v = $c->{value} // 0;
                $v = "'$v'" if $v !~ /^-?\d+$/;
                push @defs, sprintf( '[%s => %s]', $c->{name}, $v );
            }