1 package Mouse::Exporter;
7 use Mouse::Util qw(get_code_info);
11 sub setup_import_methods{
12 my($class, %args) = @_;
14 my $exporting_package = $args{exporting_package} ||= caller();
16 $SPEC{$exporting_package} = \%args;
22 my @stack = ($exporting_package);
24 while(my $current = shift @stack){
25 push @export_from, $current;
27 my $also = $SPEC{$current}{also} or next;
28 push @stack, grep{ !$seen{$_}++ } @{ $also };
32 @export_from = ($exporting_package);
40 foreach my $package(@export_from){
41 my $spec = $SPEC{$package} or next;
43 if(my $as_is = $spec->{as_is}){
44 foreach my $thingy (@{$as_is}){
45 my($code_package, $code_name, $code);
49 ($code_package, $code_name) = get_code_info($code);
53 $code_package = $package;
55 $code = \&{ $code_package . '::' . $code_name };
58 push @all, $code_name;
59 $exports{$code_name} = $code;
60 if($code_package eq $package){
61 push @removables, $code_name;
66 $args{EXPORTS} = \%exports;
67 $args{REMOVABLES} = \@removables;
69 $args{group}{default} ||= \@all;
70 $args{group}{all} ||= \@all;
75 *{$exporting_package . '::import'} = \&do_import;
76 *{$exporting_package . '::unimport'} = \&do_unimport;
78 if(!defined &{$exporting_package . '::init_meta'}){
79 *{$exporting_package . '::init_meta'} = \&do_init_meta;
84 # the entity of general init_meta()
86 my($class, %args) = @_;
88 my $spec = $SPEC{$class}
89 or confess("The package $class does not use Mouse::Exporter");
91 my $for_class = $args{for_class}
92 or confess("Cannot call init_meta without specifying a for_class");
94 my $base_class = $args{base_class} || 'Mouse::Object';
95 my $metaclass = $args{metaclass} || 'Mouse::Meta::Class';
97 my $meta = $metaclass->initialize($for_class);
99 $meta->add_method(meta => sub{
100 $metaclass->initialize(ref($_[0]) || $_[0]);
103 $meta->superclasses($base_class)
104 unless $meta->superclasses;
109 # the entity of general import()
111 my($class, @args) = @_;
113 my $spec = $SPEC{$class}
114 or confess("The package $class does not use Mouse::Exporter");
116 my $into = _get_caller_package(ref($args[0]) ? shift @args : undef);
119 foreach my $arg(@args){
120 if($arg =~ s/^[-:]//){
121 my $group = $spec->{group}{$arg} or confess(qq{group "$arg" is not exported by the $class module});
122 push @exports, @{$group};
132 if($into eq 'main' && !$spec->{_not_export_to_main}){
133 warn qq{$class does not export its sugar to the 'main' package.\n};
137 if($class->can('init_meta')){
138 my $meta = $class->init_meta(
142 # TODO: process -metaclass and -traits
147 my $exports_ref = @exports ? \@exports : $spec->{group}{default};
149 foreach my $keyword(@{$exports_ref}){
151 *{$into.'::'.$keyword} = $spec->{EXPORTS}{$keyword}
152 or confess(qq{"$keyword" is not exported by the $class module});
157 # the entity of general unimport()
159 my($class, $arg) = @_;
161 my $spec = $SPEC{$class}
162 or confess("The package $class does not use Mouse::Exporter");
164 my $from = _get_caller_package($arg);
171 for my $keyword (@{ $spec->{REMOVABLES} }) {
172 my $gv = \$stash->{$keyword};
173 if(ref($gv) eq 'GLOB' && *{$gv}{CODE} == $spec->{EXPORTS}{$keyword}){ # make sure it is from us
174 delete $stash->{$keyword};
180 sub _get_caller_package {
183 # 2 extra level because it's called by import so there's a layer
\r
188 return defined($arg->{into}) ? $arg->{into}
189 : defined($arg->{into_level}) ? scalar caller($offset + $arg->{into_level})
190 : scalar caller($offset);
193 return scalar caller($offset);
203 Mouse - The Mouse Exporter
210 Mouse::Exporter->setup_import_methods(