Add documentation for %scripts and $current_package in Xchat::Embed.

Remove the single package per script restriction. Each script is still
automatically wrapped in its own package.
Keep track of the packge(script name) whenever a hook is created in order to
allow callbacks which outside of a script and still be able to create hooks
from those callbacks.
Use newSVsv to copy instead of making a mortal copy and incrementing the
ref count.

git-svn-id: https://xchat.svn.sourceforge.net/svnroot/xchat@1513 893a96be-7f27-4fdf-9d1e-6aeec9d3cce1

ChangeLog

@@ -32,6 +32,10 @@ highlights. The full CVS log is available at www.xchat.org/cvslog/
   * Fixed a bug in the reinit handling code. The bug prevented the plugin from
     cleaning up properly. Which includes unloading scripts and removing
 	 their GUI entries.
+  * Remove the restriction on having only 1 package per script. Any inner
+    packages declared will also be unloaded when the script is unload. If
+    multiple script declare an inner package with the same name then unloading
+    or reloading one of those scripts will cause problems.
 
 ------------------------------------------------------------------------------
  2.8.8 - 30/May/2010

plugins/perl/lib/Xchat.pm

@@ -1,7 +1,3 @@
-BEGIN {
-	$INC{'Xchat.pm'} = 'DUMMY';
-}
-
 $SIG{__WARN__} = sub {
 	my $message = shift @_;
 	my ($package) = caller;
@@ -141,7 +137,7 @@ sub hook_server {
 
 	my $pkg_info = Xchat::Embed::pkg_info( $package );
 	my $hook = Xchat::Internal::hook_server(
-		$message, $priority, $callback, $data
+		$message, $priority, $callback, $data, $package
 	);
 	push @{$pkg_info->{hooks}}, $hook if defined $hook;
 	return $hook;
@@ -165,7 +161,7 @@ sub hook_command {
 
 	my $pkg_info = Xchat::Embed::pkg_info( $package );
 	my $hook = Xchat::Internal::hook_command(
-		$command, $priority, $callback, $help_text, $data
+		$command, $priority, $callback, $help_text, $data, $package
 	);
 	push @{$pkg_info->{hooks}}, $hook if defined $hook;
 	return $hook;
@@ -242,7 +238,7 @@ sub hook_print {
 
 	my $pkg_info = Xchat::Embed::pkg_info( $package );
 	my $hook = Xchat::Internal::hook_print(
-		$event, $priority, $callback, $data
+		$event, $priority, $callback, $data, $package
 	);
 	push @{$pkg_info->{hooks}}, $hook if defined $hook;
 	return $hook;
@@ -297,7 +293,8 @@ sub hook_fd {
 	my $hook = Xchat::Internal::hook_fd(
 		$fileno, $cb, $flags, {
 			DATA => $data, FD => $fd, CB => $callback, FLAGS => $flags,
-		}
+		},
+		$package
 	);
 	push @{$pkg_info->{hooks}}, $hook if defined $hook;
 	return $hook;

plugins/perl/lib/Xchat/Embed.pm

@@ -2,8 +2,36 @@ package Xchat::Embed;
 use strict;
 use warnings;
 # list of loaded scripts keyed by their package names
+# The package names are generated from the filename of the script using
+# the file2pkg() function.
+# The values of this hash are hash references with the following keys:
+#   filename
+#     The full path to the script.
+#   gui_entry
+#     This is xchat_plugin pointer that is used to remove the script from
+#     Plugins and Scripts window when a script is unloaded. This has also
+#     been converted with the PTR2IV() macro.
+#   hooks
+#     This is an array of hooks that are associated with this script.
+#     These are pointers that have been converted with the PTR2IV() macro.
+#   inner_packages
+#     Other packages that are defined in a script. This is not recommended
+#     partly because these will also get removed when a script is unloaded.
+#   loaded_at
+#     A timestamp of when the script was loaded. The value is whatever
+#     Time::HiRes::time() returns. This is used to retain load order when
+#     using the RELOADALL command.
+#   shutdown
+#     This is either a code ref or undef. It will be executed just before a
+#     script is unloaded.
 our %scripts;
 
+# used to keep track of which package a hook belongs to, if the normal way of
+# checking which script is calling a hook function fails this will be used
+# instead. When a hook is created this will be copied to the HookData structure
+# and when a callback is invoked this it will be used to set this value.
+our $current_package;
+
 sub load {
 	my $file = expand_homedir( shift @_ );
 	my $package = file2pkg( $file );
@@ -28,27 +56,6 @@ sub load {
 		# we shouldn't care about things after __END__
 		$source =~ s/^__END__.*//ms;
 
-		if(
-			my @replacements = $source =~
-				m/^\s*package ((?:[^\W:]+(?:::)?)+)\s*?;/mg
-		) {
-
-			if ( @replacements > 1 ) {
-				Xchat::print(
-					"Too many package defintions, only 1 is allowed\n"
-				);
-				return 1;
-			}
-
-			my $original_package = shift @replacements;
-
-			# remove original package declaration
-			$source =~ s/^(package $original_package\s*;)/#$1/m;
-
-			# 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
 		# Xchat::register
 		$scripts{$package}{filename} = $file;
@@ -72,6 +79,13 @@ sub load {
 					"", "unknown", "", $file
 				);
 		}
+
+		# this must be done before the error check so the unload will remove
+		# any inner packages defined by the script. if a script fails to load
+		# then any inner packages need to be removed as well.
+		my @inner_packages = $source =~
+			m/^\s*package ((?:[^\W:]+(?:::)?)+)\s*?;/mg;
+		$scripts{$package}{inner_packages} = [ @inner_packages ];
 
 		if( $@ ) {
 			# something went wrong
@@ -125,6 +139,9 @@ sub unload {
 			plugingui_remove( $pkg_info->{gui_entry} );
 		}
 
+		for my $inner_package ( @{$pkg_info->{inner_packages}} ) {
+			Symbol::delete_package( $inner_package );
+		}
 		Symbol::delete_package( $package );
 		delete $scripts{$package};
 		return Xchat::EAT_ALL;
@@ -203,16 +220,6 @@ sub pkg_info {
 	return $scripts{$package};
 }
 
-sub find_external_pkg {
-	my $level = 1;
-
-	while( my @frame = caller( $level ) ) {
-		return @frame if $frame[0] !~ /^Xchat/;
-		$level++;
-	}
-
-}
-
 sub find_pkg {
 	my $level = 1;
 
@@ -221,18 +228,7 @@ sub find_pkg {
 		$level++;
 	}
 
-	my @frame = find_external_pkg();
-	my $location;
-
-	if( $frame[0] or $frame[1] ) {
-		$location = $frame[1] ? $frame[1] : "package $frame[0]";
-		$location .= " line $frame[2]";
-	} else {
-		$location = "unknown location";
-	}
-
-	die "Unable to determine which script this hook belongs to. at $location\n";
-
+	return get_current_package();
 }
 
 sub fix_callback {
@@ -250,4 +246,15 @@ sub fix_callback {
 	return $callback;
 }
 
+sub get_current_package {
+	return $current_package;
+}
+
+sub set_current_package {
+	my $old_package = $current_package;
+	$current_package = shift;
+
+	return $old_package;
+}
+
 1