fill-templates

#!/usr/bin/env perl

use v5.20;
use warnings FATAL => 'uninitialized';
use experimental 'signatures';

use JSON::PP;
use List::Util qw(any none max);
use Scalar::Util qw(reftype);

use Protocol::Sys::Virt::Devel qw(extract_all);


unless (scalar(@ARGV) == 3) {
    say 'Usage: fill-templates [libvirt-tag] [version] [Protocol::Sys::Virt-version]';
    exit 0;
}


my $tag             = $ARGV[0];
my $version         = $ARGV[1];
my $dep_psv_version = $ARGV[2];

my @skipped_entrypoints;
my @manual_entrypoints;
my @whitelisted_entrypoints = qw(
    REMOTE_PROC_CONNECT_GET_ALL_DOMAIN_STATS
    REMOTE_PROC_CONNECT_GET_TYPE
    REMOTE_PROC_CONNECT_GET_URI
    REMOTE_PROC_CONNECT_LIST_DOMAINS
    REMOTE_PROC_DOMAIN_AUTHORIZED_SSH_KEYS_GET
    REMOTE_PROC_DOMAIN_AUTHORIZED_SSH_KEYS_SET
    REMOTE_PROC_DOMAIN_GET_DISK_ERRORS
    REMOTE_PROC_DOMAIN_GET_FSINFO
    REMOTE_PROC_DOMAIN_GET_GUEST_INFO
    REMOTE_PROC_DOMAIN_GET_JOB_STATS
    REMOTE_PROC_DOMAIN_GET_MESSAGES
    REMOTE_PROC_DOMAIN_GET_SCHEDULER_TYPE
    REMOTE_PROC_DOMAIN_GET_STATE
    REMOTE_PROC_DOMAIN_INTERFACE_ADDRESSES
    REMOTE_PROC_DOMAIN_MEMORY_STATS
    REMOTE_PROC_DOMAIN_RENAME
    );

# These require cpumap handling, which needs further research
#    REMOTE_PROC_DOMAIN_GET_VCPUS
#    REMOTE_PROC_DOMAIN_GET_VCPU_PIN_INFO

my @blacklist_typed_param_string_okay = qw(
    REMOTE_PROC_DOMAIN_GET_JOB_STATS
    );

sub contents {
    my ($fn) = @_;
    local $/;
    open my $fh, '<:encoding(UTF-8)', $fn;
    <$fh>;
}

sub find_toplevel_definition {
    my ($ast, $name) = @_;
    for my $def (@{ $ast } ) {
        next if $def->{def} eq 'passthrough';
        next if $def->{def} eq 'preprocessor';

        return $def
            if $def->{name}->{content} eq $name;
    }
    return;
}

my %module = (
    remote_nonnull_domain => 'Domain',
    remote_nonnull_domain_checkpoint => 'DomainCheckpoint',
    remote_nonnull_domain_snapshot => 'DomainSnapshot',
    remote_nonnull_network => 'Network',
    remote_nonnull_network_port => 'NetworkPort',
    remote_nonnull_nwfilter => 'NwFilter',
    remote_nonnull_nwfilter_binding => 'NwFilterBinding',
    remote_nonnull_interface => 'Interface',
    remote_nonnull_storage_pool => 'StoragePool',
    remote_nonnull_storage_vol => 'StorageVol',
    remote_nonnull_node_device => 'NodeDevice',
    remote_nonnull_secret => 'Secret',
    );

my $main_module = 'Client';
my @other_modules = qw(
    Callback Stream Connection ConnectionFactory
    ConnectionLocal ConnectionProcess ConnectionSSH );

my %prefix_strip_xdr = (
    Client => qr/^connect_/,
    Domain => qr/^domain_/,
    DomainCheckpoint => qr/^domain_(checkpoint_)?/,
    DomainSnapshot => qr/^domain_(snapshot_)?/,
    Network => qr/^network_/,
    NetworkPort => qr/^network_port_/,
    NwFilter => qr/^nwfilter_/,
    NwFilterBinding => qr/^nwfilter_binding_/,
    Interface => qr/^interface_/,
    StoragePool => qr/^storage_(pool_)?/,
    StorageVol => qr/^storage_(vol_)?/,
    NodeDevice => qr/^node_device_/,
    Secret => qr/^secret_/,
    );



sub _named_type_name {
    my $type = shift;
    if ($type->{spec} eq 'named') {
        return $type->{name}->{content};
    }
    return undef;
}

sub _retvals {
    my ($struct) = @_;
    return (
        map { +{ name => $_->{name}->{content},
                 type => _named_type_name( $_->{declaration}->{type} ),
                 declaration => $_->{declaration} } }
        @{ $struct ? $struct->{definition}->{type}->{declaration}->{members} : [] }
        );
}

sub _retval_mapper {
    my ($ast, @retvals) = @_;

    my %mapped_retvals;
    for my $retval (@retvals) {
        if ($retval->{type}
            and $module{$retval->{type}}) {
            $mapped_retvals{$retval->{name}} = $retval->{type};
        }
        elsif ($retval->{type}
               and $retval->{type} =~ m/_msg$/
               and my $nested_msgstruct = find_toplevel_definition($ast, $retval->{type})) {
            my %submap = _retval_mapper($ast, _retvals($nested_msgstruct));
            $mapped_retvals{$retval->{name}} = \%submap if %submap;
        }
    }

    return %mapped_retvals;
}

sub _retval_map {
    my $map = shift;
    my @rv = ();
    for my $key ( sort keys %{ $map } ) {
        if (ref $map->{$key} and reftype $map->{$key} eq 'HASH') {
            push @rv, "$key => " . _retval_map( $map->{$key} );
        }
        else {
            push @rv, "$key => \\&_translate_$map->{$key}";
        }
    }

    return '{ ' . join(', ', @rv) . ' }';
}

sub _version_replacements {
    my $xdr_parse_version = shift // '';
    $_[0] =~ s/__XDR_PARSE_VERSION__/$xdr_parse_version/g;
    $_[0] =~ s/__P::S::V::VERSION__/$dep_psv_version/g;
    $_[0] =~ s/__VERSION__/$version/g;
    $_[0] =~ s/__LIBVIRT_TAG__/$tag/g;
}

my %varname = (
    Client => 'client',
    Domain => 'dom',
    DomainCheckpoint => 'checkpoint',
    DomainSnapshot => 'snapshot',
    Network => 'net',
    NetworkPort => 'port',
    NwFilter => 'filter',
    NwFilterBinding => 'binding',
    Interface => 'iface',
    StoragePool => 'pool',
    StorageVol => 'vol',
    NodeDevice => 'dev',
    Secret => 'secret',
    );

sub ep_pod($mod, $ep, $c_api_defs) {
    my $argstr = ($ep->{argstr} =~ s/^\$self$|\$self, //r);
    $argstr = $argstr ? "( $argstr )" : '';
    my $retstr = ($ep->{retstr} =~ s/{\s*}/(* no data *)/r);
    ### Return a stream, somehow...
    my $retstream = $ep->{retstream} ? 'Returns a stream' : '';
    my $doc_url = '';
    if (my $c_ep = $c_api_defs->{$ep->{identifier}}) {
        my $basename = ($c_ep->{header} =~ s|^.*/||r);
        my $url = "https://libvirt.org/html/libvirt-${basename}tml#$c_ep->{name}";
        $doc_url = <<~POD;

        See documentation of L<$c_ep->{name}|$url>.
        POD
    }
    if (length $retstr > 50) {
        $retstr =~ s/, /,\n  #      /g;
    }
    if (@{$ep->{ret}} == 0 and $ep->{retstream}) {
        return <<~POD;
          =head2 $ep->{name}

            \$stream = await \$$varname{$mod}->$ep->{name}$argstr;
          $doc_url
          POD
    }
    elsif (@{$ep->{ret}} == 1 and $ep->{retstream} and $ep->{ret_unwrap}) {
        return <<~POD;
          =head2 $ep->{name}

            ( \$$ep->{ret_unwrap}, \$stream ) = await \$$varname{$mod}->$ep->{name}$argstr;
          $doc_url
          POD
    }
    elsif ($ep->{retstream}) {
        return <<~POD;
          =head2 $ep->{name}

            await \$$varname{$mod}->$ep->{name}$argstr;
            # -> ( $retstr, \$stream )
          $doc_url
          POD
    }
    elsif (not $ep->{ret_unwrap}) {
        return <<~POD;
          =head2 $ep->{name}

            await \$$varname{$mod}->$ep->{name}$argstr;
            # -> $retstr
          $doc_url
          POD
    }
    else {
        return <<~POD;
          =head2 $ep->{name}

            \$$ep->{ret_unwrap} = await \$$varname{$mod}->$ep->{name}$argstr;
          $doc_url
          POD
    }
}

sub harvest_manual_entrypoints($template, $mod) {
    my @manual_entrypoints;
    my $tmpl = contents( $template . $mod . '.pm.tmpl' );
    while ($tmpl =~ m/^#\s*ENTRYPOINT:\s*([a-zA-Z0-9_]+)/gm) {
        push @manual_entrypoints, $1;
    }
    return @manual_entrypoints;
}

sub unimplemented_pod() {
    my @sorted = (
        sort { $a->{name} cmp $b->{name} }
        grep { my $x = $_->{name}; none { $_ eq $x } @manual_entrypoints }
        @skipped_entrypoints
        );
    my %reasons = map { $_->{reason} => 1 } @sorted;
    my @reasons = sort keys %reasons;
    return join("\n\n",
                "=over 8",
                (map {
                    my $reason = $_;

                    "=item * $_\n\n=over 8\n\n"
                        . join( "\n\n",
                                map { "=item * $_->{name}" }
                                grep { $_->{reason} eq $reason }
                                @sorted)
                        . "\n\n=back\n\n"
                 } @reasons),
                "=back");
}

sub expand_mod_template($template, $mod, $h_syms, $module_functions, $translators, $c_api_defs, $xdr_parse_version) {
    my $tmpl = contents( $template . $mod . '.pm.tmpl' );
    my $calls = join("\n",
                     map { $_->{code} }
                     sort { $a->{name} cmp $b->{name} }
                     @{ $module_functions->{$mod} });
    my $entrypoints_pod =
        join("\n",
             map { ep_pod($mod, $_, $c_api_defs) }
             sort { $a->{name} cmp $b->{name} }
             grep { $_->{name} !~ m/^_/ }
             @{ $module_functions->{$mod} });
    my $private_ep_pod =
        join('',
             map { "=head2 $_->{name}\n\n" }
             sort { $a->{name} cmp $b->{name} }
             grep { $_->{name} =~ m/^_/ }
             @{ $module_functions->{$mod} });
    my $skipped_pod = unimplemented_pod();
    my @constants = grep { $_->{mod} eq $mod } @{ $h_syms };
    my $max = max map { length $_->{sym} } @constants;
    my $constants = join("\n    ",
                         map {
                             sprintf("%-${max}s => %s,", $_->{sym}, $_->{resolved})
                         } @constants);
    $constants = <<~CONSTANTS if $constants;
    use constant {
        $constants
    };
    CONSTANTS

    my $constants_pod = join("\n\n", map { "=item $_->{sym}" } @constants);
    _version_replacements( $xdr_parse_version, $tmpl );
    $tmpl =~ s/__REPLY_TRANSLATORS__/$translators/;
    $tmpl =~ s/__CALLS__/$calls/;
    $tmpl =~ s/__CONSTANTS__/$constants/;
    $tmpl =~ s/__ENTRYPOINTS__/$entrypoints_pod/;
    $tmpl =~ s/__PRIVATE_EPS__/$private_ep_pod/;
    $tmpl =~ s/__CONSTANTS_POD__/$constants_pod/;
    $tmpl =~ s/__UNIMPLEMENTED__/$skipped_pod/;

    my $out;
    if ($mod eq $main_module) {
        $out = 'lib/Sys/Async/Virt.pm';
    }
    else {
        $mod =~ s#^Connection(?!(\.|$))#Connection/#;
        $out = "lib/Sys/Async/Virt/$mod.pm";
    }
    open my $fh, '>', $out
        or die "$!";
    print $fh $tmpl;
}

sub proc_msg($proc, $module_returns, $msgstruct, $ast, $proc_value) {
    my $proc_annotation = proc_annotation($proc);
    if ($proc_annotation !~ m/\@generate: (both|client)/) {
        return;
    }
    my @retvals = _retvals( $msgstruct );
    my %mapped_retvals = _retval_mapper($ast, @retvals);
    my $mapstr = _retval_map( \%mapped_retvals );
    $module_returns->[$proc_value] =
        qq|sub { $proc_value; my \$client = shift; _translated_msg(\$client, $mapstr, \@_) }|;
}

sub proc_annotation($proc) {
    return join("\n",
                map { $_->{content} }
                @{ $proc->{comments} } );
}

sub proc_call_retstr($retstream, $ret_unwrap, @retvals) {
    if ($retstream and @retvals == 0) {
        return '$stream';
    }
    elsif ($retstream) {
        return '( ' . proc_call_retstr('', $ret_unwrap, @retvals) . ', $stream )';
    }
    elsif (not $ret_unwrap) {
        return ('{ ' . join(', ',
                            map { $_ . ' => $' . $_ }
                            sort map { $_->{name} }  @retvals) . ' }');
    }
    else {
        return "\$$ret_unwrap";
    }
}

sub proc_call($ast, $proc, $module_functions, $module_returns, $proc_value, $struct_basename, $c_api_defs) {
    my $proc_annotation = proc_annotation($proc);
    if ($proc_annotation !~ m/\@generate:\s*(both|client|server|none)/) {
        die "Unexpected generator target for $proc->{name}->{content}";
    }
    my $generator_target = $1;
    my $callstruct_name = $struct_basename . '_args';
    my $callstruct = find_toplevel_definition($ast, $callstruct_name);
    my @callargs = _retvals( $callstruct );
    my $header =
        $c_api_defs->{$proc->{name}->{content}}->{header} // '';
    if (not ($generator_target eq 'client'
             or $generator_target eq 'both')
        and none { $proc->{name}->{content} eq $_ } @whitelisted_entrypoints) {
        # skip stream-related entrypoints for now
        $module_returns->[$proc_value] = '\&_no_translation';

        my $proc_name = $proc->{name}->{content};
        # return if $proc_name =~ m/_(EVENT|AUTH)_|CLOSE_CALLBACK/;

        my $nparams = grep { $_->{name} eq 'nparams' } @callargs;
        my $needresults = grep { $_->{name} eq 'need_results' } @callargs;
        unless ($needresults or $nparams) {
            my $header =
                $c_api_defs->{$proc->{name}->{content}}->{header} // '';
            if ($header) {
                $header = " ($header)";
            }
            push @skipped_entrypoints, {
                name => $proc_name,
                reason => "\@generate: $generator_target$header",
            };
            return;
        }
    }
    my $func = ($struct_basename =~ s/^remote_//r);
    my $retstruct_name = $struct_basename . '_ret';
    my $retstruct = find_toplevel_definition($ast, $retstruct_name);
    my ($retstream) = ($proc_annotation =~ m/@(read|write)stream:/);
    my $into_module = $main_module;

    my @retvals  = _retvals( $retstruct );

    my $first_call_arg = @callargs ? $callargs[0] : undef;
    if ($first_call_arg) {
        my $first_arg_type_name = $first_call_arg->{type} // '__unmapped__';
        $first_arg_type_name = '__unmapped__' if $first_call_arg->{declaration}->{array};
        $into_module = $module{$first_arg_type_name} // $main_module;
    }

    # gendispatch.pl says 'node_device' is special
    if ($func =~ m/^node_device_/
        and $func !~ m/^node_device_(lookup_(by_name|scsi_host_by_wwn)_|(create|define)_xml_)/) {
        $into_module = $module{remote_nonnull_node_device};
    }

    my $entrypoint = ($func =~ s/$prefix_strip_xdr{$into_module}//r);
    $entrypoint = '_' . $entrypoint
        if $header =~ m/internal/i;
    my $pod_remarks = '';
    if (any { $_->{name} eq 'ret' } @retvals) {
        # list functions have a 'ret' and an array; simply return the array,
        # Perl *knows* how long the array is...
        @retvals = grep { $_->{name} ne 'ret' } @retvals;
        $pod_remarks .= <<~'POD';

          B<Remark:> This function differs from the LibVirt API in that it
          discards the C<ret> parameter in the return structure; the value
          of it is embedded in the length of the returned array.
          POD
    }
    if (any { $_->{name} eq 'nparams' } @retvals) {
        @retvals = grep { $_->{name} ne 'nparams' } @retvals;
        $pod_remarks .= <<~'POD';

          B<Remark:> This function differs from the LibVirt API in that it
          discards the C<nparams> parameter in the return structure; the value
          of it is embedded in the length of the returned array.
          POD
    }
    if (any { $_->{name} eq 'nerrors' } @retvals) {
        @retvals = grep { $_->{name} ne 'nerrors' } @retvals;
        $pod_remarks .= <<~'POD';

          B<Remark:> This function differs from the LibVirt API in that it
          discards the C<nerrors> parameter in the return structure; the value
          of it is embedded in the length of the returned array.
          POD
    }
    my $ret_unwrap = (@retvals == 1 ? $retvals[0]->{name} : '');
    push @{ $module_functions->{$into_module} //= [] }, {
        name => $entrypoint,
        const => proc_const($proc),
        generator => $generator_target,
        identifier => $proc->{name}->{content},
        args => \@callargs,
        ret  => \@retvals,
        retstream => $retstream,
        retstr => proc_call_retstr($retstream, $ret_unwrap, @retvals),
        ret_unwrap => $ret_unwrap,
    };
    my %mapped_retvals;
    for my $retval (@retvals) {
        if ($retval->{type}
            and $module{$retval->{type}}) {
            $mapped_retvals{$retval->{name}} = $retval->{type};
        }
    }
    if (%mapped_retvals or $ret_unwrap) {
        my $mapstr = join(', ',
                          map { "$_ => \\&_translate_$mapped_retvals{$_}" }
                          sort keys %mapped_retvals);
        $ret_unwrap = $ret_unwrap ? "'$ret_unwrap'" : 'undef';
        $module_returns->[$proc_value] =
            qq|sub { $proc_value; my \$client = shift; _translated_reply(\$client, undef, { $mapstr }, \@_) }|;
    }
    else {
        $module_returns->[$proc_value] = '\&_no_translation';
    }
}

sub proc_const($proc) {
    return ($proc->{name}->{content} =~ s/^REMOTE_//r);
}

my %args_defaults = (
    'flags' => { '*' => '0' },
    );

my %fixed_args = (
#    'maplen' => {
#        get_vcpus => '$remote->CPUMAPS_MAX',
#    },
    'maxcells' => {
        node_get_cells_free_memory => '$remote->NODE_MAX_CELLS',
    },
    'maxerrors' => {
        get_disk_errors => '$remote->DOMAIN_DISK_ERRORS_MAX',
    },
    'maxids' => {
        list_domains => '$remote->DOMAIN_LIST_MAX',
    },
    'maxinfo' => {
        get_vcpus => '$remote->VCPUINFO_MAX',
    },
    'maxStats' => {
        memory_stats => '$remote->DOMAIN_MEMORY_STATS_MAX',
    },
    'maxnames' => {
        list_children_names => '$remote->DOMAIN_SNAPSHOT_LIST_MAX',
        snapshot_list_names => '$remote->DOMAIN_SNAPSHOT_LIST_MAX',
        list_defined_domains => '$remote->DOMAIN_LIST_MAX',
        list_defined_interfaces => '$remote->INTERFACE_LIST_MAX',
        list_defined_networks => '$remote->NETWORK_LIST_MAX',
        list_defined_storage_pools => '$remote->STORAGE_POOL_LIST_MAX',
        list_interfaces => '$remote->INTERFACE_LIST_MAX',
        list_networks => '$remote->NETWORK_LIST_MAX',
        list_nwfilters => '$remote->NWFILTER_LIST_MAX',
        list_storage_pools => '$remote->STORAGE_POOL_LIST_MAX',
        list_caps => '$remote->NODE_DEVICE_CAPS_LIST_MAX',
        node_list_devices => '$remote->NODE_DEVICE_LIST_MAX',
        list_volumes => '$remote->STORAGE_VOL_LIST_MAX',
    },
    'maxuuids' => {
        list_secrets => '$remote->SECRET_LIST_MAX',
    },
    'need_results' => {
        list_all_children => '$remote->DOMAIN_CHECKPOINT_LIST_MAX',
        list_all_checkpoints => '$remote->DOMAIN_CHECKPOINT_LIST_MAX',
        list_all_snapshots => '$remote->DOMAIN_SNAPSHOT_LIST_MAX',
        list_all_children => '$remote->DOMAIN_SNAPSHOT_LIST_MAX',
        get_cpu_model_names => '$remote->CPU_MODELS_MAX',
        list_all_domains => '$remote->DOMAIN_LIST_MAX',
        list_all_interfaces => '$remote->INTERFACE_LIST_MAX',
        list_all_networks => '$remote->NETWORK_LIST_MAX',
        list_all_node_devices => '$remote->NODE_DEVICE_LIST_MAX',
        list_all_nwfilter_bindings => '$remote->NWFILTER_BINGING_LIST_MAX',
        list_all_nwfilters => '$remote->NWFILTER_LIST_MAX',
        list_all_secrets => '$remote->SECRET_LIST_MAX',
        list_all_storage_pools => '$remote->STORAGE_POOL_LIST_MAX',
        get_dhcp_leases => '$remote->NETWORK_DHCP_LEASES_MAX',
        list_all_ports => '$remote->NETWORK_PORT_LIST_MAX',
        list_all_volumes => '$remote->STORAGE_VOL_LIST_MAX',
    },
    'nparams' => {
        node_get_cpu_stats => '$remote->NODE_CPU_STATS_MAX',
        node_get_memory_stats => '$remote->NODE_MEMORY_STATS_MAX',
        get_scheduler_parameters => '$remote->DOMAIN_SCHEDULER_PARAMETERS_MAX',
        get_scheduler_parameters_flags => '$remote->DOMAIN_SCHEDULER_PARAMETERS_MAX',
        get_blkio_parameters => '$remote->DOMAIN_BLKIO_PARAMETERS_MAX',
        get_memory_parameters => '$remote->DOMAIN_MEMORY_PARAMETERS_MAX',
        get_numa_parameters => '$remote->DOMAIN_NUMA_PARAMETERS_MAX',
        block_stats_flags => '$remote->DOMAIN_BLOCK_STATS_PARAMETERS_MAX',
        get_interface_parameters => '$remote->DOMAIN_INTERFACE_PARAMETERS_MAX',
        get_block_io_tune => '$remote->DOMAIN_BLOCK_IO_TUNE_PARAMETERS_MAX',
        get_cpu_stats => '$remote->DOMAIN_GET_CPU_STATS_MAX',
        node_get_memory_parameters => '$remote->NODE_MEMORY_PARAMETERS_MAX',
        node_get_sev_info => '$remote->NODE_SEV_INFO_MAX',
        get_parameters => '$remote->NETWORK_PORT_PARAMETERS_MAX',
});

sub proc_ep_argstring($ep_name, @argnames) {
    my $maybe_optional = 1;
    return join(', ',
                reverse map {
                    if ($maybe_optional
                        and $args_defaults{$_}
                        and (defined $args_defaults{$_}->{$ep_name}
                             or defined  $args_defaults{$_}->{'*'})) {
                        '$' . $_ . ' = ' . ($args_defaults{$_}->{$ep_name}
                                            // $args_defaults{$_}->{'*'});
                    }
                    else {
                        $maybe_optional = 0;
                        '$' . $_;
                    }
                }
                reverse grep {
                    not ($fixed_args{$_} and (defined $fixed_args{$_}->{$ep_name}
                                              or defined $fixed_args{$_}->{'*'}))
                }  @argnames);
}

sub proc_ep_argsmap($ep_name, $options, @argnames) {
    $options //= {};
    my $overrides = $options->{override} // {};
    my @args = map {
        if ($fixed_args{$_} and (defined $fixed_args{$_}->{$ep_name}
                                 or defined $fixed_args{$_}->{'*'})) {
            $_ . ' => ' . ($overrides->{$_}
                           // $fixed_args{$_}->{$ep_name}
                           // $fixed_args{$_}->{'*'});
        }
        else {
            $_ . ' => ' . ($overrides->{$_}
                           // ('$' . $_ . ($_ eq 'flags' ? ' // 0' : '')));
        }
    }
    @argnames;

    if ($options->{first_arg_name}) {
        unshift @args, ($options->{first_arg_name} . ' => $self->{id}');
    }
    return join(', ', @args);
}

sub proc_ep_flag_typed_param_string_okay($is_main, $entrypoint) {
    if (any { $_->{name} eq 'flags' } @{ $entrypoint->{args} }
        and (any { $_->{type} and $_->{type} eq 'remote_typed_param' } @{ $entrypoint->{ret} })
        and (none { $_ eq $entrypoint->{identifier} } @blacklist_typed_param_string_okay)) {
        if ($is_main) {
            return '$flags |= await $self->_typed_param_string_okay();';
        }
        else {
            return '$flags |= await $self->{client}->_typed_param_string_okay();';
        }
    }
    else {
        return '';
    }
}

sub proc_ep_filter_typed_param_string($is_main, $entrypoint) {
    return join(
        "\n    ",
        map {
            if ($is_main) {
                "\$$_->{name} = await \$self->_filter_typed_param_string( \$$_->{name} );";
            }
            else {
                "\$$_->{name} = await \$self->{client}->_filter_typed_param_string( \$$_->{name} );";
            }
        }
        grep { $_->{type} and $_->{type} eq 'remote_typed_param' }
        @{ $entrypoint->{args} }
        );
}

sub proc_entrypoint($module, $entrypoint) {
    my $is_main = ($module eq $main_module);
    my (@argnames) = map { $_->{name} } @{ $entrypoint->{args} };
    my $first_arg_name = (not $is_main) ? shift(@argnames) : '';
    my $query_nparams =
        (($entrypoint->{generator} !~ m/^(client|both)$/)
         and grep { $_ eq 'nparams' } @argnames);
    my $argstr = proc_ep_argstring($entrypoint->{name}, 'self', @argnames);
    my $argsmap_options = {
        first_arg_name => $first_arg_name,
        ($query_nparams ? ( override => { nparams => '$nparams' } ) : ()),
    };
    my $argsmap =
        proc_ep_argsmap($entrypoint->{name}, $argsmap_options, @argnames);
    my $modify_flags =
        proc_ep_flag_typed_param_string_okay($is_main, $entrypoint);
    my $filter_params =
        proc_ep_filter_typed_param_string($is_main, $entrypoint);
    my $ret_unwrap = $entrypoint->{ret_unwrap};
    my ($async, $await) = ($modify_flags or $filter_params
                           or $ret_unwrap or $query_nparams)
        ? ('async ', 'await ')
        : ('', '');
    my $call = $is_main ? '$self->_call' : '$self->{client}->_call';
    my $stream =
        $entrypoint->{retstream} ? ", stream => '$entrypoint->{retstream}'" : '';
    my $empty =
        (@{ $entrypoint->{ret} } == 0) ? ", empty => 1" : '';

    $entrypoint->{argstr} = $argstr;
    $ret_unwrap = ", unwrap => '$ret_unwrap'"
        if $ret_unwrap;
    my $nparams = '';
    if ($query_nparams) {
        my $nparams_argsmap =
            proc_ep_argsmap($entrypoint->{name},
                            { first_arg_name => $first_arg_name,
                              override => { nparams => 0 } },
                            @argnames);
        $nparams = <<~PROC;
            my \$nparams = await $call(
                    \$remote->$entrypoint->{const},
                    { $nparams_argsmap }, unwrap => 'nparams' );
            PROC
    }
    my $result = '';
    my $return = <<~RETURN;
         ${await}$call(
                 \$remote->$entrypoint->{const},
                 { $argsmap }$ret_unwrap$stream$empty )
         RETURN
    chomp $return;
    $entrypoint->{code} = (<<~PROC =~ s/^\s*\n//mgr);
        ${async}sub $entrypoint->{name}($argstr) {
            $modify_flags
            $filter_params
            $nparams
            $result
            return $return;
        }
        PROC
}

sub client($xdr_parse_version, $ast, $template, $h_syms, $c_api_defs) {
    my $procs = find_toplevel_definition($ast, 'remote_procedure');
    my @entrypoints;
    my (%module_functions, @module_returns); # returns are always in the client!

    for my $proc ( @{ $procs->{definition}->{type}->{declaration}->{elements} } ) {
        my $proc_name = $proc->{name}->{content};
        my $proc_value = $proc->{value}->{content};
        my $struct_basename = lc($proc_name =~ s/_PROC//r);

        if (my $msgstruct = find_toplevel_definition($ast, $struct_basename . '_msg')) {
            proc_msg($proc, \@module_returns, $msgstruct, $ast, $proc_value);
        }
        else {
            proc_call($ast, $proc, \%module_functions, \@module_returns, $proc_value,
                      $struct_basename, $c_api_defs);
        }
    }
    for my $key ( sort keys %module_functions ) {
        $module_functions{$key} = [ sort @{ $module_functions{$key} } ];
    }
    for my $module ( sort keys %module_functions ) {
        for my $entrypoint ( @{ $module_functions{$module} } ) {
            proc_entrypoint( $module, $entrypoint );
        }
    }

    my $translators = join(",\n    ", map { $_ // 'undef'} @module_returns);

    for my $mod ($main_module, @other_modules, values %module) {
        push @manual_entrypoints, harvest_manual_entrypoints($template, $mod);
    }
    for my $mod ($main_module, @other_modules, values %module) {
        expand_mod_template($template,
                            $mod,
                            $h_syms,
                            \%module_functions,
                            $translators,
                            $c_api_defs,
                            $xdr_parse_version);
    }
}

if (-d 'libvirt') {
    say "Deleting libvirt/...";
    system 'rm -rf libvirt/';
}
if (not -d '../libvirt') {
    system "git clone --depth 50 -b $tag  https://gitlab.com/libvirt/libvirt/ ../libvirt";
}


my $api_data    = extract_all( '../libvirt/' );
my $ast         = $api_data->{ast}->{remote};
my $header_syms = $api_data->{header_syms};
my $c_api_defs  = $api_data->{proc_entrypoints};

client($api_data->{xdr_parse_version},
       $ast,
       'templates/',
       $header_syms,
       $c_api_defs);

say (scalar @skipped_entrypoints - scalar @manual_entrypoints);