Fix spaces in modperl.

git-svn-id: https://znc.svn.sourceforge.net/svnroot/znc/trunk@2144 726aef4b-f618-498e-8847-2d620e286838
This commit is contained in:
darthgandalf
2010-09-27 13:30:54 +00:00
parent 9fe92c3725
commit a30a201338
5 changed files with 323 additions and 323 deletions
+61 -61
View File
@@ -70,70 +70,70 @@ namespace {
EOF
while (<$in>) {
my ($type, $name, $args, $default) = /(\S+)\s+(\w+)\((.*)\)(?:=(\w+))?/ or next;
$type =~ s/(EModRet)/CModule::$1/;
$type =~ s/^\s*(.*?)\s*$/$1/;
unless (defined $default) {
given ($type) {
when ('bool') { $default = 'true' }
when ('CModule::EModRet') { $default = 'CONTINUE' }
when ('CString') { $default = '""' }
when (/\*$/) { $default = "($type)NULL" }
}
}
my @arg = map {
my ($t, $v) = /^\s*(.*\W)\s*(\w+)\s*$/;
$t =~ s/^\s*(.*?)\s*$/$1/;
my ($tt, $tm) = $t =~ /^(.*?)\s*?(\*|&)?$/;
{type=>$t, var=>$v, base=>$tt, mod=>$tm//''}
} split /,/, $args;
say $out "$type CPerlModule::$name($args) {";
say $out "\t$type result = $default;" if $type ne 'void';
say $out "\tPSTART_IDF($name);";
given ($type) {
when ('CString') { print $out "\tPUSH_STR($default);" }
when (/\*$/) { my $t=$type; $t=~s/^const//; print $out "\tPUSH_PTR($t, $default);" }
when ('void') { print $out "\tmXPUSHi(0);" }
default { print $out "\tmXPUSHi(static_cast<int>($default));" }
}
say $out " // Default value";
for my $a (@arg) {
given ($a->{type}) {
when (/(vector\s*<\s*(.*)\*\s*>)/) {
my ($vec, $sub) = ($1, $2);
my $dot = '.';
$dot = '->' if $a->{mod} eq '*';
say $out "\tfor (${vec}::const_iterator i = $a->{var}${dot}begin(); i != $a->{var}${dot}end(); ++i) {";
my ($type, $name, $args, $default) = /(\S+)\s+(\w+)\((.*)\)(?:=(\w+))?/ or next;
$type =~ s/(EModRet)/CModule::$1/;
$type =~ s/^\s*(.*?)\s*$/$1/;
unless (defined $default) {
given ($type) {
when ('bool') { $default = 'true' }
when ('CModule::EModRet') { $default = 'CONTINUE' }
when ('CString') { $default = '""' }
when (/\*$/) { $default = "($type)NULL" }
}
}
my @arg = map {
my ($t, $v) = /^\s*(.*\W)\s*(\w+)\s*$/;
$t =~ s/^\s*(.*?)\s*$/$1/;
my ($tt, $tm) = $t =~ /^(.*?)\s*?(\*|&)?$/;
{type=>$t, var=>$v, base=>$tt, mod=>$tm//''}
} split /,/, $args;
say $out "$type CPerlModule::$name($args) {";
say $out "\t$type result = $default;" if $type ne 'void';
say $out "\tPSTART_IDF($name);";
given ($type) {
when ('CString') { print $out "\tPUSH_STR($default);" }
when (/\*$/) { my $t=$type; $t=~s/^const//; print $out "\tPUSH_PTR($t, $default);" }
when ('void') { print $out "\tmXPUSHi(0);" }
default { print $out "\tmXPUSHi(static_cast<int>($default));" }
}
say $out " // Default value";
for my $a (@arg) {
given ($a->{type}) {
when (/(vector\s*<\s*(.*)\*\s*>)/) {
my ($vec, $sub) = ($1, $2);
my $dot = '.';
$dot = '->' if $a->{mod} eq '*';
say $out "\tfor (${vec}::const_iterator i = $a->{var}${dot}begin(); i != $a->{var}${dot}end(); ++i) {";
#atm sub is always "...*" so...
say $out "\t\tPUSH_PTR($sub*, *i);";
say $out "\t}";
}
when (/CString/) { say $out "\tPUSH_STR($a->{var});" }
when (/\*$/) { my $t=$a->{type}; $t=~s/^const//; say $out "\tPUSH_PTR($t, $a->{var});" }
when (/&$/) { my $b=$a->{base}; $b=~s/^const//; say $out "\tPUSH_PTR($b*, &$a->{var});" }
say $out "\t\tPUSH_PTR($sub*, *i);";
say $out "\t}";
}
when (/CString/) { say $out "\tPUSH_STR($a->{var});" }
when (/\*$/) { my $t=$a->{type}; $t=~s/^const//; say $out "\tPUSH_PTR($t, $a->{var});" }
when (/&$/) { my $b=$a->{base}; $b=~s/^const//; say $out "\tPUSH_PTR($b*, &$a->{var});" }
when (/unsigned/){ say $out "\tmXPUSHu($a->{var});" }
default { say $out "\tmXPUSHi($a->{var});" }
}
}
say $out "\tPCALLMOD(,";
my $x = 0;
say $out "\t\tresult = ".sv($type)."(ST(0));" if $type ne 'void';
for my $a (@arg) {
$x++;
say $out "\t\t$a->{var} = PString(ST($x));" if $a->{base} eq 'CString' && $a->{mod} eq '&';
}
say $out "\t);";
say $out "\treturn result;" if $type ne 'void';
say $out "}\n";
default { say $out "\tmXPUSHi($a->{var});" }
}
}
say $out "\tPCALLMOD(,";
my $x = 0;
say $out "\t\tresult = ".sv($type)."(ST(0));" if $type ne 'void';
for my $a (@arg) {
$x++;
say $out "\t\t$a->{var} = PString(ST($x));" if $a->{base} eq 'CString' && $a->{mod} eq '&';
}
say $out "\t);";
say $out "\treturn result;" if $type ne 'void';
say $out "}\n";
}
sub sv {
my $type = shift;
given ($type) {
when (/^(.*)\*$/) { return "SvToPtr<$1>(\"$type\")" }
when ('CString') { return 'PString' }
when ('CModule::EModRet') { return 'SvToEModRet' }
when (/unsigned/) { return 'SvUV' }
default { return 'SvIV' }
}
my $type = shift;
given ($type) {
when (/^(.*)\*$/) { return "SvToPtr<$1>(\"$type\")" }
when ('CString') { return 'PString' }
when ('CModule::EModRet') { return 'SvToEModRet' }
when (/unsigned/) { return 'SvUV' }
default { return 'SvIV' }
}
}