adam/znc
1
0
Fork 0
mirror of https://github.com/znc/znc.git synced 2026-08-07 01:13:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

Fix spaces in modperl.

Browse Source 
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
Download Patch File Download Diff File Expand all files Collapse all files
modules/modperl/CString.i
+96 -96
View File
@@ -15,31 +15,31 @@ class CString;
/*@SWIG:/usr/share/swig1.3/typemaps/std_strings.swg,4,%std_string_asptr@*/
%fragment("SWIG_" "AsPtr" "_" {CString},"header",fragment="SWIG_AsCharPtrAndSize") {
SWIGINTERN int
SWIG_AsPtr_std_string SWIG_PERL_DECL_ARGS_2(SV * obj, CString **val)
SWIG_AsPtr_std_string SWIG_PERL_DECL_ARGS_2(SV * obj, CString **val)
{
char* buf = 0 ; size_t size = 0; int alloc = SWIG_OLDOBJ;
if (SWIG_IsOK((SWIG_AsCharPtrAndSize(obj, &buf, &size, &alloc)))) {
if (buf) {
if (val) *val = new CString(buf, size - 1);
if (alloc == SWIG_NEWOBJ) free((char*)buf);
return SWIG_NEWOBJ;
} else {
if (val) *val = 0;
return SWIG_OLDOBJ;
}
if (buf) {
if (val) *val = new CString(buf, size - 1);
if (alloc == SWIG_NEWOBJ) free((char*)buf);
return SWIG_NEWOBJ;
} else {
if (val) *val = 0;
return SWIG_OLDOBJ;
}
} else {
static int init = 0;
static swig_type_info* descriptor = 0;
if (!init) {
descriptor = SWIG_TypeQuery("CString" " *");
init = 1;
}
if (descriptor) {
CString *vptr;
int res = SWIG_ConvertPtr(obj, (void**)&vptr, descriptor, 0);
if (SWIG_IsOK(res) && val) *val = vptr;
return res;
}
static int init = 0;
static swig_type_info* descriptor = 0;
if (!init) {
descriptor = SWIG_TypeQuery("CString" " *");
init = 1;
}
if (descriptor) {
CString *vptr;
int res = SWIG_ConvertPtr(obj, (void**)&vptr, descriptor, 0);
if (SWIG_IsOK(res) && val) *val = vptr;
return res;
}
}
return SWIG_ERROR;
}
@@ -54,12 +54,12 @@ SWIG_AsVal_std_string SWIG_PERL_DECL_ARGS_2(SV * obj, CString *val)
int res = SWIG_AsPtr_std_string SWIG_PERL_CALL_ARGS_2(obj, &v);
if (!SWIG_IsOK(res)) return res;
if (v) {
if (val) *val = *v;
if (SWIG_IsNewObj(res)) {
free((char*)v);
res = SWIG_DelNewMask(res);
}
return res;
if (val) *val = *v;
if (SWIG_IsNewObj(res)) {
free((char*)v);
res = SWIG_DelNewMask(res);
}
return res;
}
return SWIG_ERROR;
}
@@ -71,9 +71,9 @@ SWIGINTERNINLINE SV *
SWIG_From_std_string SWIG_PERL_DECL_ARGS_1(const CString& s)
{
if (s.size()) {
return SWIG_FromCharPtrAndSize(s.data(), s.size());
return SWIG_FromCharPtrAndSize(s.data(), s.size());
} else {
return SWIG_FromCharPtrAndSize(s.c_str(), 0);
return SWIG_FromCharPtrAndSize(s.c_str(), 0);
}
}
}
@@ -83,54 +83,54 @@ SWIG_From_std_string SWIG_PERL_DECL_ARGS_1(const CString& s)
/*@SWIG:/usr/share/swig1.3/typemaps/ptrtypes.swg,190,%typemaps_asptrfrom@*/
/*@SWIG:/usr/share/swig1.3/typemaps/ptrtypes.swg,160,%typemaps_asptr@*/
%fragment("SWIG_" "AsVal" "_" {CString},"header",fragment="SWIG_" "AsPtr" "_" {CString}) {
SWIGINTERNINLINE int
SWIG_AsVal_std_string SWIG_PERL_CALL_ARGS_2(SV * obj, CString *val)
{
CString *v = (CString *)0;
int res = SWIG_AsPtr_std_string SWIG_PERL_CALL_ARGS_2(obj, &v);
if (!SWIG_IsOK(res)) return res;
if (v) {
SWIGINTERNINLINE int
SWIG_AsVal_std_string SWIG_PERL_CALL_ARGS_2(SV * obj, CString *val)
{
CString *v = (CString *)0;
int res = SWIG_AsPtr_std_string SWIG_PERL_CALL_ARGS_2(obj, &v);
if (!SWIG_IsOK(res)) return res;
if (v) {
if (val) *val = *v;
if (SWIG_IsNewObj(res)) {
free((char*)v);
res = SWIG_DelNewMask(res);
}
return res;
}
return SWIG_ERROR;
}
}
return SWIG_ERROR;
}
}
/*@SWIG:/usr/share/swig1.3/typemaps/ptrtypes.swg,28,%ptr_in_typemap@*/
%typemap(in,fragment="SWIG_" "AsPtr" "_" {CString}) CString {
CString *ptr = (CString *)0;
int res = SWIG_AsPtr_std_string SWIG_PERL_CALL_ARGS_2($input, &ptr);
if (!SWIG_IsOK(res) || !ptr) {
SWIG_exception_fail(SWIG_ArgError((ptr ? res : SWIG_TypeError)), "in method '" "$symname" "', argument " "$argnum"" of type '" "$type""'");
}
$1 = *ptr;
if (SWIG_IsNewObj(res)) free((char*)ptr);
CString *ptr = (CString *)0;
int res = SWIG_AsPtr_std_string SWIG_PERL_CALL_ARGS_2($input, &ptr);
if (!SWIG_IsOK(res) || !ptr) {
SWIG_exception_fail(SWIG_ArgError((ptr ? res : SWIG_TypeError)), "in method '" "$symname" "', argument " "$argnum"" of type '" "$type""'");
}
$1 = *ptr;
if (SWIG_IsNewObj(res)) free((char*)ptr);
}
%typemap(freearg) CString "";
%typemap(in,fragment="SWIG_" "AsPtr" "_" {CString}) const CString & (int res = SWIG_OLDOBJ) {
CString *ptr = (CString *)0;
res = SWIG_AsPtr_std_string SWIG_PERL_CALL_ARGS_2($input, &ptr);
if (!SWIG_IsOK(res)) { SWIG_exception_fail(SWIG_ArgError(res), "in method '" "$symname" "', argument " "$argnum"" of type '" "$type""'"); }
if (!ptr) { SWIG_exception_fail(SWIG_ValueError, "invalid null reference " "in method '" "$symname" "', argument " "$argnum"" of type '" "$type""'"); }
$1 = ptr;
CString *ptr = (CString *)0;
res = SWIG_AsPtr_std_string SWIG_PERL_CALL_ARGS_2($input, &ptr);
if (!SWIG_IsOK(res)) { SWIG_exception_fail(SWIG_ArgError(res), "in method '" "$symname" "', argument " "$argnum"" of type '" "$type""'"); }
if (!ptr) { SWIG_exception_fail(SWIG_ValueError, "invalid null reference " "in method '" "$symname" "', argument " "$argnum"" of type '" "$type""'"); }
$1 = ptr;
}
%typemap(freearg,noblock=1) const CString & {
if (SWIG_IsNewObj(res$argnum)) free((char*)$1);
if (SWIG_IsNewObj(res$argnum)) free((char*)$1);
}
/*@SWIG@*/;
/*@SWIG:/usr/share/swig1.3/typemaps/ptrtypes.swg,53,%ptr_varin_typemap@*/
%typemap(varin,fragment="SWIG_" "AsPtr" "_" {CString}) CString {
CString *ptr = (CString *)0;
int res = SWIG_AsPtr_std_string SWIG_PERL_CALL_ARGS_2($input, &ptr);
if (!SWIG_IsOK(res) || !ptr) {
SWIG_exception_fail(SWIG_ArgError((ptr ? res : SWIG_TypeError)), "in variable '""$name""' of type '""$type""'");
}
$1 = *ptr;
if (SWIG_IsNewObj(res)) free((char*)ptr);
CString *ptr = (CString *)0;
int res = SWIG_AsPtr_std_string SWIG_PERL_CALL_ARGS_2($input, &ptr);
if (!SWIG_IsOK(res) || !ptr) {
SWIG_exception_fail(SWIG_ArgError((ptr ? res : SWIG_TypeError)), "in variable '""$name""' of type '""$type""'");
}
$1 = *ptr;
if (SWIG_IsNewObj(res)) free((char*)ptr);
}
/*@SWIG@*/;
;
@@ -140,36 +140,36 @@ SWIG_From_std_string SWIG_PERL_DECL_ARGS_1(const CString& s)
$1 = SWIG_CheckState(res);
}
%typemap(typecheck,noblock=1,precedence=135,fragment="SWIG_" "AsPtr" "_" {CString}) CString, const CString& {
%typemap(typecheck,noblock=1,precedence=135,fragment="SWIG_" "AsPtr" "_" {CString}) CString, const CString& {
int res = SWIG_AsPtr_std_string SWIG_PERL_CALL_ARGS_2($input, (CString**)(0));
$1 = SWIG_CheckState(res);
}
/*@SWIG@*/;
/*@SWIG:/usr/share/swig1.3/typemaps/inoutlist.swg,254,%ptr_input_typemap@*/
/*@SWIG:/usr/share/swig1.3/typemaps/inoutlist.swg,254,%ptr_input_typemap@*/
/*@SWIG:/usr/share/swig1.3/typemaps/inoutlist.swg,117,%_ptr_input_typemap@*/
%typemap(in,noblock=1,fragment="SWIG_" "AsPtr" "_" {CString}) CString *INPUT(int res = 0) {
res = SWIG_AsPtr_std_string SWIG_PERL_CALL_ARGS_2($input, &$1);
if (!SWIG_IsOK(res)) {
SWIG_exception_fail(SWIG_ArgError(res), "in method '" "$symname" "', argument " "$argnum"" of type '" "$type""'");
}
res = SWIG_AddTmpMask(res);
%typemap(in,noblock=1,fragment="SWIG_" "AsPtr" "_" {CString}) CString *INPUT(int res = 0) {
res = SWIG_AsPtr_std_string SWIG_PERL_CALL_ARGS_2($input, &$1);
if (!SWIG_IsOK(res)) {
SWIG_exception_fail(SWIG_ArgError(res), "in method '" "$symname" "', argument " "$argnum"" of type '" "$type""'");
}
res = SWIG_AddTmpMask(res);
}
%typemap(in,noblock=1,fragment="SWIG_" "AsPtr" "_" {CString}) CString &INPUT(int res = 0) {
res = SWIG_AsPtr_std_string SWIG_PERL_CALL_ARGS_2($input, &$1);
if (!SWIG_IsOK(res)) {
SWIG_exception_fail(SWIG_ArgError(res), "in method '" "$symname" "', argument " "$argnum"" of type '" "$type""'");
}
if (!$1) {
SWIG_exception_fail(SWIG_ValueError, "invalid null reference " "in method '" "$symname" "', argument " "$argnum"" of type '" "$type""'");
}
res = SWIG_AddTmpMask(res);
%typemap(in,noblock=1,fragment="SWIG_" "AsPtr" "_" {CString}) CString &INPUT(int res = 0) {
res = SWIG_AsPtr_std_string SWIG_PERL_CALL_ARGS_2($input, &$1);
if (!SWIG_IsOK(res)) {
SWIG_exception_fail(SWIG_ArgError(res), "in method '" "$symname" "', argument " "$argnum"" of type '" "$type""'");
}
if (!$1) {
SWIG_exception_fail(SWIG_ValueError, "invalid null reference " "in method '" "$symname" "', argument " "$argnum"" of type '" "$type""'");
}
res = SWIG_AddTmpMask(res);
}
%typemap(freearg,noblock=1,match="in") CString *INPUT, CString &INPUT {
if (SWIG_IsNewObj(res$argnum)) free((char*)$1);
if (SWIG_IsNewObj(res$argnum)) free((char*)$1);
}
%typemap(typecheck,noblock=1,precedence=135,fragment="SWIG_" "AsPtr" "_" {CString}) CString *INPUT, CString &INPUT {
int res = SWIG_AsPtr_std_string SWIG_PERL_CALL_ARGS_2($input, (CString**)0);
$1 = SWIG_CheckState(res);
int res = SWIG_AsPtr_std_string SWIG_PERL_CALL_ARGS_2($input, (CString**)0);
$1 = SWIG_CheckState(res);
}
/*@SWIG@*/
/*@SWIG@*/;
@@ -177,20 +177,20 @@ SWIG_From_std_string SWIG_PERL_DECL_ARGS_1(const CString& s)
/*@SWIG:/usr/share/swig1.3/typemaps/valtypes.swg,184,%typemaps_from@*/
/*@SWIG:/usr/share/swig1.3/typemaps/valtypes.swg,55,%value_out_typemap@*/
%typemap(out,noblock=1,fragment="SWIG_" "From" "_" {CString}) CString, const CString {
$result = SWIG_From_std_string SWIG_PERL_CALL_ARGS_1((CString)($1)); argvi++ ;
$result = SWIG_From_std_string SWIG_PERL_CALL_ARGS_1((CString)($1)); argvi++ ;
}
%typemap(out,noblock=1,fragment="SWIG_" "From" "_" {CString}) const CString& {
$result = SWIG_From_std_string SWIG_PERL_CALL_ARGS_1((CString)(*$1)); argvi++ ;
$result = SWIG_From_std_string SWIG_PERL_CALL_ARGS_1((CString)(*$1)); argvi++ ;
}
/*@SWIG@*/;
/*@SWIG:/usr/share/swig1.3/typemaps/valtypes.swg,79,%value_varout_typemap@*/
%typemap(varout,noblock=1,fragment="SWIG_" "From" "_" {CString}) CString, const CString& {
sv_setsv($result,SWIG_From_std_string SWIG_PERL_CALL_ARGS_1((CString)($1))) ;
sv_setsv($result,SWIG_From_std_string SWIG_PERL_CALL_ARGS_1((CString)($1))) ;
}
/*@SWIG@*/;
/*@SWIG:/usr/share/swig1.3/typemaps/valtypes.swg,87,%value_constcode_typemap@*/
%typemap(constcode,noblock=1,fragment="SWIG_" "From" "_" {CString}) CString {
/*@SWIG:/usr/share/swig1.3/perl5/perltypemaps.swg,65,%set_constant@*/ do {
/*@SWIG:/usr/share/swig1.3/perl5/perltypemaps.swg,65,%set_constant@*/ do {
SV *sv = get_sv((char*) SWIG_prefix "$symname", TRUE | 0x2 | GV_ADDMULTI);
sv_setsv(sv, SWIG_From_std_string SWIG_PERL_CALL_ARGS_1((CString)($value)));
SvREADONLY_on(sv);
@@ -200,40 +200,40 @@ SWIG_From_std_string SWIG_PERL_DECL_ARGS_1(const CString& s)
;
/*@SWIG:/usr/share/swig1.3/typemaps/valtypes.swg,154,%value_throws_typemap@*/
%typemap(throws,noblock=1,fragment="SWIG_" "From" "_" {CString}) CString {
sv_setsv(GvSV(PL_errgv), SWIG_From_std_string SWIG_PERL_CALL_ARGS_1((CString)($1))); SWIG_fail ;
sv_setsv(GvSV(PL_errgv), SWIG_From_std_string SWIG_PERL_CALL_ARGS_1((CString)($1))); SWIG_fail ;
}
/*@SWIG@*/;
/*@SWIG:/usr/share/swig1.3/typemaps/inoutlist.swg,258,%value_output_typemap@*/
/*@SWIG:/usr/share/swig1.3/typemaps/inoutlist.swg,258,%value_output_typemap@*/
/*@SWIG:/usr/share/swig1.3/typemaps/inoutlist.swg,175,%_value_output_typemap@*/
%typemap(in,numinputs=0,noblock=1)
CString *OUTPUT ($*1_ltype temp, int res = SWIG_TMPOBJ),
%typemap(in,numinputs=0,noblock=1)
CString *OUTPUT ($*1_ltype temp, int res = SWIG_TMPOBJ),
CString &OUTPUT ($*1_ltype temp, int res = SWIG_TMPOBJ) {
$1 = &temp;
}
%typemap(argout,noblock=1,fragment="SWIG_" "From" "_" {CString}) CString *OUTPUT, CString &OUTPUT {
if (SWIG_IsTmpObj(res$argnum)) {
if (argvi >= items) EXTEND(sp,1); $result = SWIG_From_std_string SWIG_PERL_CALL_ARGS_1((*$1)); argvi++ ;
if (argvi >= items) EXTEND(sp,1); $result = SWIG_From_std_string SWIG_PERL_CALL_ARGS_1((*$1)); argvi++ ;
} else {
int new_flags = SWIG_IsNewObj(res$argnum) ? (SWIG_POINTER_OWN | $shadow) : $shadow;
if (argvi >= items) EXTEND(sp,1); $result = SWIG_NewPointerObj((void*)($1), $1_descriptor, new_flags); argvi++ ;
int new_flags = SWIG_IsNewObj(res$argnum) ? (SWIG_POINTER_OWN | $shadow) : $shadow;
if (argvi >= items) EXTEND(sp,1); $result = SWIG_NewPointerObj((void*)($1), $1_descriptor, new_flags); argvi++ ;
}
}
/*@SWIG@*/
/*@SWIG@*/;
/*@SWIG@*/;
/*@SWIG:/usr/share/swig1.3/typemaps/inoutlist.swg,258,%value_output_typemap@*/
/*@SWIG:/usr/share/swig1.3/typemaps/inoutlist.swg,258,%value_output_typemap@*/
/*@SWIG:/usr/share/swig1.3/typemaps/inoutlist.swg,175,%_value_output_typemap@*/
%typemap(in,numinputs=0,noblock=1)
CString *OUTPUT ($*1_ltype temp, int res = SWIG_TMPOBJ),
%typemap(in,numinputs=0,noblock=1)
CString *OUTPUT ($*1_ltype temp, int res = SWIG_TMPOBJ),
CString &OUTPUT ($*1_ltype temp, int res = SWIG_TMPOBJ) {
$1 = &temp;
}
%typemap(argout,noblock=1,fragment="SWIG_" "From" "_" {CString}) CString *OUTPUT, CString &OUTPUT {
if (SWIG_IsTmpObj(res$argnum)) {
if (argvi >= items) EXTEND(sp,1); $result = SWIG_From_std_string SWIG_PERL_CALL_ARGS_1((*$1)); argvi++ ;
if (argvi >= items) EXTEND(sp,1); $result = SWIG_From_std_string SWIG_PERL_CALL_ARGS_1((*$1)); argvi++ ;
} else {
int new_flags = SWIG_IsNewObj(res$argnum) ? (SWIG_POINTER_OWN | $shadow) : $shadow;
if (argvi >= items) EXTEND(sp,1); $result = SWIG_NewPointerObj((void*)($1), $1_descriptor, new_flags); argvi++ ;
int new_flags = SWIG_IsNewObj(res$argnum) ? (SWIG_POINTER_OWN | $shadow) : $shadow;
if (argvi >= items) EXTEND(sp,1); $result = SWIG_NewPointerObj((void*)($1), $1_descriptor, new_flags); argvi++ ;
}
}
/*@SWIG@*/
modules/modperl/codegen.pl
+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' }
}
}
modules/modperl/modperl.i
+91 -91
View File
@@ -41,28 +41,28 @@
%include <std_list.i>
namespace std {
template<class K> class set {
public:
set();
set(const set<K>&);
};
template<class K> class set {
public:
set();
set(const set<K>&);
};
}
%include "modperl/CString.i"
%template(_stringlist) std::list<CString>;
%typemap(out) std::list<CString> {
std::list<CString>::const_iterator i;
unsigned int j;
int len = $1.size();
SV **svs = new SV*[len];
for (i=$1.begin(), j=0; i!=$1.end(); i++, j++) {
svs[j] = sv_newmortal();
SwigSvFromString(svs[j], *i);
}
AV *myav = av_make(len, svs);
delete[] svs;
$result = newRV_noinc((SV*) myav);
sv_2mortal($result);
argvi++;
std::list<CString>::const_iterator i;
unsigned int j;
int len = $1.size();
SV **svs = new SV*[len];
for (i=$1.begin(), j=0; i!=$1.end(); i++, j++) {
svs[j] = sv_newmortal();
SwigSvFromString(svs[j], *i);
}
AV *myav = av_make(len, svs);
delete[] svs;
$result = newRV_noinc((SV*) myav);
sv_2mortal($result);
argvi++;
}
#define u_short unsigned short
@@ -92,61 +92,61 @@ namespace std {
%include "modperl/module.h"
%inline %{
class String : public CString {
public:
String() {}
String(const CString& s) : CString(s) {}
String(double d, int prec=2): CString(d, prec) {}
String(float f, int prec=2) : CString(f, prec) {}
String(int i) : CString(i) {}
String(unsigned int i) : CString(i) {}
String(long int i) : CString(i) {}
String(unsigned long int i) : CString(i) {}
String(char c) : CString(c) {}
String(unsigned char c) : CString(c) {}
String(short int i) : CString(i) {}
String(unsigned short int i): CString(i) {}
String(bool b) : CString(b) {}
CString GetPerlStr() {
return *this;
}
};
class String : public CString {
public:
String() {}
String(const CString& s) : CString(s) {}
String(double d, int prec=2): CString(d, prec) {}
String(float f, int prec=2) : CString(f, prec) {}
String(int i) : CString(i) {}
String(unsigned int i) : CString(i) {}
String(long int i) : CString(i) {}
String(unsigned long int i) : CString(i) {}
String(char c) : CString(c) {}
String(unsigned char c) : CString(c) {}
String(short int i) : CString(i) {}
String(unsigned short int i): CString(i) {}
String(bool b) : CString(b) {}
CString GetPerlStr() {
return *this;
}
};
%}
%extend CModule {
std::list<CString> _GetNVKeys() {
std::list<CString> res;
for (MCString::iterator i = $self->BeginNV(); i != $self->EndNV(); ++i) {
res.push_back(i->first);
}
return res;
}
bool ExistsNV(const CString& sName) {
return $self->EndNV() != $self->FindNV(sName);
}
std::list<CString> _GetNVKeys() {
std::list<CString> res;
for (MCString::iterator i = $self->BeginNV(); i != $self->EndNV(); ++i) {
res.push_back(i->first);
}
return res;
}
bool ExistsNV(const CString& sName) {
return $self->EndNV() != $self->FindNV(sName);
}
}
%perlcode %{
package ZNC::CModule;
sub GetNVKeys {
my $result = _GetNVKeys(@_);
return @$result;
}
package ZNC::CModule;
sub GetNVKeys {
my $result = _GetNVKeys(@_);
return @$result;
}
%}
%extend CModules {
void push_back(CModule* p) {
$self->push_back(p);
}
bool removeModule(CModule* p) {
for (CModules::iterator i = $self->begin(); $self->end() != i; ++i) {
if (*i == p) {
$self->erase(i);
return true;
}
}
return false;
}
void push_back(CModule* p) {
$self->push_back(p);
}
bool removeModule(CModule* p) {
for (CModules::iterator i = $self->begin(); $self->end() != i; ++i) {
if (*i == p) {
$self->erase(i);
return true;
}
}
return false;
}
}
/* Web */
@@ -157,44 +157,44 @@ typedef vector<pair<CString, CString> > VPair;
%template(VWebSubPages) vector<TWebSubPage>;
%inline %{
void _VPair_Add2Str(VPair* self, const CString& a, const CString& b) {
self->push_back(std::make_pair(a, b));
}
void _VPair_Add2Str(VPair* self, const CString& a, const CString& b) {
self->push_back(std::make_pair(a, b));
}
%}
%extend CTemplate {
void set(const CString& key, const CString& value) {
(*$self)[key] = value;
}
void set(const CString& key, const CString& value) {
(*$self)[key] = value;
}
}
%inline %{
TWebSubPage _CreateWebSubPage(const CString& sName, const CString& sTitle, const VPair& vParams, unsigned int uFlags) {
return new CWebSubPage(sName, sTitle, vParams, uFlags);
}
TWebSubPage _CreateWebSubPage(const CString& sName, const CString& sTitle, const VPair& vParams, unsigned int uFlags) {
return new CWebSubPage(sName, sTitle, vParams, uFlags);
}
%}
%perlcode %{
package ZNC;
sub CreateWebSubPage {
my ($name, %arg) = @_;
my $params = $arg{params}//{};
my $vpair = ZNC::VPair->new;
while (my ($key, $val) = each %$params) {
ZNC::_VPair_Add2Str($vpair, $key, $val);
}
my $flags = 0;
$flags |= $ZNC::CWebSubPage::F_ADMIN if $arg{admin}//0;
return _CreateWebSubPage($name, $arg{title}//'', $vpair, $flags);
}
package ZNC;
sub CreateWebSubPage {
my ($name, %arg) = @_;
my $params = $arg{params}//{};
my $vpair = ZNC::VPair->new;
while (my ($key, $val) = each %$params) {
ZNC::_VPair_Add2Str($vpair, $key, $val);
}
my $flags = 0;
$flags |= $ZNC::CWebSubPage::F_ADMIN if $arg{admin}//0;
return _CreateWebSubPage($name, $arg{title}//'', $vpair, $flags);
}
%}
%perlcode %{
package ZNC;
*CONTINUE = *ZNC::CModule::CONTINUE;
*HALT = *ZNC::CModule::HALT;
*HALTMODS = *ZNC::CModule::HALTMODS;
*HALTCORE = *ZNC::CModule::HALTCORE;
*UNLOAD = *ZNC::CModule::UNLOAD;
package ZNC;
*CONTINUE = *ZNC::CModule::CONTINUE;
*HALT = *ZNC::CModule::HALT;
*HALTMODS = *ZNC::CModule::HALTMODS;
*HALTCORE = *ZNC::CModule::HALTCORE;
*UNLOAD = *ZNC::CModule::UNLOAD;
%}
modules/modperl/module.h
+15 -15
View File
@@ -11,16 +11,16 @@
#include "Modules.h"
class CPerlModule : public CModule {
CString m_sPerlID;
CString m_sPerlID;
VWebSubPages* _GetSubPages();
public:
CPerlModule(CUser* pUser, const CString& sModName, const CString& sDataPath,
const CString& sPerlID)
: CModule(NULL, pUser, sModName, sDataPath) {
m_sPerlID = sPerlID;
}
CString GetPerlID() { return m_sPerlID; }
CPerlModule(CUser* pUser, const CString& sModName, const CString& sDataPath,
const CString& sPerlID)
: CModule(NULL, pUser, sModName, sDataPath) {
m_sPerlID = sPerlID;
}
CString GetPerlID() { return m_sPerlID; }
virtual bool OnBoot();
virtual bool WebRequiresLogin();
virtual bool WebRequiresAdmin();
@@ -89,24 +89,24 @@ public:
};
static inline CPerlModule* AsPerlModule(CModule* p) {
return dynamic_cast<CPerlModule*>(p);
return dynamic_cast<CPerlModule*>(p);
}
enum ELoadPerlMod {
Perl_NotFound,
Perl_Loaded,
Perl_LoadError,
Perl_NotFound,
Perl_Loaded,
Perl_LoadError,
};
class CPerlTimer : public CTimer {
CString m_sPerlID;
CString m_sPerlID;
public:
CPerlTimer(CPerlModule* pModule, unsigned int uInterval, unsigned int uCycles, const CString& sLabel, const CString& sDescription, const CString& sPerlID)
: CTimer (pModule, uInterval, uCycles, sLabel, sDescription), m_sPerlID(sPerlID) {
pModule->AddTimer(this);
}
virtual void RunJob();
CString GetPerlID() { return m_sPerlID; }
CString GetPerlID() { return m_sPerlID; }
};
inline CPerlTimer* CreatePerlTimer(CPerlModule* pModule, unsigned int uInterval, unsigned int uCycles,
@@ -118,7 +118,7 @@ class CPerlSocket : public CSocket {
CString m_sPerlID;
public:
CPerlSocket(CPerlModule* pModule, const CString& sPerlID) : CSocket(pModule), m_sPerlID(sPerlID) {}
CString GetPerlID() { return m_sPerlID; }
CString GetPerlID() { return m_sPerlID; }
virtual void Connected();
virtual void Disconnected();
virtual void Timeout();
modules/modperl/startup.pl
+60 -60
View File
@@ -27,25 +27,25 @@ sub CreateUUID {
}
sub unloadByIDUser {
my ($id, $user) = @_;
$pmods{$id}->OnShutdown;
$user->GetModules->removeModule($pmods{$id}{_cmod});
delete $pmods{$id}{_cmod};# Just for the case
my ($id, $user) = @_;
$pmods{$id}->OnShutdown;
$user->GetModules->removeModule($pmods{$id}{_cmod});
delete $pmods{$id}{_cmod};# Just for the case
delete $pmods{$id}{_nv};
delete $pmods{$id}{_ptimers};
delete $pmods{$id}{_sockets};
delete $pmods{$id};
delete $pmods{$id};
}
sub UnloadModule {
my ($cmod) = @_;
unloadByIDUser($cmod->GetPerlID, $cmod->GetUser);
my ($cmod) = @_;
unloadByIDUser($cmod->GetPerlID, $cmod->GetUser);
}
sub UnloadAll {
while (my ($id, $pmod) = each %pmods) {
unloadByIDUser($id, $pmod->{_cmod}->GetUser);
}
while (my ($id, $pmod) = each %pmods) {
unloadByIDUser($id, $pmod->{_cmod}->GetUser);
}
}
sub IsModule {
@@ -56,84 +56,84 @@ sub IsModule {
}
sub LoadModule {
my ($modname, $args, $user) = @_;
$modname =~ /^\w+$/ or return ($ZNC::Perl_LoadError, "Module names can only contain letters, numbers and underscores, [$modname] is invalid.");
return ($ZNC::Perl_LoadError, "Module [$modname] already loaded.") if defined $user->GetModules->FindModule($modname);
my $modpath = ZNC::String->new;
my $datapath = ZNC::String->new;
ZNC::CModules::FindModPath("$modname.pm", $modpath, $datapath) or return ($ZNC::Perl_NotFound, "Unable to find module [$modname]");
$modpath = $modpath->GetPerlStr;
my ($modname, $args, $user) = @_;
$modname =~ /^\w+$/ or return ($ZNC::Perl_LoadError, "Module names can only contain letters, numbers and underscores, [$modname] is invalid.");
return ($ZNC::Perl_LoadError, "Module [$modname] already loaded.") if defined $user->GetModules->FindModule($modname);
my $modpath = ZNC::String->new;
my $datapath = ZNC::String->new;
ZNC::CModules::FindModPath("$modname.pm", $modpath, $datapath) or return ($ZNC::Perl_NotFound, "Unable to find module [$modname]");
$modpath = $modpath->GetPerlStr;
return ($ZNC::Perl_LoadError, "Incorrect perl module.") unless IsModule $modpath, $modname;
require $modpath;
my $id = CreateUUID;
require $modpath;
my $id = CreateUUID;
$datapath = $datapath->GetPerlStr;
$datapath =~ s/\.pm$//;
my $cmod = ZNC::CPerlModule->new($user, $modname, $datapath, $id);
my $cmod = ZNC::CPerlModule->new($user, $modname, $datapath, $id);
my %nv;
tie %nv, 'ZNC::ModuleNV', $cmod;
my $pmod = bless {
my $pmod = bless {
_cmod=>$cmod,
_nv=>\%nv
}, $modname;
$cmod->SetDescription($pmod->description);
$cmod->SetArgs($args);
$cmod->SetModPath($modpath);
$pmods{$id} = $pmod;
$user->GetModules->push_back($cmod);
my $x = '';
my $loaded = 0;
eval {
$loaded = $pmod->OnLoad($args, $x);
};
$cmod->SetDescription($pmod->description);
$cmod->SetArgs($args);
$cmod->SetModPath($modpath);
$pmods{$id} = $pmod;
$user->GetModules->push_back($cmod);
my $x = '';
my $loaded = 0;
eval {
$loaded = $pmod->OnLoad($args, $x);
};
if ($@) {
$x .= ' ' if '' ne $x;
$x .= $@;
}
if (!$loaded) {
unloadByIDUser($id, $user);
if ($x) {
return ($ZNC::Perl_LoadError, "Module [$modname] aborted: $x");
}
return ($ZNC::Perl_LoadError, "Module [$modname] aborted.");
}
if ($x) {
return ($ZNC::Perl_Loaded, "Loaded module [$modname] [$x] [$modpath]");
}
return ($ZNC::Perl_Loaded, "Loaded module [$modname] [$modpath]")
if (!$loaded) {
unloadByIDUser($id, $user);
if ($x) {
return ($ZNC::Perl_LoadError, "Module [$modname] aborted: $x");
}
return ($ZNC::Perl_LoadError, "Module [$modname] aborted.");
}
if ($x) {
return ($ZNC::Perl_Loaded, "Loaded module [$modname] [$x] [$modpath]");
}
return ($ZNC::Perl_Loaded, "Loaded module [$modname] [$modpath]")
}
sub GetModInfo {
my ($modname) = @_;
$modname =~ /^\w+$/ or return ($ZNC::Perl_LoadError, "Module names can only contain letters, numbers and underscores, [$modname] is invalid.");
my $modpath = ZNC::String->new;
my $datapath = ZNC::String->new;
ZNC::CModules::FindModPath("$modname.pm", $modpath, $datapath) or return ($ZNC::Perl_NotFound, "Unable to find module [$modname]");
$modpath = $modpath->GetPerlStr;
my ($modname) = @_;
$modname =~ /^\w+$/ or return ($ZNC::Perl_LoadError, "Module names can only contain letters, numbers and underscores, [$modname] is invalid.");
my $modpath = ZNC::String->new;
my $datapath = ZNC::String->new;
ZNC::CModules::FindModPath("$modname.pm", $modpath, $datapath) or return ($ZNC::Perl_NotFound, "Unable to find module [$modname]");
$modpath = $modpath->GetPerlStr;
return ($ZNC::Perl_LoadError, "Incorrect perl module.") unless IsModule $modpath, $modname;
require $modpath;
my $pmod = bless {}, $modname;
return ($ZNC::Perl_Loaded, $modpath, $pmod->description)
my $pmod = bless {}, $modname;
return ($ZNC::Perl_Loaded, $modpath, $pmod->description)
}
sub ModInfoByPath {
my ($modpath, $modname) = @_;
my ($modpath, $modname) = @_;
die "Incorrect perl module." unless IsModule $modpath, $modname;
require $modpath;
my $pmod = bless {}, $modname;
return ($pmod->description)
require $modpath;
my $pmod = bless {}, $modname;
return ($pmod->description)
}
sub CallModFunc {
my $id = shift;
my $func = shift;
my $id = shift;
my $func = shift;
my $default = shift;
my @arg = @_;
my $res = $pmods{$id}->$func(@arg);
my @arg = @_;
my $res = $pmods{$id}->$func(@arg);
# print "Returned from $func(@_): $res, (@arg)\n";
unless (defined $res) {
$res = $default if defined $default;
}
($res, @arg)
($res, @arg)
}
sub CallTimer {
@@ -222,7 +222,7 @@ sub SCALAR {
package ZNC::Module;
sub description {
"< Placeholder for a description >"
"< Placeholder for a description >"
}
# Default implementations for module hooks. They can be overriden in derived modules.