update perl extension bindings. This pretty much works now
This commit is contained in:
Fish
parent
68c8621998
commit
6a22f33a2e
3 changed files with 196 additions and 5 deletions
|
|
@ -50,6 +50,11 @@ use Symbol();
|
|||
my ($package) = caller;
|
||||
my $pkg_info = NeoStats::Embed::pkg_info( $package );
|
||||
my $filename = $pkg_info->{filename};
|
||||
|
||||
if ($pkg_info->{type} != 0) {
|
||||
NeoStats::debug("Extension tried to register as a module");
|
||||
return NeoStats::NS_FAILURE;
|
||||
}
|
||||
|
||||
my ($name, $version, $description, $startupcb, $shutdowncb) = @_;
|
||||
$description = "" unless defined $description;
|
||||
|
|
@ -69,6 +74,33 @@ use Symbol();
|
|||
return NeoStats::NS_SUCCESS;
|
||||
}
|
||||
|
||||
sub registerextension {
|
||||
if (@_ != 4) {
|
||||
NeoStats::debug("Invalid Number of arguments to registerextension");
|
||||
return NeoStats::NS_FAILURE;
|
||||
}
|
||||
my ($package) = caller;
|
||||
my $pkg_info = NeoStats::Embed::pkg_info( $package );
|
||||
my $filename = $pkg_info->{filename};
|
||||
|
||||
if ($pkg_info->{type} != 1) {
|
||||
NeoStats::debug("Perl Module tried to register as a extension");
|
||||
return NeoStats::NS_FAILURE;
|
||||
}
|
||||
|
||||
my ($name, $version, $startupcb, $shutdowncb) = @_;
|
||||
$pkg_info->{name} = $name;
|
||||
$pkg_info->{version} = $version;
|
||||
$pkg_info->{gui_entry} =
|
||||
NeoStats::Internal::registerextension( $pkg_info->{name}, $pkg_info->{version});
|
||||
$startupcb = NeoStats::Embed::fix_callback( $package, $startupcb );
|
||||
$shutdowncb = NeoStats::Embed::fix_callback( $package, $shutdowncb );
|
||||
$pkg_info->{shutdown} = $shutdowncb;
|
||||
$pkg_info->{startup} = $startupcb;
|
||||
|
||||
# keep with old behavior
|
||||
return NeoStats::NS_SUCCESS;
|
||||
}
|
||||
|
||||
|
||||
sub hook_event {
|
||||
|
|
@ -719,6 +751,7 @@ $SIG{__WARN__} = sub {
|
|||
# this must come before the eval or the filename will not be found in
|
||||
# NeoStats::register
|
||||
$scripts{$package}{filename} = $file;
|
||||
$scripts{$package}{type} = 0;
|
||||
|
||||
{
|
||||
# no strict; no warnings;
|
||||
|
|
@ -741,7 +774,57 @@ $SIG{__WARN__} = sub {
|
|||
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
sub loadextension {
|
||||
my $file = expand_homedir( shift @_ );
|
||||
|
||||
my $package = file2pkg( $file );
|
||||
|
||||
if ( open FH, $file ) {
|
||||
my $source = do {local $/; <FH>};
|
||||
close FH;
|
||||
|
||||
if ( my $replacements = $source =~ s/^\s*package ([\w:]+).*?;//mg ) {
|
||||
my $original_package = $1;
|
||||
|
||||
if ( $replacements > 1 ) {
|
||||
NeoStats::debug( "Too many package defintions, only 1 is allowed\n" );
|
||||
return 1;
|
||||
}
|
||||
|
||||
# fixes things up for code calling subs with fully qualified names
|
||||
$source =~ s/${original_package}:://g;
|
||||
|
||||
}
|
||||
|
||||
# this must come before the eval or the filename will not be found in
|
||||
# NeoStats::registerextension
|
||||
$scripts{$package}{filename} = $file;
|
||||
$scripts{$package}{type} = 1;
|
||||
|
||||
{
|
||||
# no strict; no warnings;
|
||||
eval "package $package; $source;";
|
||||
}
|
||||
|
||||
if ( $@ ) {
|
||||
# something went wrong
|
||||
NeoStats::debug( "Error loading extension '$file':\n$@\n" );
|
||||
|
||||
# make sure the script list doesn't contain false information
|
||||
unload( $scripts{$package}{filename} );
|
||||
return 1;
|
||||
}
|
||||
|
||||
} else {
|
||||
NeoStats::debug( "Error opening '$file': $!\n" );
|
||||
return 2;
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
sub unload {
|
||||
my $file = shift @_;
|
||||
my $package = file2pkg( $file );
|
||||
|
|
|
|||
|
|
@ -51,6 +51,11 @@
|
|||
"my $pkg_info = NeoStats::Embed::pkg_info( $package );\n"
|
||||
"my $filename = $pkg_info->{filename};\n"
|
||||
"\n"
|
||||
"if ($pkg_info->{type} != 0) {\n"
|
||||
"NeoStats::debug(\"Extension tried to register as a module\");\n"
|
||||
"return NeoStats::NS_FAILURE;\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"my ($name, $version, $description, $startupcb, $shutdowncb) = @_;\n"
|
||||
"$description = \"\" unless defined $description;\n"
|
||||
"\n"
|
||||
|
|
@ -69,6 +74,33 @@
|
|||
"return NeoStats::NS_SUCCESS;\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"sub registerextension {\n"
|
||||
"if (@_ != 4) {\n"
|
||||
"NeoStats::debug(\"Invalid Number of arguments to registerextension\");\n"
|
||||
"return NeoStats::NS_FAILURE;\n"
|
||||
"}\n"
|
||||
"my ($package) = caller;\n"
|
||||
"my $pkg_info = NeoStats::Embed::pkg_info( $package );\n"
|
||||
"my $filename = $pkg_info->{filename};\n"
|
||||
"\n"
|
||||
"if ($pkg_info->{type} != 1) {\n"
|
||||
"NeoStats::debug(\"Perl Module tried to register as a extension\");\n"
|
||||
"return NeoStats::NS_FAILURE;\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"my ($name, $version, $startupcb, $shutdowncb) = @_;\n"
|
||||
"$pkg_info->{name} = $name;\n"
|
||||
"$pkg_info->{version} = $version;\n"
|
||||
"$pkg_info->{gui_entry} =\n"
|
||||
"NeoStats::Internal::registerextension( $pkg_info->{name}, $pkg_info->{version});\n"
|
||||
"$startupcb = NeoStats::Embed::fix_callback( $package, $startupcb );\n"
|
||||
"$shutdowncb = NeoStats::Embed::fix_callback( $package, $shutdowncb );\n"
|
||||
"$pkg_info->{shutdown} = $shutdowncb;\n"
|
||||
"$pkg_info->{startup} = $startupcb;\n"
|
||||
"\n"
|
||||
"\n"
|
||||
"return NeoStats::NS_SUCCESS;\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"\n"
|
||||
"sub hook_event {\n"
|
||||
|
|
@ -719,6 +751,7 @@
|
|||
"\n"
|
||||
"\n"
|
||||
"$scripts{$package}{filename} = $file;\n"
|
||||
"$scripts{$package}{type} = 0;\n"
|
||||
"\n"
|
||||
"{\n"
|
||||
"\n"
|
||||
|
|
@ -742,6 +775,56 @@
|
|||
"return 0;\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"\n"
|
||||
"sub loadextension {\n"
|
||||
"my $file = expand_homedir( shift @_ );\n"
|
||||
"\n"
|
||||
"my $package = file2pkg( $file );\n"
|
||||
"\n"
|
||||
"if ( open FH, $file ) {\n"
|
||||
"my $source = do {local $/; <FH>};\n"
|
||||
"close FH;\n"
|
||||
"\n"
|
||||
"if ( my $replacements = $source =~ s/^\\s*package ([\\w:]+).*?;//mg ) {\n"
|
||||
"my $original_package = $1;\n"
|
||||
"\n"
|
||||
"if ( $replacements > 1 ) {\n"
|
||||
"NeoStats::debug( \"Too many package defintions, only 1 is allowed\\n\" );\n"
|
||||
"return 1;\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"\n"
|
||||
"$source =~ s/${original_package}:://g;\n"
|
||||
"\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"\n"
|
||||
"\n"
|
||||
"$scripts{$package}{filename} = $file;\n"
|
||||
"$scripts{$package}{type} = 1;\n"
|
||||
"\n"
|
||||
"{\n"
|
||||
"\n"
|
||||
"eval \"package $package; $source;\";\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"if ( $@ ) {\n"
|
||||
"\n"
|
||||
"NeoStats::debug( \"Error loading extension '$file':\\n$@\\n\" );\n"
|
||||
"\n"
|
||||
"\n"
|
||||
"unload( $scripts{$package}{filename} );\n"
|
||||
"return 1;\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"} else {\n"
|
||||
"NeoStats::debug( \"Error opening '$file': $!\\n\" );\n"
|
||||
"return 2;\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"return 0;\n"
|
||||
"}\n"
|
||||
"\n"
|
||||
"sub unload {\n"
|
||||
"my $file = shift @_;\n"
|
||||
"my $package = file2pkg( $file );\n"
|
||||
|
|
|
|||
35
src/perl.c
35
src/perl.c
|
|
@ -433,11 +433,33 @@ XS (XS_NeoStats_register)
|
|||
mod->info->version = strndup(SvPV_nolen (ST (1)), sv_len(ST (1)));
|
||||
mod->info->description = strndup(SvPV_nolen (ST (2)), sv_len(ST(2)));
|
||||
mod->pm->registered = 1;
|
||||
mod->pm->type = TYPE_MODULE;
|
||||
XSRETURN_UV (PTR2UV (mod));
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
static
|
||||
XS (XS_NeoStats_registerextension)
|
||||
{
|
||||
Module *mod;
|
||||
dXSARGS;
|
||||
if (items != 2) {
|
||||
nlog(LOG_WARNING, "Usage: NeoStats::Internal::registerextension(scriptname, version)");
|
||||
} else {
|
||||
mod = GET_CUR_MODULE();
|
||||
if (!mod) {
|
||||
nlog(LOG_WARNING, "Current Mod Stack for Perl Mods is screwed");
|
||||
XSRETURN_EMPTY;
|
||||
}
|
||||
mod->pm->extname = strndup(SvPV_nolen(ST(0)), sv_len(ST (0)));
|
||||
mod->pm->extversion = strndup(SvPV_nolen (ST (1)), sv_len(ST (1)));
|
||||
mod->pm->registered = 1;
|
||||
mod->pm->type = TYPE_EXTENSION;
|
||||
XSRETURN_UV (PTR2UV (mod));
|
||||
}
|
||||
}
|
||||
|
||||
/* NeoStats::debug(output) */
|
||||
static
|
||||
XS (XS_NeoStats_debug)
|
||||
|
|
@ -1535,6 +1557,7 @@ xs_init (pTHX)
|
|||
newCONSTSUB (stash, "NS_FAILURE", newSViv (NS_FAILURE));
|
||||
|
||||
if (mod->pm->extninit) {
|
||||
newXS ("NeoStats::Internal::registerextension", XS_NeoStats_registerextension, __FILE__);
|
||||
mod->pm->extninit();
|
||||
}
|
||||
}
|
||||
|
|
@ -1595,27 +1618,29 @@ Module *load_perlfiles (const char *filename, Module *mod, perl_xs_init init_fun
|
|||
int load_perlextension(const char *filename, perl_xs_init init_func, Client *u)
|
||||
{
|
||||
Module *mod;
|
||||
char filebuf[BUFSIZE];
|
||||
|
||||
mod = GET_CUR_MODULE();
|
||||
if (!mod) {
|
||||
nlog(LOG_WARNING, "Trying to laod a Perl Extension %s in the core? No No", filename);
|
||||
return NS_FAILURE;
|
||||
}
|
||||
|
||||
mod = load_perlfiles((const char *)filename, mod, init_func);
|
||||
ircsnprintf(filebuf, BUFSIZE, "modules/%s.ple", filename);
|
||||
printf("%s\n",filebuf);
|
||||
mod = load_perlfiles((const char *)filebuf, mod, init_func);
|
||||
|
||||
SET_RUN_LEVEL(mod);
|
||||
if (!execute_perl (mod, sv_2mortal (newSVpv ("NeoStats::Embed::loadextension", 0)),
|
||||
1, (char *)filename)) {
|
||||
1, (char *)filebuf)) {
|
||||
/* if we are here, check that pm->mod->description has something, otherwise the script didnt register */
|
||||
if (!mod->pm->registered) {
|
||||
load_module_error(u, filename, __("Perl extension didn't register.", u));
|
||||
load_module_error(u, filebuf, __("Perl extension didn't register.", u));
|
||||
unload_perlextension(mod);
|
||||
return NS_FAILURE;
|
||||
}
|
||||
/* it loaded ok */
|
||||
} else {
|
||||
load_module_error(u, filename, __("Errors in Perl extension", u));
|
||||
load_module_error(u, filebuf, __("Errors in Perl extension", u));
|
||||
unload_perlextension(mod);
|
||||
return NS_FAILURE;
|
||||
}
|
||||
|
|
|
|||
Reference in a new issue