X-Git-Url: http://git.jankratochvil.net/?p=MyWeb.git;a=blobdiff_plain;f=Hash.pm;h=614c5d71967288c9e36636ba4cf10226bc48a95c;hp=69204e473d97686f621544ce090831e69e98f64b;hb=adf50ea526c9de029a489de03ab45e35c215f64f;hpb=aaa499f21bc074a0f4508963412ea387a811e3e7

diff --git a/Hash.pm b/Hash.pm
index 69204e4..614c5d7 100644
--- a/Hash.pm
+++ b/Hash.pm
@@ -29,20 +29,24 @@ use Carp qw(cluck confess);
 # OK, this is just @ISA 'runtime' reimplementation using: ->{"parent"}
 # Creating classes each time is too complicated in Perl.
 # Maybe the best would be run-time generation of the classes using: @ISA
-# This way the feature implementations could use SUPER::... instead of: pass(...)
+# This way the feature implementations could use SUPER.pm calls instead of: pass(...)
 
 
+# My::Hash::KIND->new($parent,@optional_KIND_arguments);
+# My::Hash->new($parent,"My::Hash::KIND_OUTER",["My::Hash::KIND_INNER",@optional_KIND_INNER_arguments]);
 sub new($$;@)
 {
 my($class,$parent,@classes)=@_;
 
-	unshift @classes,$class if $class ne __PACKAGE__;
-	for my $pkg (reverse @classes) {
+	@classes=[$class,@classes] if $class ne __PACKAGE__ || !@classes;
+	for my $item (reverse @classes) {
+		my $pkg=(!ref($item) ? $item : $item->[0]);
+		my @args=@{$item}[1..$#$item] if ref $item;
 		local $_=$pkg.".pm";
 		s{::}{/}g;
 		require $_;
 		my %hash;
-		tie %hash,$pkg,$parent;
+		tie %hash,$pkg,$parent,@args;
 		$parent=\%hash;
 		}
 	return $parent;
@@ -67,9 +71,15 @@ sub pass($$@)
 {
 my($self,$funcname,@funcargs)=@_;
 
-	local $_=ref(tied(%{$self->{"parent"}}))."::".$funcname;
-	return if /^(?:Tie::StdHash)?::(?:DESTROY|UNTIE)$/;
-	tied(%{$self->{"parent"}})->$_(@funcargs);
+	local $@=undef();
+	my $parent_tied=tied(%{$self->{"parent"}});
+	my $destroy=1 if $funcname eq "DESTROY" || $funcname eq "UNTIE";
+	return if !defined($parent_tied) && $destroy;
+	my $r=eval {
+		$parent_tied->$funcname(@funcargs);
+		};
+	return $r if !$@ || ($destroy && $@=~/^Can't locate object method "$funcname" via package ".*" at /);
+	confess $@;
 }
 
 our $AUTOLOAD;