From: gfx Date: Tue, 6 Oct 2009 06:34:18 +0000 (+0900) Subject: Fix do_unimport and related stuff X-Git-Tag: 0.37_03~31 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=4ee3190e219122aa1d8ad590e63231e3c2e2407b;hp=db9fc23783271f93e5a2bf15300f2f4a5284cc96 Fix do_unimport and related stuff --- diff --git a/lib/Mouse/Exporter.pm b/lib/Mouse/Exporter.pm index f60c4e9..dc7e128 100644 --- a/lib/Mouse/Exporter.pm +++ b/lib/Mouse/Exporter.pm @@ -35,35 +35,39 @@ sub setup_import_methods{ { my %exports; my @removables; + my @all; foreach my $package(@export_from){ my $spec = $SPEC{$package} or next; if(my $as_is = $spec->{as_is}){ foreach my $thingy (@{$as_is}){ - my($name, $code); + my($code_package, $code_name, $code); if(ref($thingy)){ - my $code_package; $code = $thingy; - ($code_package, $name) = get_code_info($code); + ($code_package, $code_name) = get_code_info($code); } else{ no strict 'refs'; - $name = $thingy; - $code = \&{ $package . '::' . $name }; + $code_package = $package; + $code_name = $thingy; + $code = \&{ $code_package . '::' . $code_name }; } - $exports{$name} = $code; - push @removables, $name; + push @all, $code_name; + $exports{$code_name} = $code; + if($code_package eq $package){ + push @removables, $code_name; + } } } } $args{EXPORTS} = \%exports; $args{REMOVABLES} = \@removables; - $args{group}{default} ||= \@removables; - $args{group}{all} ||= \@removables; + $args{group}{default} ||= \@all; + $args{group}{all} ||= \@all; } no strict 'refs'; @@ -165,7 +169,10 @@ sub do_unimport { }; for my $keyword (@{ $spec->{REMOVABLES} }) { - delete $stash->{$keyword}; + my $gv = \$stash->{$keyword}; + if(ref($gv) eq 'GLOB' && *{$gv}{CODE} == $spec->{EXPORTS}{$keyword}){ # make sure it is from us + delete $stash->{$keyword}; + } } return; }