1 package Mouse::Exporter;
6 use Scalar::Util qw(looks_like_number);
12 sub setup_import_methods{
13 my($class, %args) = @_;
15 my $exporting_package = $args{exporting_package} ||= caller();
17 my $spec = $SPEC{$exporting_package} = {};
20 my @export_from = ($exporting_package);
22 my %seen = ($exporting_package => 1);
23 my @stack = ($exporting_package);
25 while(my $current = shift @stack){
26 push @export_from, $current;
28 my $also = $args{also} or next;
29 unshift @stack, grep{ ++$seen{$_} == 1 } @{ $also };
33 print "[@export_from]\n";
35 my $import = sub{ _do_import ($spec, @_) };
36 my $unimport = sub{ _do_unimport ($spec, @_) };
37 my $init_meta = sub{ _do_init_meta($spec, @_) };
41 *{$exporting_package . '::import'} = $import;
42 *{$exporting_package . '::unimport'} = $unimport;
43 *{$exporting_package . '::init_meta'} = $init_meta;
52 my $class = $args{for_class}
53 or confess("Cannot call init_meta without specifying a for_class");
54 my $base_class = $args{base_class} || 'Mouse::Object';
55 my $metaclass = $args{metaclass} || 'Mouse::Meta::Class';
57 confess("The Metaclass $metaclass must be a subclass of Mouse::Meta::Class.")
58 unless $metaclass->isa('Mouse::Meta::Class');
60 # make a subtype for each Mouse class
61 Mouse::Util::TypeConstraints::class_type($class)
62 unless Mouse::Util::TypeConstraints::find_type_constraint($class);
64 my $meta = $metaclass->initialize($class);
66 $meta->add_method(meta => sub{
67 return $metaclass->initialize(ref($_[0]) || $_[0]);
70 $meta->superclasses($base_class)
71 unless $meta->superclasses;
77 my($class, $spec, @args) = @_;
82 foreach my $arg(@args){
83 if(ref $arg){ # e.g. use Mouse { into => $package };
86 elsif($arg =~ s/^[-:]//){
87 my $group = $spec->{group}{$arg} or confess(qq{group "$arg" is not exported by the $class module});
88 push @exports, @{$group};
95 my $into = $command->{into} || caller(($command->{into_level} || 0) + 1);
100 if($into eq 'main' && !$spec->{_not_export_to_main}){
101 warn qq{$class does not export its sugar to the 'main' package.\n};
109 my $exports_ref = @exports ? \@exports : $spec->{default};
111 foreach my $keyword(@{$exports_ref}){
113 *{$into.'::'.$keyword} = $spec->{exports}{$keyword}
114 or confess(qq{"$keyword" is not exported by the $class module});
120 my($class, $spec) = @_;
129 for my $keyword (@{ $spec->{exports} }) {
131 if(exists $spec->{is_removable}{$keyword}
132 && ($code = $caller->can($keyword))
133 && (Mouse::Util::get_code_info($code))[0] eq __PACKAGE__){
135 delete $stash->{$keyword};
146 Mouse - The Mouse Exporter
153 Mouse::Exporter->setup_import_methods(
166 Goro Fuji (gfx) C<< <gfuji at cpan.org> >>