[libvirt] [PATCH] Remove tabs from all perl files & enforce this

From: "Daniel P. Berrange" <berrange(a)redhat.com&gt; The cfg.mk file rule to check for tab characters was not applied to perl files. Much of our Perl code is full of tabs as a result. Kill them, kill them all ! --- build-aux/augeas-gentest.pl | 42 +++---- cfg.mk | 2 +- docs/hvsupport.pl | 268 +++++++++++++++++++++---------------------- docs/todo.pl | 42 +++---- src/check-symfile.pl | 4 +- src/dtrace2systemtap.pl | 104 ++++++++--------- src/rpc/gendispatch.pl | 180 ++++++++++++++--------------- src/rpc/genprotocol.pl | 106 ++++++++--------- src/rpc/gensystemtap.pl | 48 ++++---- tests/oomtrace.pl | 6 +- 10 files changed, 401 insertions(+), 401 deletions(-) diff --git a/build-aux/augeas-gentest.pl b/build-aux/augeas-gentest.pl index a5f9fd3..607ea20 100755 --- a/build-aux/augeas-gentest.pl +++ b/build-aux/augeas-gentest.pl @@ -41,28 +41,28 @@ open TEMPLATE, "<", $template or die "cannot read $template: $!"; my $group = 0; while (<TEMPLATE>) { if (/::CONFIG::/) { - my $group = 0; - print AUGTEST " let conf = \""; - while (<CONFIG>) { - if (/^#\w/) { - s/^#//; - s/\"/\\\"/g; - print AUGTEST $_; - $group = /\[\s$/; - } elsif ($group) { - s/\"/\\\"/g; - if (/#\s*\]/) { - $group = 0; - } - if (/^#/) { - s/^#//; - print AUGTEST $_; - } - } - } - print AUGTEST "\"\n"; + my $group = 0; + print AUGTEST " let conf = \""; + while (<CONFIG>) { + if (/^#\w/) { + s/^#//; + s/\"/\\\"/g; + print AUGTEST $_; + $group = /\[\s$/; + } elsif ($group) { + s/\"/\\\"/g; + if (/#\s*\]/) { + $group = 0; + } + if (/^#/) { + s/^#//; + print AUGTEST $_; + } + } + } + print AUGTEST "\"\n"; } else { - print AUGTEST $_; + print AUGTEST $_; } } diff --git a/cfg.mk b/cfg.mk index 68f3a91..aa457f9 100644 --- a/cfg.mk +++ b/cfg.mk @@ -453,7 +453,7 @@ sc_size_of_brackets: # Ensure that no C source file, docs, or rng schema uses TABs for # indentation. Also match *.h.in files, to get libvirt.h.in. Exclude # files in gnulib, since they're imported. -space_indent_files=(\.(rng|s?[ch](\.in)?|html.in|py|syms)|(daemon|tools)/.*\.in) +space_indent_files=(\.(rng|s?[ch](\.in)?|html.in|py|pl|syms)|(daemon|tools)/.*\.in) sc_TAB_in_indentation: @prohibit='^ * ' \ in_vc_files='$(space_indent_files)$$' \ diff --git a/docs/hvsupport.pl b/docs/hvsupport.pl index b0d1f0f..4871739 100755 --- a/docs/hvsupport.pl +++ b/docs/hvsupport.pl @@ -27,9 +27,9 @@ my %groupheaders = ( my @srcs; find({ wanted => sub { - if (m!$srcdir/.*/\w+_(driver|tmpl|monitor|hal|udev)\.c$!) { - push @srcs, $_ if $_ !~ /vbox_driver\.c/; - } + if (m!$srcdir/.*/\w+_(driver|tmpl|monitor|hal|udev)\.c$!) { + push @srcs, $_ if $_ !~ /vbox_driver\.c/; + } }, no_chdir => 1}, $srcdir); my $line; @@ -47,26 +47,26 @@ while (defined($line = <FILE>)) { next if $line =~ /^\s*$/; next if $line =~ /^\s*(global|local):/; if ($line =~ /^\s*LIBVIRT_(\d+\.\d+\.\d+)\s*{\s*$/) { - if (defined $vers) { - die "malformed syms file"; - } - $vers = $1; + if (defined $vers) { + die "malformed syms file"; + } + $vers = $1; } elsif ($line =~ /\s*}\s*;\s*$/) { - if (defined $prevvers) { - die "malformed syms file"; - } - $prevvers = $vers; - $vers = undef; + if (defined $prevvers) { + die "malformed syms file"; + } + $prevvers = $vers; + $vers = undef; } elsif ($line =~ /\s*}\s*LIBVIRT_(\d+\.\d+\.\d+)\s*;\s*$/) { - if ($1 ne $prevvers) { - die "malformed syms file $1 != $vers"; - } - $prevvers = $vers; - $vers = undef; + if ($1 ne $prevvers) { + die "malformed syms file $1 != $vers"; + } + $prevvers = $vers; + $vers = undef; } elsif ($line =~ /\s*(\w+)\s*;\s*$/) { - $apis{$1} = $vers; + $apis{$1} = $vers; } else { - die "unexpected data $line\n"; + die "unexpected data $line\n"; } } @@ -86,26 +86,26 @@ while (defined($line = <FILE>)) { next if $line =~ /^\s*$/; next if $line =~ /^\s*(global|local):/; if ($line =~ /^\s*LIBVIRT_QEMU_(\d+\.\d+\.\d+)\s*{\s*$/) { - if (defined $vers) { - die "malformed syms file"; - } - $vers = $1; + if (defined $vers) { + die "malformed syms file"; + } + $vers = $1; } elsif ($line =~ /\s*}\s*;\s*$/) { - if (defined $prevvers) { - die "malformed syms file"; - } - $prevvers = $vers; - $vers = undef; + if (defined $prevvers) { + die "malformed syms file"; + } + $prevvers = $vers; + $vers = undef; } elsif ($line =~ /\s*}\s*LIBVIRT_QEMU_(\d+\.\d+\.\d+)\s*;\s*$/) { - if ($1 ne $prevvers) { - die "malformed syms file $1 != $vers"; - } - $prevvers = $vers; - $vers = undef; + if ($1 ne $prevvers) { + die "malformed syms file $1 != $vers"; + } + $prevvers = $vers; + $vers = undef; } elsif ($line =~ /\s*(\w+)\s*;\s*$/) { - $apis{$1} = $vers; + $apis{$1} = $vers; } else { - die "unexpected data $line\n"; + die "unexpected data $line\n"; } } @@ -143,31 +143,31 @@ my %groups; my $ingrp; while (defined($line = <FILE>)) { if ($line =~ /struct _(vir\w*(?:Driver|Monitor))/) { - my $grp = $1; - if ($grp ne "virStateDriver" && - $grp ne "virStreamDriver") { - $ingrp = $grp; - $groups{$ingrp} = { apis => {}, drivers => {} }; - } + my $grp = $1; + if ($grp ne "virStateDriver" && + $grp ne "virStreamDriver") { + $ingrp = $grp; + $groups{$ingrp} = { apis => {}, drivers => {} }; + } } elsif ($ingrp) { - if ($line =~ /^\s*vir(?:Drv|DevMon)(\w+)\s+(\w+);\s*$/) { - my $field = $2; - my $name = $1; - - my $api; - if (exists $apis{"vir$name"}) { - $api = "vir$name"; - } elsif (exists $apis{"virConnect$name"}) { - $api = "virConnect$name"; - } elsif (exists $apis{"virNode$name"}) { - $api = "virNode$name"; - } else { - die "driver $name does not have a public API"; - } - $groups{$ingrp}->{apis}->{$field} = $api; - } elsif ($line =~ /};/) { - $ingrp = undef; - } + if ($line =~ /^\s*vir(?:Drv|DevMon)(\w+)\s+(\w+);\s*$/) { + my $field = $2; + my $name = $1; + + my $api; + if (exists $apis{"vir$name"}) { + $api = "vir$name"; + } elsif (exists $apis{"virConnect$name"}) { + $api = "virConnect$name"; + } elsif (exists $apis{"virNode$name"}) { + $api = "virNode$name"; + } else { + die "driver $name does not have a public API"; + } + $groups{$ingrp}->{apis}->{$field} = $api; + } elsif ($line =~ /};/) { + $ingrp = undef; + } } } @@ -179,60 +179,60 @@ close FILE; foreach my $src (@srcs) { open FILE, "<$src" or - die "cannot read $src: $!"; + die "cannot read $src: $!"; $ingrp = undef; my $impl; while (defined($line = <FILE>)) { - if (!$ingrp) { - foreach my $grp (keys %groups) { - if ($line =~ /^\s*(?:static\s+)?$grp\s+(\w+)\s*=\s*{/ || - $line =~ /^\s*(?:static\s+)?$grp\s+NAME\(\w+\)\s*=\s*{/) { - $ingrp = $grp; - $impl = $src; - - if ($impl =~ m,.*/node_device_(\w+)\.c,) { - $impl = $1; - } else { - $impl =~ s,.*/(\w+?)_((\w+)_)?(\w+)\.c,$1,; - } - - if ($groups{$ingrp}->{drivers}->{$impl}) { - die "Group $ingrp already contains $impl"; - } - - $groups{$ingrp}->{drivers}->{$impl} = {}; - } - } - - } else { - if ($line =~ m!\s*\.(\w+)\s*=\s*(\w+)\s*,?\s*(?:/\*\s*(\d+\.\d+\.\d+)\s*\*/\s*)?$!) { - my $api = $1; - my $meth = $2; - my $vers = $3; - - next if $api eq "no" || $api eq "name"; - - die "Method $meth in $src is missing version" unless defined $vers; - - die "Driver method for $api is NULL in $src" if $meth eq "NULL"; - - if (!exists($groups{$ingrp}->{apis}->{$api})) { - die "Found unexpected method $api in $ingrp\n"; - } - - $groups{$ingrp}->{drivers}->{$impl}->{$api} = $vers; - if ($api eq "domainMigratePrepare" || - $api eq "domainMigratePrepare2" || - $api eq "domainMigratePrepare3") { - $groups{$ingrp}->{drivers}->{$impl}->{"domainMigrate"} = $vers - unless $groups{$ingrp}->{drivers}->{$impl}->{"domainMigrate"}; - } - - } elsif ($line =~ /}/) { - $ingrp = undef; - } - } + if (!$ingrp) { + foreach my $grp (keys %groups) { + if ($line =~ /^\s*(?:static\s+)?$grp\s+(\w+)\s*=\s*{/ || + $line =~ /^\s*(?:static\s+)?$grp\s+NAME\(\w+\)\s*=\s*{/) { + $ingrp = $grp; + $impl = $src; + + if ($impl =~ m,.*/node_device_(\w+)\.c,) { + $impl = $1; + } else { + $impl =~ s,.*/(\w+?)_((\w+)_)?(\w+)\.c,$1,; + } + + if ($groups{$ingrp}->{drivers}->{$impl}) { + die "Group $ingrp already contains $impl"; + } + + $groups{$ingrp}->{drivers}->{$impl} = {}; + } + } + + } else { + if ($line =~ m!\s*\.(\w+)\s*=\s*(\w+)\s*,?\s*(?:/\*\s*(\d+\.\d+\.\d+)\s*\*/\s*)?$!) { + my $api = $1; + my $meth = $2; + my $vers = $3; + + next if $api eq "no" || $api eq "name"; + + die "Method $meth in $src is missing version" unless defined $vers; + + die "Driver method for $api is NULL in $src" if $meth eq "NULL"; + + if (!exists($groups{$ingrp}->{apis}->{$api})) { + die "Found unexpected method $api in $ingrp\n"; + } + + $groups{$ingrp}->{drivers}->{$impl}->{$api} = $vers; + if ($api eq "domainMigratePrepare" || + $api eq "domainMigratePrepare2" || + $api eq "domainMigratePrepare3") { + $groups{$ingrp}->{drivers}->{$impl}->{"domainMigrate"} = $vers + unless $groups{$ingrp}->{drivers}->{$impl}->{"domainMigrate"}; + } + + } elsif ($line =~ /}/) { + $ingrp = undef; + } + } } close FILE; @@ -253,21 +253,21 @@ foreach my $drv (keys %{$groups{"virDriver"}->{drivers}}) { my $openVersStr = $groups{"virDriver"}->{drivers}->{$drv}->{"open"}; my $openVers; if ($openVersStr =~ /(\d+)\.(\d+)\.(\d+)/) { - $openVers = ($1 * 1000 * 1000) + ($2 * 1000) + $3; + $openVers = ($1 * 1000 * 1000) + ($2 * 1000) + $3; } # virConnectOpenReadOnly always matches virConnectOpen version $groups{"virDriver"}->{drivers}->{$drv}->{"openReadOnly"} = - $groups{"virDriver"}->{drivers}->{$drv}->{"open"}; + $groups{"virDriver"}->{drivers}->{$drv}->{"open"}; # virConnectOpenAuth is always 0.4.0 if the driver existed # before this time, otherwise it matches the version of # the driver's virConnectOpen entry if ($openVersStr eq "Y" || - $openVers >= $openAuthVers) { - $groups{"virDriver"}->{drivers}->{$drv}->{"openAuth"} = $openVersStr; + $openVers >= $openAuthVers) { + $groups{"virDriver"}->{drivers}->{$drv}->{"openAuth"} = $openVersStr; } else { - $groups{"virDriver"}->{drivers}->{$drv}->{"openAuth"} = "0.4.0"; + $groups{"virDriver"}->{drivers}->{$drv}->{"openAuth"} = "0.4.0"; } } @@ -283,17 +283,17 @@ foreach my $drv (keys %{$groups{"virDriver"}->{drivers}}) { next unless defined $createVersStr; my $createVers; if ($createVersStr =~ /(\d+)\.(\d+)\.(\d+)/) { - $createVers = ($1 * 1000 * 1000) + ($2 * 1000) + $3; + $createVers = ($1 * 1000 * 1000) + ($2 * 1000) + $3; } # virCreateLinux is always 0.0.3 if the driver existed # before this time, otherwise it matches the version of # the driver's virCreateXML entry if ($createVersStr eq "Y" || - $createVers >= $createAPIVers) { - $groups{"virDriver"}->{drivers}->{$drv}->{"domainCreateLinux"} = $createVersStr; + $createVers >= $createAPIVers) { + $groups{"virDriver"}->{drivers}->{$drv}->{"domainCreateLinux"} = $createVersStr; } else { - $groups{"virDriver"}->{drivers}->{$drv}->{"domainCreateLinux"} = "0.0.3"; + $groups{"virDriver"}->{drivers}->{$drv}->{"domainCreateLinux"} = "0.0.3"; } } @@ -329,7 +329,7 @@ foreach my $grp (sort { $a cmp $b } keys %groups) { EOF foreach my $drv (sort { $a cmp $b } keys %{$groups{$grp}->{drivers}}) { - print " <th>$drv</th>\n"; + print " <th>$drv</th>\n"; } print <<EOF; @@ -340,27 +340,27 @@ EOF my $row = 0; foreach my $field (sort { - $groups{$grp}->{apis}->{$a} - cmp - $groups{$grp}->{apis}->{$b} - } keys %{$groups{$grp}->{apis}}) { - my $api = $groups{$grp}->{apis}->{$field}; - my $vers = $apis{$api}; - print <<EOF; + $groups{$grp}->{apis}->{$a} + cmp + $groups{$grp}->{apis}->{$b} + } keys %{$groups{$grp}->{apis}}) { + my $api = $groups{$grp}->{apis}->{$field}; + my $vers = $apis{$api}; + print <<EOF; <tr> <td><a href=\"html/libvirt-libvirt.html#$api\">$api</a></td> <td>$vers</td> EOF foreach my $drv (sort {$a cmp $b } keys %{$groups{$grp}->{drivers}}) { - if (exists $groups{$grp}->{drivers}->{$drv}->{$field}) { - print "<td>", $groups{$grp}->{drivers}->{$drv}->{$field}, "</td>\n"; - } else { - print "<td></td>\n"; - } + if (exists $groups{$grp}->{drivers}->{$drv}->{$field}) { + print "<td>", $groups{$grp}->{drivers}->{$drv}->{$field}, "</td>\n"; + } else { + print "<td></td>\n"; + } } - print <<EOF; + print <<EOF; </tr> EOF @@ -373,13 +373,13 @@ EOF EOF foreach my $drv (sort { $a cmp $b } keys %{$groups{$grp}->{drivers}}) { - print " <th>$drv</th>\n"; + print " <th>$drv</th>\n"; } print <<EOF; </tr> EOF - } + } } diff --git a/docs/todo.pl b/docs/todo.pl index 1183ff5..68d82d4 100755 --- a/docs/todo.pl +++ b/docs/todo.pl @@ -22,17 +22,17 @@ my $blurb = $cfg->get("output/blurb", undef); $SIG{__DIE__} = sub { my $err = shift; if (UNIVERSAL::isa($err, "BZ::Client::Exception")) { - die "Unable to access bugzilla: " . $err->message; + die "Unable to access bugzilla: " . $err->message; } die $err; }; my $client = BZ::Client->new(url => $server, - user => $username, - password => $password); + user => $username, + password => $password); my $todo = BZ::Client::Bug->search($client, {'product' => $product, - 'alias' => $todoalias}); + 'alias' => $todoalias}); die "Cannot find bug alias 'libvirtTodo'" unless $#{$todo} > -1; my $todoid = $todo->[0]->{'bug_id'}; @@ -42,7 +42,7 @@ $todosummary =~ s/^\s*\[\s*RFE\s*\]\s*:?\s*//; $todosummary =~ s/^\s*Tracker\s*:\s*//; my $trackers = BZ::Client::Bug->search($client, {'product' => $product, - 'blocked' => $todoid }); + 'blocked' => $todoid }); my @trackers; @@ -55,27 +55,27 @@ foreach my $tracker (@{$trackers}) { $summary =~ s/^\s*Tracker\s*:\s*//; push @trackers, { - id => $tracker->{'bug_id'}, - summary => $summary, - features => [], + id => $tracker->{'bug_id'}, + summary => $summary, + features => [], }; } foreach my $tracker (@trackers) { my $features = BZ::Client::Bug->search($client, {'product' => $product, - 'blocked' => $tracker->{id}}); + 'blocked' => $tracker->{id}}); foreach my $feature (@{$features}) { - next if $feature->{'bug_status'} eq "CLOSED"; + next if $feature->{'bug_status'} eq "CLOSED"; - my $summary = $feature->{'short_desc'}; - $summary =~ s/^\s*RFE\s*:\s*//; - $summary =~ s/^\s*\[\s*RFE\s*\]\s*:?\s*//; + my $summary = $feature->{'short_desc'}; + $summary =~ s/^\s*RFE\s*:\s*//; + $summary =~ s/^\s*\[\s*RFE\s*\]\s*:?\s*//; - push @{$tracker->{features}}, { - id => $feature->{'bug_id'}, - summary => $summary, - }; + push @{$tracker->{features}}, { + id => $feature->{'bug_id'}, + summary => $summary, + }; } } @@ -108,11 +108,11 @@ foreach my $tracker (sort { $a->{summary} cmp $b->{summary} } @trackers) { print " <h2><a href=\"$server/$id\">$summary</a></h2>\n"; print " <ul>\n"; foreach my $feature (sort { $a->{summary} cmp $b->{summary} } @{$tracker->{features}}) { - $summary = &escape($feature->{summary}); - $summary =~ s,^([^:]+):,<strong>$1</strong>,; + $summary = &escape($feature->{summary}); + $summary =~ s,^([^:]+):,<strong>$1</strong>,; - $id = $feature->{id}; - print " <li>$summary (<strong>rhbz <a href=\"$server/$id\">$id</a></strong>)</li>\n"; + $id = $feature->{id}; + print " <li>$summary (<strong>rhbz <a href=\"$server/$id\">$id</a></strong>)</li>\n"; } print " </ul>\n"; } diff --git a/src/check-symfile.pl b/src/check-symfile.pl index 19ffec5..73cdfcd 100755 --- a/src/check-symfile.pl +++ b/src/check-symfile.pl @@ -34,9 +34,9 @@ foreach my $elflib (@elflibs) { open NM, "-|", "nm", $elflib or die "cannot run 'nm $elflib': $!"; while (<NM>) { - next unless /^\S+\s(?:T|D)\s(\S+)\s*$/; + next unless /^\S+\s(?:T|D)\s(\S+)\s*$/; - $gotsyms{$1} = 1; + $gotsyms{$1} = 1; } close NM; diff --git a/src/dtrace2systemtap.pl b/src/dtrace2systemtap.pl index 4c6c249..8852379 100755 --- a/src/dtrace2systemtap.pl +++ b/src/dtrace2systemtap.pl @@ -46,38 +46,38 @@ while (<>) { next if /^\s*};\s*$/; if (m,^\s*\#,) { - if (m,^\s*\#\s*file:\s*(\S+)\s*$,) { - $file = $1; - push @files, $file; - $files{$file} = { prefix => undef, probes => [] }; - } elsif (m,^\s*\#\s*prefix:\s*(\S+)\s*$,) { - $files{$file}->{prefix} = $1; - } elsif (m,^\s*\#\s*binary:\s*(\S+)\s*$,) { - $files{$file}->{binary} = $1; - } else { - # ignore unknown comments - } + if (m,^\s*\#\s*file:\s*(\S+)\s*$,) { + $file = $1; + push @files, $file; + $files{$file} = { prefix => undef, probes => [] }; + } elsif (m,^\s*\#\s*prefix:\s*(\S+)\s*$,) { + $files{$file}->{prefix} = $1; + } elsif (m,^\s*\#\s*binary:\s*(\S+)\s*$,) { + $files{$file}->{binary} = $1; + } else { + # ignore unknown comments + } } else { - if (m,\s*probe\s+([a-zA-Z0-9_]+)\((.*?)(\);)?$,) { - $probe = $1; - $args = $2; - if ($3) { - push @{$files{$file}->{probes}}, [$probe, $args]; - $probe = $args = undef; - } - } elsif ($probe) { - if (m,^(.*?)(\);)?$,) { - $args .= $1; - if ($2) { - push @{$files{$file}->{probes}}, [$probe, $args]; - $probe = $args = undef; - } - } else { - die "unexpected data $_ on line $."; - } - } else { - die "unexpected data $_ on line $."; - } + if (m,\s*probe\s+([a-zA-Z0-9_]+)\((.*?)(\);)?$,) { + $probe = $1; + $args = $2; + if ($3) { + push @{$files{$file}->{probes}}, [$probe, $args]; + $probe = $args = undef; + } + } elsif ($probe) { + if (m,^(.*?)(\);)?$,) { + $args .= $1; + if ($2) { + push @{$files{$file}->{probes}}, [$probe, $args]; + $probe = $args = undef; + } + } else { + die "unexpected data $_ on line $."; + } + } else { + die "unexpected data $_ on line $."; + } } } @@ -88,32 +88,32 @@ foreach my $file (@files) { print "# $file\n\n"; foreach my $probe (@probes) { - my $name = $probe->[0]; - my $args = $probe->[1]; + my $name = $probe->[0]; + my $args = $probe->[1]; - my $pname = $name; - $pname =~ s/${prefix}_/libvirt.$prefix./; + my $pname = $name; + $pname =~ s/${prefix}_/libvirt.$prefix./; - my $binary = "$libdir/libvirt.so"; - if (exists $files{$file}->{binary}) { - $binary = $sbindir . "/" . $files{$file}->{binary}; - } + my $binary = "$libdir/libvirt.so"; + if (exists $files{$file}->{binary}) { + $binary = $sbindir . "/" . $files{$file}->{binary}; + } - print "probe $pname = process(\"$binary\").mark(\"$name\") {\n"; + print "probe $pname = process(\"$binary\").mark(\"$name\") {\n"; - my @args = split /,/, $args; - for (my $i = 0 ; $i <= $#args ; $i++) { - my $arg = $args[$i]; - my $isstr = $arg =~ /char\s+\*/; - $arg =~ s/^.*\s\*?(\S+)$/$1/; + my @args = split /,/, $args; + for (my $i = 0 ; $i <= $#args ; $i++) { + my $arg = $args[$i]; + my $isstr = $arg =~ /char\s+\*/; + $arg =~ s/^.*\s\*?(\S+)$/$1/; - if ($isstr) { - print " $arg = user_string(\$arg", $i + 1, ");\n"; - } else { - print " $arg = \$arg", $i + 1, ";\n"; - } - } - print "}\n\n"; + if ($isstr) { + print " $arg = user_string(\$arg", $i + 1, ");\n"; + } else { + print " $arg = \$arg", $i + 1, ";\n"; + } + } + print "}\n\n"; } print "\n"; } diff --git a/src/rpc/gendispatch.pl b/src/rpc/gendispatch.pl index 17bfb2e..3a66445 100755 --- a/src/rpc/gendispatch.pl +++ b/src/rpc/gendispatch.pl @@ -54,11 +54,11 @@ sub name_to_ProcName { my @elems; if ($name =~ /_/ || (lc $name) eq "open" || (lc $name) eq "close") { - @elems = split /_/, $name; - @elems = map lc, @elems; - @elems = map ucfirst, @elems; + @elems = split /_/, $name; + @elems = map lc, @elems; + @elems = map ucfirst, @elems; } else { - @elems = $name; + @elems = $name; } @elems = map { fixup_name($_) } @elems; my $procname = join "", @elems; @@ -332,53 +332,53 @@ elsif ($opt_b) { # skip things which are REMOTE_MESSAGE next if $call->{msg}; - my $name = $structprefix . "Dispatch" . $call->{ProcName}; - my $argtype = $call->{args}; - my $rettype = $call->{ret}; - - my $argann = $argtype ne "void" ? "" : " ATTRIBUTE_UNUSED"; - my $retann = $rettype ne "void" ? "" : " ATTRIBUTE_UNUSED"; - - # First we print out a function declaration for the - # real dispatcher body - print "static int ${name}(\n"; - print " virNetServerPtr server,\n"; - print " virNetServerClientPtr client,\n"; - print " virNetMessagePtr msg,\n"; - print " virNetMessageErrorPtr rerr"; - if ($argtype ne "void") { - print ",\n $argtype *args"; - } - if ($rettype ne "void") { - print ",\n $rettype *ret"; - } - print ");\n"; - - - # Next we print out a generic wrapper method which has - # fixed function signature, for use in the dispatcher - # table. This simply callers the real dispatcher method - print "static int ${name}Helper(\n"; - print " virNetServerPtr server,\n"; - print " virNetServerClientPtr client,\n"; - print " virNetMessagePtr msg,\n"; - print " virNetMessageErrorPtr rerr,\n"; - print " void *args$argann,\n"; - print " void *ret$retann)\n"; - print "{\n"; - print " VIR_DEBUG(\"server=%p client=%p msg=%p rerr=%p args=%p ret=%p\", server, client, msg, rerr, args, ret);\n"; - print " return $name(server, client, msg, rerr"; - if ($argtype ne "void") { - print ", args"; - } - if ($rettype ne "void") { - print ", ret"; - } - print ");\n"; - print "}\n"; - - # Finally we print out the dispatcher method body impl - # (if possible) + my $name = $structprefix . "Dispatch" . $call->{ProcName}; + my $argtype = $call->{args}; + my $rettype = $call->{ret}; + + my $argann = $argtype ne "void" ? "" : " ATTRIBUTE_UNUSED"; + my $retann = $rettype ne "void" ? "" : " ATTRIBUTE_UNUSED"; + + # First we print out a function declaration for the + # real dispatcher body + print "static int ${name}(\n"; + print " virNetServerPtr server,\n"; + print " virNetServerClientPtr client,\n"; + print " virNetMessagePtr msg,\n"; + print " virNetMessageErrorPtr rerr"; + if ($argtype ne "void") { + print ",\n $argtype *args"; + } + if ($rettype ne "void") { + print ",\n $rettype *ret"; + } + print ");\n"; + + + # Next we print out a generic wrapper method which has + # fixed function signature, for use in the dispatcher + # table. This simply callers the real dispatcher method + print "static int ${name}Helper(\n"; + print " virNetServerPtr server,\n"; + print " virNetServerClientPtr client,\n"; + print " virNetMessagePtr msg,\n"; + print " virNetMessageErrorPtr rerr,\n"; + print " void *args$argann,\n"; + print " void *ret$retann)\n"; + print "{\n"; + print " VIR_DEBUG(\"server=%p client=%p msg=%p rerr=%p args=%p ret=%p\", server, client, msg, rerr, args, ret);\n"; + print " return $name(server, client, msg, rerr"; + if ($argtype ne "void") { + print ", args"; + } + if ($rettype ne "void") { + print ", ret"; + } + print ");\n"; + print "}\n"; + + # Finally we print out the dispatcher method body impl + # (if possible) if (!exists($generate{$call->{ProcName}})) { print "/* ${structprefix}Dispatch$call->{ProcName} body has " . "to be implemented manually */\n\n\n\n"; @@ -794,18 +794,18 @@ elsif ($opt_b) { } # print functions signature - print "static int $name(\n"; - print " virNetServerPtr server ATTRIBUTE_UNUSED,\n"; - print " virNetServerClientPtr client,\n"; - print " virNetMessagePtr msg ATTRIBUTE_UNUSED,\n"; - print " virNetMessageErrorPtr rerr"; + print "static int $name(\n"; + print " virNetServerPtr server ATTRIBUTE_UNUSED,\n"; + print " virNetServerClientPtr client,\n"; + print " virNetMessagePtr msg ATTRIBUTE_UNUSED,\n"; + print " virNetMessageErrorPtr rerr"; if ($argtype ne "void") { - print ",\n $argtype *args"; - } + print ",\n $argtype *args"; + } if ($rettype ne "void") { - print ",\n $rettype *ret"; - } - print ")\n"; + print ",\n $rettype *ret"; + } + print ")\n"; # print function body print "{\n"; @@ -814,7 +814,7 @@ elsif ($opt_b) { foreach my $var (@vars_list) { print " $var;\n"; } - print " struct daemonClientPrivate *priv =\n"; + print " struct daemonClientPrivate *priv =\n"; print " virNetServerClientGetPrivateData(client);\n"; if ($call->{streamflag} ne "none") { @@ -994,32 +994,32 @@ elsif ($opt_b) { print "virNetServerProgramProc ${structprefix}Procs[] = {\n"; for ($id = 0 ; $id <= $#calls ; $id++) { - my ($comment, $name, $argtype, $arglen, $argfilter, $retlen, $retfilter, $priority); - - if (defined $calls[$id] && !$calls[$id]->{msg}) { - $comment = "/* Method $calls[$id]->{ProcName} => $id */"; - $name = $structprefix . "Dispatch" . $calls[$id]->{ProcName} . "Helper"; - my $argtype = $calls[$id]->{args}; - my $rettype = $calls[$id]->{ret}; - $arglen = $argtype ne "void" ? "sizeof($argtype)" : "0"; - $retlen = $rettype ne "void" ? "sizeof($rettype)" : "0"; - $argfilter = $argtype ne "void" ? "xdr_$argtype" : "xdr_void"; - $retfilter = $rettype ne "void" ? "xdr_$rettype" : "xdr_void"; - } else { - if ($calls[$id]->{msg}) { - $comment = "/* Async event $calls[$id]->{ProcName} => $id */"; - } else { - $comment = "/* Unused $id */"; - } - $name = "NULL"; - $arglen = $retlen = 0; - $argfilter = "xdr_void"; - $retfilter = "xdr_void"; - } + my ($comment, $name, $argtype, $arglen, $argfilter, $retlen, $retfilter, $priority); + + if (defined $calls[$id] && !$calls[$id]->{msg}) { + $comment = "/* Method $calls[$id]->{ProcName} => $id */"; + $name = $structprefix . "Dispatch" . $calls[$id]->{ProcName} . "Helper"; + my $argtype = $calls[$id]->{args}; + my $rettype = $calls[$id]->{ret}; + $arglen = $argtype ne "void" ? "sizeof($argtype)" : "0"; + $retlen = $rettype ne "void" ? "sizeof($rettype)" : "0"; + $argfilter = $argtype ne "void" ? "xdr_$argtype" : "xdr_void"; + $retfilter = $rettype ne "void" ? "xdr_$rettype" : "xdr_void"; + } else { + if ($calls[$id]->{msg}) { + $comment = "/* Async event $calls[$id]->{ProcName} => $id */"; + } else { + $comment = "/* Unused $id */"; + } + $name = "NULL"; + $arglen = $retlen = 0; + $argfilter = "xdr_void"; + $retfilter = "xdr_void"; + } $priority = defined $calls[$id]->{priority} ? $calls[$id]->{priority} : 0; - print "{ $comment\n ${name},\n $arglen,\n (xdrproc_t)$argfilter,\n $retlen,\n (xdrproc_t)$retfilter,\n true,\n $priority\n},\n"; + print "{ $comment\n ${name},\n $arglen,\n (xdrproc_t)$argfilter,\n $retlen,\n (xdrproc_t)$retfilter,\n true,\n $priority\n},\n"; } print "};\n"; print "size_t ${structprefix}NProcs = ARRAY_CARDINALITY(${structprefix}Procs);\n"; @@ -1039,8 +1039,8 @@ elsif ($opt_k) { # skip procedures not on generate list next if ! exists($generate{$call->{ProcName}}); - my $argtype = $call->{args}; - my $rettype = $call->{ret}; + my $argtype = $call->{args}; + my $rettype = $call->{ret}; # handle arguments to the function my @args_list = (); @@ -1574,10 +1574,10 @@ elsif ($opt_k) { } if ($call->{ProcName} eq "DomainDestroy" || - $call->{ProcName} eq "DomainSave" || - $call->{ProcName} eq "DomainManagedSave") { + $call->{ProcName} eq "DomainSave" || + $call->{ProcName} eq "DomainManagedSave") { # SPECIAL: virDomain{Destroy|Save|ManagedSave} need to reset - # the domain id explicitly on success + # the domain id explicitly on success print " dom->id = -1;\n"; } diff --git a/src/rpc/genprotocol.pl b/src/rpc/genprotocol.pl index f8e68f5..c8c1570 100755 --- a/src/rpc/genprotocol.pl +++ b/src/rpc/genprotocol.pl @@ -41,14 +41,14 @@ while (<RPCGEN>) { # We only want to fixup the GLibc rpcgen output # So just print data unchanged, if non-Linux unless ($fixup) { - print TARGET; - next; + print TARGET; + next; } if (m/^{/) { - $in_function = 1; - print TARGET; - next; + $in_function = 1; + print TARGET; + next; } s/\t/ /g; @@ -64,58 +64,58 @@ while (<RPCGEN>) { s/(?<!IXDR_GET_INT32 )IXDR_GET_LONG/IXDR_GET_INT32/g; if (m/^}/) { - $in_function = 0; - - # Note: The body of the function is in @function. - - # Remove decl of buf, if buf isn't used in the function. - my @uses = grep /[^.>]\bbuf\b/, @function; - @function = grep !/[^.>]\bbuf\b/, @function if @uses == 1; - - # Remove decl of i, if i isn't used in the function. - @uses = grep /[^.>]\bi\b/, @function; - @function = grep !/[^.>]\bi\b/, @function if @uses == 1; - - # (char **)&objp->... gives: - # warning: dereferencing type-punned pointer will break - # strict-aliasing rules - # so rewrite it. - my %uses = (); - my $i = 0; - foreach (@function) { - $uses{$1} = $i++ if m/\(char \*\*\)\&(objp->[a-z_.]+_val)/i; - } - if (keys %uses >= 1) { - my $i = 1; - - foreach (keys %uses) { - $i = $uses{$_}; - unshift @function, - (" char **objp_cpp$i = (char **) (void *) &$_;\n"); - $i++; - } - @function = - map { s{\(char \*\*\)\&(objp->[a-z_.]+_val)} - {objp_cpp$uses{$1}}gi; $_ } @function; - } - - # The code uses 'IXDR_PUT_{U_,}LONG' but it's wrong in two - # ways: Firstly these functions are deprecated and don't - # work on 64 bit platforms. Secondly the return value should - # be ignored. Correct both these mistakes. - @function = - map { s/\bIXDR_PUT_((U_)?)LONG\b/(void)IXDR_PUT_$1INT32/; $_ } - map { s/\bXDR_INLINE\b/(int32_t*)XDR_INLINE/; $_ } - @function; - - print TARGET (join ("", @function)); - @function = (); + $in_function = 0; + + # Note: The body of the function is in @function. + + # Remove decl of buf, if buf isn't used in the function. + my @uses = grep /[^.>]\bbuf\b/, @function; + @function = grep !/[^.>]\bbuf\b/, @function if @uses == 1; + + # Remove decl of i, if i isn't used in the function. + @uses = grep /[^.>]\bi\b/, @function; + @function = grep !/[^.>]\bi\b/, @function if @uses == 1; + + # (char **)&objp->... gives: + # warning: dereferencing type-punned pointer will break + # strict-aliasing rules + # so rewrite it. + my %uses = (); + my $i = 0; + foreach (@function) { + $uses{$1} = $i++ if m/\(char \*\*\)\&(objp->[a-z_.]+_val)/i; + } + if (keys %uses >= 1) { + my $i = 1; + + foreach (keys %uses) { + $i = $uses{$_}; + unshift @function, + (" char **objp_cpp$i = (char **) (void *) &$_;\n"); + $i++; + } + @function = + map { s{\(char \*\*\)\&(objp->[a-z_.]+_val)} + {objp_cpp$uses{$1}}gi; $_ } @function; + } + + # The code uses 'IXDR_PUT_{U_,}LONG' but it's wrong in two + # ways: Firstly these functions are deprecated and don't + # work on 64 bit platforms. Secondly the return value should + # be ignored. Correct both these mistakes. + @function = + map { s/\bIXDR_PUT_((U_)?)LONG\b/(void)IXDR_PUT_$1INT32/; $_ } + map { s/\bXDR_INLINE\b/(int32_t*)XDR_INLINE/; $_ } + @function; + + print TARGET (join ("", @function)); + @function = (); } unless ($in_function) { - print TARGET; + print TARGET; } else { - push @function, $_; + push @function, $_; } } diff --git a/src/rpc/gensystemtap.pl b/src/rpc/gensystemtap.pl index 1cf9c0f..41c5625 100755 --- a/src/rpc/gensystemtap.pl +++ b/src/rpc/gensystemtap.pl @@ -37,33 +37,33 @@ my $intype = 0; my $inauth = 0; while (<>) { if (/enum\s+virNetMessageType/) { - $intype = 1; + $intype = 1; } elsif (/enum\s+virNetMessageStatus/) { - $instatus = 1; + $instatus = 1; } elsif (/enum remote_auth_type/) { - $inauth = 1; + $inauth = 1; } elsif (/}/) { - $instatus = $intype = $inauth = 0; + $instatus = $intype = $inauth = 0; } elsif ($instatus) { - if (/^\s+VIR_NET_(\w+)\s*=\s*(\d+),?$/) { - $status{$2} = lc $1; - } + if (/^\s+VIR_NET_(\w+)\s*=\s*(\d+),?$/) { + $status{$2} = lc $1; + } } elsif ($intype) { - if (/^\s+VIR_NET_(\w+)\s*=\s*(\d+),?$/) { - $type{$2} = lc $1; - } + if (/^\s+VIR_NET_(\w+)\s*=\s*(\d+),?$/) { + $type{$2} = lc $1; + } } elsif ($inauth) { - if (/^\s+REMOTE_AUTH_(\w+)\s*=\s*(\d+),?$/) { - $auth{$2} = lc $1; - } + if (/^\s+REMOTE_AUTH_(\w+)\s*=\s*(\d+),?$/) { + $auth{$2} = lc $1; + } } else { - if (/(\w+)_PROGRAM\s*=\s*0x([a-fA-F0-9]+)\s*;/) { - $funcs{lc $1} = { id => hex($2), version => undef, progs => [] }; - } elsif (/(\w+)_PROTOCOL_VERSION\s*=\s*(\d+)\s*;/) { - $funcs{lc $1}->{version} = $2; - } elsif (/(\w+)_PROC_(.*?)\s+=\s+(\d+)/) { - $funcs{lc $1}->{progs}->[$3] = lc $2; - } + if (/(\w+)_PROGRAM\s*=\s*0x([a-fA-F0-9]+)\s*;/) { + $funcs{lc $1} = { id => hex($2), version => undef, progs => [] }; + } elsif (/(\w+)_PROTOCOL_VERSION\s*=\s*(\d+)\s*;/) { + $funcs{lc $1}->{version} = $2; + } elsif (/(\w+)_PROC_(.*?)\s+=\s+(\d+)/) { + $funcs{lc $1}->{progs}->[$3] = lc $2; + } } } @@ -172,10 +172,10 @@ foreach my $prog (keys %funcs) { my $pfirst = 1; for (my $id = 1 ; $id <= $#{$funcs{$prog}->{progs}} ; $id++) { - my $cond = $pfirst ? "if" : "} else if"; - $pfirst = 0; - print " $cond (proc == $id) {\n"; - print " procstr = \"", $funcs{$prog}->{progs}->[$id], "\";\n"; + my $cond = $pfirst ? "if" : "} else if"; + $pfirst = 0; + print " $cond (proc == $id) {\n"; + print " procstr = \"", $funcs{$prog}->{progs}->[$id], "\";\n"; } print " } else {\n"; print " procstr = \"unknown\";\n"; diff --git a/tests/oomtrace.pl b/tests/oomtrace.pl index c615ed9..6d423e7 100755 --- a/tests/oomtrace.pl +++ b/tests/oomtrace.pl @@ -21,7 +21,7 @@ my %lines; foreach (@data) { if (/^\s*TRACE:\s+(\S+?)(?:\(.*\))?\s+\[0x(.*)\]\s*$/ ) { - $trace{$2} = $1; + $trace{$2} = $1; } } @@ -34,8 +34,8 @@ foreach my $key (keys %trace) { foreach (@data) { if (/^\s*TRACE:\s+(\S+?)(?:\(.*\))?\s+\[0x(.*)\]\s*$/ ) { - print $lines{$2}; + print $lines{$2}; } else { - print; + print; } } -- 1.7.10.4