diff options
author | merlin | 2007-12-31 12:09:03 +0000 |
---|---|---|
committer | merlin | 2007-12-31 12:09:03 +0000 |
commit | 472627edf7dc3705db27365411c750a268be5d47 (patch) | |
tree | afee71d14e8cb0d5911fc3d4392ab8c73bea430e /src | |
parent | b64426d191f210ee90a3d33e59d28b06f482907d (diff) | |
download | mtc-472627edf7dc3705db27365411c750a268be5d47.zip mtc-472627edf7dc3705db27365411c750a268be5d47.tar.gz mtc-472627edf7dc3705db27365411c750a268be5d47.tar.bz2 mtc-472627edf7dc3705db27365411c750a268be5d47.tar.xz |
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).
Diffstat (limited to 'src')
-rw-r--r-- | src/MTools.pm | 33 |
1 files changed, 20 insertions, 13 deletions
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; |