From 6a22f33a2e489e28db485360439365b3ce2359ff Mon Sep 17 00:00:00 2001 From: Fish <> Date: Wed, 28 Sep 2005 13:41:42 +0000 Subject: [PATCH] update perl extension bindings. This pretty much works now --- src/NeoStats.pm | 83 +++++++++++++++++++++++++++++++++++++++++++++++ src/neostats.pm.h | 83 +++++++++++++++++++++++++++++++++++++++++++++++ src/perl.c | 35 +++++++++++++++++--- 3 files changed, 196 insertions(+), 5 deletions(-) diff --git a/src/NeoStats.pm b/src/NeoStats.pm index 72f5f8b5..b88e200b 100644 --- a/src/NeoStats.pm +++ b/src/NeoStats.pm @@ -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 $/; }; + 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 ); diff --git a/src/neostats.pm.h b/src/neostats.pm.h index abc28b6e..322ee25d 100644 --- a/src/neostats.pm.h +++ b/src/neostats.pm.h @@ -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 $/; };\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" diff --git a/src/perl.c b/src/perl.c index 302e3cbd..49fd7e26 100644 --- a/src/perl.c +++ b/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; }