[NeoStats-Devel] [Commits] r2833 - trunk/src

Author: Fish
Date: Wed Sep 28 21:41:42 2005
New Revision: 2833

Modified:
   trunk/src/NeoStats.pm
   trunk/src/neostats.pm.h
   trunk/src/perl.c
Log:
update perl extension bindings. This pretty much works now


Modified: trunk/src/NeoStats.pm
==============================================================================
--- trunk/src/NeoStats.pm	(original)
+++ trunk/src/NeoStats.pm	Wed Sep 28 21:41:42 2005
@@ -50,6 +50,11 @@
     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 @@
     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 @@
       # 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 @@
     
     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 );

Modified: trunk/src/neostats.pm.h
==============================================================================
--- trunk/src/neostats.pm.h	(original)
+++ trunk/src/neostats.pm.h	Wed Sep 28 21:41:42 2005
@@ -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"

Modified: trunk/src/perl.c
==============================================================================
--- trunk/src/perl.c	(original)
+++ trunk/src/perl.c	Wed Sep 28 21:41:42 2005
@@ -433,11 +433,33 @@
 		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 @@
 	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 @@
 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;	
 	}