Amélioration des perfos de la methode mfind. On peut désormais accéder aux objets zinc via une table de hash. Attention tkdiff src/MTools.pm! il est impératif de supprimer et regénérer vos fichiers contenu dans les répertoires AUTOGEN.

1 files changed, 15 insertions, 6 deletions

diff --git a/src/MTools.pm b/src/MTools.pm
index 61f57f6..250b092 100644
--- a/src/MTools.pm
+++ b/src/MTools.pm
@@ -542,9 +542,18 @@ sub rotate {
 }
 
 sub mfind {
-	my ($obj, @params) = @_;
-	my @tagged = $zinc -> find ('withtag', @params);
-	my $ref = ref ($obj) eq '' ? $obj : $obj -> {instance};
+	my ($obj, $param) = @_;
+	if (ref ($obj) ne '' && defined $obj -> {children}) {
+		my $child = $obj -> {children} -> {$param};
+		if (defined $child) {
+			return $child;
+		}
+	}
+
+	if (ref ($obj) ne '') {
+		$obj = $obj -> {instance};
+	}
+	my @tagged = $zinc -> find ('withtag', ($param));
 	if (@tagged)
 	{
 		for (my $i = 0; $i < @tagged; $i++)
@@ -552,17 +561,17 @@ sub mfind {
 			my @ancestors = $zinc -> find ('ancestors', $tagged [$i]);
 			for (my $j = 0; $j < @ancestors; $j ++)
 			{
-				if ($ancestors [$j] == $ref)
+				if ($ancestors [$j] == $obj)
 				{
 					return $tagged [$i];
 				}
 			}
 		}
-		print "#### Warning : can't find any object matching with @params \n";
+		print "#### Warning : can't find any object matching with $param \n";
 	}
 	else
 	{
-		print "#### Warning : can't find any object matching with @params \n";
+		print "#### Warning : can't find any object matching with $param \n";
 	}
 	return undef;
 }