From 472627edf7dc3705db27365411c750a268be5d47 Mon Sep 17 00:00:00 2001 From: merlin Date: Mon, 31 Dec 2007 12:09:03 +0000 Subject: Utilisation de croak au lieu de die pour lever des exceptions permettant d'obtenir des messages d'erreurs plus explicites (info complementaire sur la pile d'appel). Petite modif de minstanciate permettant de passer des options de configuration (equivalent a un appel de mconfigure apres le minstanciate). --- src/MTools.pm | 33 ++++++++++++++++++++------------- 1 file changed, 20 insertions(+), 13 deletions(-) (limited to 'src/MTools.pm') diff --git a/src/MTools.pm b/src/MTools.pm index 436fe95..61f57f6 100644 --- a/src/MTools.pm +++ b/src/MTools.pm @@ -99,6 +99,7 @@ BEGIN } use strict; +use Carp; use Tk::Zinc; use Ivy; @@ -120,7 +121,7 @@ sub new { if (!defined $Zinc) { $screen = ":0.0" if (!defined $screen); - $self -> {window} = my $mw = MainWindow -> new ('-screen' =>$screen); + $self -> {window} = my $mw = MainWindow -> new ('-screen' => $screen); $mw -> title($title); $mw->geometry ($geometry) if (defined $geometry); @@ -176,7 +177,7 @@ sub __configure { }; if ($@) { - die "##### Error MTools::__confproplink : property $key not defined for $obj\n"; + croak "##### Error MTools::__confproplink : property $key not defined for $obj\n"; } } } @@ -212,7 +213,7 @@ sub __confproplink { }; if ($@) { - die "##### Error MTools::__confproplink : property $key not defined for $obj\n"; + croak "##### Error MTools::__confproplink : property $key not defined for $obj\n"; } } } @@ -277,7 +278,7 @@ sub mconfigure { { $prop .= " '$k'"; } - die "##### Error MTools::mconfigure : one of the following properties :$prop, is not defined for $obj\n"; + croak "##### Error MTools::mconfigure : one of the following properties :$prop, is not defined for $obj\n"; } } } @@ -335,7 +336,7 @@ sub plink { }; if ($@) { - die "##### Error MTools::plink : property $key not defined for $obj\n"; + croak "##### Error MTools::plink : property $key not defined for $obj\n"; } } } @@ -389,7 +390,7 @@ sub mget { }; if ($@) { - die "##### Error MTools::mget : property $key not defined for $obj\n"; + croak "##### Error MTools::mget : property $key not defined for $obj\n"; } return $retour; } @@ -403,7 +404,7 @@ sub mget { }; if ($@) { - die "##### Error MTools::mget : property $key not defined for $obj\n"; + croak "##### Error MTools::mget : property $key not defined for $obj\n"; } return $retour; } @@ -718,37 +719,43 @@ sub mrun { } sub minstanciate { - my ($path, $parent) = @_; + my ($path, $parent, %options) = @_; + my $retour; if ( ref ($path) eq '') { if( $path =~ /SVG\((.*)\)/) { - return MTools::SVG::SVGLoader::load ($1, $parent); + $retour = MTools::SVG::SVGLoader::load ($1, $parent); } else { if( $path =~ /(.*)\.svg\#(.*)/) { - return MTools::SVG::SVGLoader::load ($path, $parent); + $retour = MTools::SVG::SVGLoader::load ($path, $parent); } elsif( $path =~ /(.*)\.svg/) { - return MTools::SVG::SVGLoader::load ($path, $parent); + $retour = MTools::SVG::SVGLoader::load ($path, $parent); } else { my $obj = new MTools::MObjet (); $obj -> {instance} = $path; $obj -> chggroup ($parent); - return $obj; + $retour = $obj; } } } else { $path -> chggroup ($parent); - return $path; + $retour = $path; + } + if (defined %options) + { + $retour -> mconfigure (%options); } + return $retour; } 1; -- cgit v1.1