X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FExporter.pm;h=dd46f4329b9429f9000df06ba1a4de67060f3116;hb=fd2b172a4657cb6cc47976d2e66cdba4bdfa579d;hp=1ab9d1832bc4e00565346c026fc513db1400ebcd;hpb=6e1e5b31f9ff0a46de1d7e396840da18c385962d;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Exporter.pm b/lib/Mouse/Exporter.pm index 1ab9d18..dd46f43 100644 --- a/lib/Mouse/Exporter.pm +++ b/lib/Mouse/Exporter.pm @@ -2,20 +2,26 @@ package Mouse::Exporter; use strict; use warnings; -use Carp qw(confess); +use Carp (); my %SPEC; my $strict_bits; BEGIN{ $strict_bits = strict::bits(qw(subs refs vars)); } +my $warnings_extra_bits; +BEGIN{ $warnings_extra_bits = warnings::bits(FATAL => 'recursion') } + # it must be "require", because Mouse::Util depends on Mouse::Exporter, # which depends on Mouse::Util::import() require Mouse::Util; sub import{ - $^H |= $strict_bits; # strict->import; - ${^WARNING_BITS} |= $warnings::Bits{all}; # warnings->import; + # strict->import; + $^H |= $strict_bits; + # warnings->import('all', FATAL => 'recursion'); + ${^WARNING_BITS} |= $warnings::Bits{all}; + ${^WARNING_BITS} |= $warnings_extra_bits; return; } @@ -33,15 +39,10 @@ sub setup_import_methods{ export_to_level => sub { my($package, $level, undef, @args) = @_; # the third argument is redundant - - Carp::carp("$package->export_to_level has been deprecated." - ." Use $package->import({ into_level => LEVEL }) instead"); $package->import({ into_level => $level + 1 }, @args); }, export => sub { my($package, $into, @args) = @_; - Carp::carp("$package->export has been deprecated." - ." Use $package->import({ into => PACKAGE }) instead"); $package->import({ into => $into }, @args); }, ); @@ -49,7 +50,7 @@ sub setup_import_methods{ } sub build_import_methods{ - my($class, %args) = @_; + my($self, %args) = @_; my $exporting_package = $args{exporting_package} ||= caller(); @@ -113,13 +114,13 @@ sub build_import_methods{ $args{EXPORTS} = \%exports; $args{REMOVABLES} = \@removables; - $args{groups}{all} ||= \@all; + $args{groups}{all} ||= \@all; if(my $default_list = $args{groups}{default}){ my %default; foreach my $keyword(@{$default_list}){ $default{$keyword} = $exports{$keyword} - || confess(qq{The $exporting_package package does not export "$keyword"}); + || Carp::confess(qq{The $exporting_package package does not export "$keyword"}); } $args{DEFAULT} = \%default; } @@ -135,13 +136,12 @@ sub build_import_methods{ return (\&do_import, \&do_unimport); } - # the entity of general import() sub do_import { my($package, @args) = @_; my $spec = $SPEC{$package} - || confess("The package $package package does not use Mouse::Exporter"); + || Carp::confess("The package $package package does not use Mouse::Exporter"); my $into = _get_caller_package(ref($args[0]) ? shift @args : undef); @@ -160,7 +160,7 @@ sub do_import { } elsif($arg =~ s/^://){ my $group = $spec->{groups}{$arg} - || confess(qq{The $package package does not export the group "$arg"}); + || Carp::confess(qq{The $package package does not export the group "$arg"}); push @exports, @{$group}; } else{ @@ -168,8 +168,11 @@ sub do_import { } } - $^H |= $strict_bits; # strict->import; - ${^WARNING_BITS} |= $warnings::Bits{all}; # warnings->import; + # strict->import; + $^H |= $strict_bits; + # warnings->import('all', FATAL => 'recursion'); + ${^WARNING_BITS} |= $warnings::Bits{all}; + ${^WARNING_BITS} |= $warnings_extra_bits; if($spec->{INIT_META}){ my $meta; @@ -179,11 +182,11 @@ sub do_import { if(@traits){ my $type = (split /::/, ref $meta)[-1]; # e.g. "Class" for "My::Meta::Class" - @traits = - map{ - ref($_) ? $_ - : Mouse::Util::resolve_metaclass_alias($type => $_, trait => 1) - } @traits; + @traits = map{ + ref($_) + ? $_ + : Mouse::Util::resolve_metaclass_alias($type => $_, trait => 1) + } @traits; require Mouse::Util::MetaRole; Mouse::Util::MetaRole::apply_metaroles( @@ -203,7 +206,7 @@ sub do_import { foreach my $keyword(@exports){ push @export_table, $keyword => ($spec->{EXPORTS}{$keyword} - || confess(qq{The $package package does not export "$keyword"}) + || Carp::confess(qq{The $package package does not export "$keyword"}) ); } Mouse::Util::install_subroutines($into, @export_table); @@ -219,7 +222,7 @@ sub do_unimport { my($package, $arg) = @_; my $spec = $SPEC{$package} - || confess("The package $package does not use Mouse::Exporter"); + || Carp::confess("The package $package does not use Mouse::Exporter"); my $from = _get_caller_package($arg); @@ -264,7 +267,7 @@ Mouse::Exporter - make an import() and unimport() just like Mouse.pm =head1 VERSION -This document describes Mouse version 0.50_06 +This document describes Mouse version 0.87 =head1 SYNOPSIS @@ -274,8 +277,8 @@ This document describes Mouse version 0.50_06 use Mouse::Exporter; Mouse::Exporter->setup_import_methods( - as_is => [ 'has_rw', 'other_sugar', \&Some::Random::thing ], - also => 'Mouse', + as_is => [ 'has_rw', 'other_sugar', \&Some::Random::thing ], + also => 'Mouse', ); sub has_rw {