<commit_before>#!/usr/bin/env perl
#
# Copyright (C) 2010-2015 Red Hat, Inc.
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library.  If not, see
# <http://www.gnu.org/licenses/>.
#
# This script parses remote_protocol.x or qemu_protocol.x and produces lots of
# boilerplate code for both ends of the remote connection.
#
# The first non-option argument specifies the prefix to be searched for, and
# output to, the boilerplate code.  The second non-option argument is the
# file you want to operate on.  For instance, to generate the dispatch table
# for both remote_protocol.x and qemu_protocol.x, you would run the
# following:
#
# gendispatch.pl -t remote ../src/remote/remote_protocol.x
# gendispatch.pl -t qemu ../src/remote/qemu_protocol.x
#
# By <NAME> <<EMAIL>>
# Extended by <NAME> <<EMAIL>>

use strict;
use warnings;

use Getopt::Long;

my $mode = "debug";
my $res = GetOptions("mode=s" => \$mode);

die "cannot parse command line options" unless $res;

die "unknown mode '$mode', expecting 'client', 'server', " .
    "'aclheader', 'aclbody', 'aclsym', 'aclapi' or 'debug'"
    unless $mode =~ /^(client|server|aclheader|aclbody|aclsym|aclapi|debug)$/;

my $structprefix = shift or die "missing struct prefix argument";
my $procprefix = shift or die "missing procedure prefix argument";
my $protocol = shift or die "missing protocol argument";
my @autogen;

my $connect_ptr = $structprefix eq "admin" ? "virAdmConnectPtr" : "virConnectPtr";
my $prefix = ($structprefix eq "admin") ? "admin" : "vir";

sub fixup_name {
    my $name = shift;

    $name =~ s/Nwfilter/NWFilter/;
    $name =~ s/Xml$/XML/;
    $name =~ s/Xml2$/XML2/;
    $name =~ s/Uri$/URI/;
    $name =~ s/Uuid$/UUID/;
    $name =~ s/Id$/ID/;
    $name =~ s/Mac$/MAC/;
    $name =~ s/Cpu$/CPU/;
    $name =~ s/Os$/OS/;
    $name =~ s/Nmi$/NMI/;
    $name =~ s/Pm/PM/;
    $name =~ s/Fstrim$/FSTrim/;
    $name =~ s/Fsfreeze$/FSFreeze/;
    $name =~ s/Fsthaw$/FSThaw/;
    $name =~ s/Fsinfo$/FSInfo/;
    $name =~ s/Iothread$/IOThread/;
    $name =~ s/Scsi/SCSI/;
    $name =~ s/Wwn$/WWN/;
    $name =~ s/Dhcp$/DHCP/;

    return $name;
}

# Convert name_of_call to NameOfCall.
sub name_to_ProcName {
    my $name = shift;
    my $forcefix = $structprefix eq "admin";

    my @elems;

    if ($forcefix || $name =~ /_/ ||
        (lc $name) eq "open" || (lc $name) eq "close") {
        @elems = split /_/, $name;
        @elems = map lc, @elems;
        @elems = map ucfirst, @elems;
    } else {
        @elems = $name;
    }
    @elems = map { fixup_name($_) } @elems;
    my $procname = join "", @elems;

    return $procname;
}

sub name_to_TypeName {
    my $name = shift;

    my @elems = split /_/, $name;
    @elems = map lc, @elems;
    @elems = map ucfirst, @elems;
    @elems = map { fixup_name($_) } @elems;
    my $typename = join "", @elems;
    return $typename;
}

sub get_conn_type {
    if ($structprefix eq "admin") {
        return "virNetDaemonPtr";
    } else {
        return "virConnectPtr";
    }
}

sub get_conn_var {
    if ($structprefix eq "admin") {
        return "dmn";
    } else {
        return "conn";
    }
}

sub get_conn_method {
    my $proc = shift;
    my $args = shift;
    my $rets = shift;

    if ($structprefix eq "admin") {
        return "adminGetConn";
    }

    my @types;
    push @types, @{$args} if $args;
    push @types, @{$rets} if $rets;

    # This correctly detects most APIs
    foreach my $type (@types) {
        if ($type =~ /remote_nonnull_interface/) {
            return "remoteGetInterfaceConn";
        }
        if ($type =~ /remote_nonnull_network/) {
            return "remoteGetNetworkConn";
        }
        if ($type =~ /remote_nonnull_node_device/) {
            return "remoteGetNodeDevConn";
        }
        if ($type =~ /remote_nonnull_nwfilter/) {
            return "remoteGetNWFilterConn";
        }
        if ($type =~ /remote_nonnull_secret/) {
            return "remoteGetSecretConn";
        }
        if ($type =~ /remote_nonnull_storage/) {
            return "remoteGetStorageConn";
        }
    }

    # This is for the few virConnect APIs that
    # return things which aren't objects. eg list
    # of pool names, or number of pools.
    if ($proc =~ /Connect.*Interface/ || $proc =~ /InterfaceChange/) {
        return "remoteGetInterfaceConn";
    }
    if ($proc =~ /Connect.*Network/) {
        return "remoteGetNetworkConn";
    }
    if ($proc =~ /Node.*Device/) {
        return "remoteGetNodeDevConn";
    }
    if ($proc =~ /Connect.*NWFilter/) {
        return "remoteGetNWFilterConn";
    }
    if ($proc =~ /Connect.*Secret/) {
        return "remoteGetSecretConn";
    }
    if ($proc =~ /Connect.*Storage/) {
        return "remoteGetStorageConn";
    }

    return "remoteGetHypervisorConn";
}

# Read the input file (usually remote_protocol.x) and form an
# opinion about the name, args and return type of each RPC.
my ($name, $ProcName, $id, $flags, %calls, @calls, %opts);

my $collect_args_members = 0;
my $collect_ret_members = 0;
my $collect_opts = 0;
my $last_name;

open PROTOCOL, "<$protocol" or die "cannot open $protocol: $!";

while (<PROTOCOL>) {
    if ($collect_args_members) {
        if (/^};/) {
            $collect_args_members = 0;<commit_msg>rpc: fix dispatch for node device APIs for virt drivers<commit_after>#!/usr/bin/env perl
#
# Copyright (C) 2010-2015 Red Hat, Inc.
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library.  If not, see
# <http://www.gnu.org/licenses/>.
#
# This script parses remote_protocol.x or qemu_protocol.x and produces lots of
# boilerplate code for both ends of the remote connection.
#
# The first non-option argument specifies the prefix to be searched for, and
# output to, the boilerplate code.  The second non-option argument is the
# file you want to operate on.  For instance, to generate the dispatch table
# for both remote_protocol.x and qemu_protocol.x, you would run the
# following:
#
# gendispatch.pl -t remote ../src/remote/remote_protocol.x
# gendispatch.pl -t qemu ../src/remote/qemu_protocol.x
#
# By <NAME> <<EMAIL>>
# Extended by <NAME> <<EMAIL>>

use strict;
use warnings;

use Getopt::Long;

my $mode = "debug";
my $res = GetOptions("mode=s" => \$mode);

die "cannot parse command line options" unless $res;

die "unknown mode '$mode', expecting 'client', 'server', " .
    "'aclheader', 'aclbody', 'aclsym', 'aclapi' or 'debug'"
    unless $mode =~ /^(client|server|aclheader|aclbody|aclsym|aclapi|debug)$/;

my $structprefix = shift or die "missing struct prefix argument";
my $procprefix = shift or die "missing procedure prefix argument";
my $protocol = shift or die "missing protocol argument";
my @autogen;

my $connect_ptr = $structprefix eq "admin" ? "virAdmConnectPtr" : "virConnectPtr";
my $prefix = ($structprefix eq "admin") ? "admin" : "vir";

sub fixup_name {
    my $name = shift;

    $name =~ s/Nwfilter/NWFilter/;
    $name =~ s/Xml$/XML/;
    $name =~ s/Xml2$/XML2/;
    $name =~ s/Uri$/URI/;
    $name =~ s/Uuid$/UUID/;
    $name =~ s/Id$/ID/;
    $name =~ s/Mac$/MAC/;
    $name =~ s/Cpu$/CPU/;
    $name =~ s/Os$/OS/;
    $name =~ s/Nmi$/NMI/;
    $name =~ s/Pm/PM/;
    $name =~ s/Fstrim$/FSTrim/;
    $name =~ s/Fsfreeze$/FSFreeze/;
    $name =~ s/Fsthaw$/FSThaw/;
    $name =~ s/Fsinfo$/FSInfo/;
    $name =~ s/Iothread$/IOThread/;
    $name =~ s/Scsi/SCSI/;
    $name =~ s/Wwn$/WWN/;
    $name =~ s/Dhcp$/DHCP/;

    return $name;
}

# Convert name_of_call to NameOfCall.
sub name_to_ProcName {
    my $name = shift;
    my $forcefix = $structprefix eq "admin";

    my @elems;

    if ($forcefix || $name =~ /_/ ||
        (lc $name) eq "open" || (lc $name) eq "close") {
        @elems = split /_/, $name;
        @elems = map lc, @elems;
        @elems = map ucfirst, @elems;
    } else {
        @elems = $name;
    }
    @elems = map { fixup_name($_) } @elems;
    my $procname = join "", @elems;

    return $procname;
}

sub name_to_TypeName {
    my $name = shift;

    my @elems = split /_/, $name;
    @elems = map lc, @elems;
    @elems = map ucfirst, @elems;
    @elems = map { fixup_name($_) } @elems;
    my $typename = join "", @elems;
    return $typename;
}

sub get_conn_type {
    if ($structprefix eq "admin") {
        return "virNetDaemonPtr";
    } else {
        return "virConnectPtr";
    }
}

sub get_conn_var {
    if ($structprefix eq "admin") {
        return "dmn";
    } else {
        return "conn";
    }
}

sub get_conn_method {
    my $proc = shift;
    my $args = shift;
    my $rets = shift;

    if ($structprefix eq "admin") {
        return "adminGetConn";
    }

    my @types;
    push @types, @{$args} if $args;
    push @types, @{$rets} if $rets;

    # This correctly detects most APIs
    foreach my $type (@types) {
        if ($type =~ /remote_nonnull_interface/) {
            return "remoteGetInterfaceConn";
        }
        if ($type =~ /remote_nonnull_network/) {
            return "remoteGetNetworkConn";
        }
        if ($type =~ /remote_nonnull_node_device/) {
            return "remoteGetNodeDevConn";
        }
        if ($type =~ /remote_nonnull_nwfilter/) {
            return "remoteGetNWFilterConn";
        }
        if ($type =~ /remote_nonnull_secret/) {
            return "remoteGetSecretConn";
        }
        if ($type =~ /remote_nonnull_storage/) {
            return "remoteGetStorageConn";
        }
    }

    # This is for the few virConnect APIs that
    # return things which aren't objects. eg list
    # of pool names, or number of pools.
    if ($proc =~ /Connect.*Interface/ || $proc =~ /InterfaceChange/) {
        return "remoteGetInterfaceConn";
    }
    if ($proc =~ /Connect.*Network/) {
        return "remoteGetNetworkConn";
    }
    # Carefully whitelist a few APIs with NodeDevice name
    # prefix which actually get handled by the virt drivers
    if ($proc =~ /Node.*Device/ &&
        !($proc =~ /NodeDeviceReset/ ||
          $proc =~ /NodeDeviceReAttach/ ||
          $proc =~ /NodeDeviceDettach/ ||
          $proc =~ /NodeDeviceDetachFlags/)) {
        return "remoteGetNodeDevConn";
    }
    if ($proc =~ /Connect.*NWFilter/) {
        return "remoteGetNWFilterConn";
    }
    if ($proc =~ /Connect.*Secret/) {
        return "remoteGetSecretConn";
    }
    if ($proc =~ /Connect.*Storage/) {
        return "remoteGetStorageConn";
    }

    return "remoteGetHypervisorConn";
}

# Read the input file (usually remote_protocol.x) and form an
# opinion about the name, args and return type of each RPC.
my ($name, $ProcName, $id, $flags, %calls, @calls, %opts);

my $collect_args_members = 0;
my $collect_ret_members = 0;
my $collect_opts = 0;
my $last_name;

open PROTOCOL, "<$protocol" or die "cannot open $protocol: $!";

while (<PROTOCOL>) {
    if ($collect_args_members) {
        if (/^};/) {
            $collect_args_members = 0;
{'fraction_non_alphanumeric': 0.139943153318843, 'fraction_numerical': 0.002675137936799866, 'mean_word_length': 2.72099533437014, 'pattern_counts': {'":': 0, '<': 21, '<?xml version=': 0, '>': 21, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4083718', 'n_tokens_mistral': 4122, 'n_tokens_neox': 3979, 'n_words': 1221}