lib/Exporter.pm

   1 package Mouse::Exporter;
   2 use strict;
   3 use warnings;
   4
   5 use Carp 'confess';
   6 use Scalar::Util qw(looks_like_number);
   7
   8 use Mouse::Util qw(not_supported);
   9
  10 sub init_meta {
  11     shift;
  12     my %args = @_;
  13
  14     my $class = $args{for_class}
  15                     or confess("Cannot call init_meta without specifying a for_class");
  16     my $base_class = $args{base_class} || 'Mouse::Object';
  17     my $metaclass  = $args{metaclass}  || 'Mouse::Meta::Class';
  18
  19     confess("The Metaclass $metaclass must be a subclass of Mouse::Meta::Class.")
  20             unless $metaclass->isa('Mouse::Meta::Class');
  21
  22     # make a subtype for each Mouse class
  23     Mouse::Util::TypeConstraints::class_type($class)
  24         unless Mouse::Util::TypeConstraints::find_type_constraint($class);
  25
  26     my $meta = $metaclass->initialize($class);
  27
  28     $meta->add_method(meta => sub{
  29         return $metaclass->initialize(ref($_[0]) || $_[0]);
  30     });
  31
  32     $meta->superclasses($base_class)
  33         unless $meta->superclasses;
  34
  35     return $meta;
  36 }
  37
  38 sub do_import {
  39     my($class, $spec, @args) = @_;
  40
  41     my $command;
  42
  43     my @exports;
  44     foreach my $arg(@args){
  45         if(ref $arg){ # e.g. use Mouse { into => $package };
  46             $command = $arg;
  47         }
  48         elsif($arg =~ s/^[-:]//){
  49             my $group = $spec->{group}{$arg} or confess(qq{group "$arg" is not exported by the $class module});
  50             push @exports, @{$group};
  51         }
  52         else{
  53             push @exports, $arg;
  54         }
  55     }
  56
  57     my $into = $command->{into} || caller(($command->{into_level} || 0) + 1);
  58
  59     strict->import;
  60     warnings->import;
  61
  62     if($into eq 'main' && !$spec->{_not_export_to_main}){
  63         warn qq{$class does not export its sugar to the 'main' package.\n};
  64         return;
  65     }
  66
  67     $class->init_meta(
  68         for_class  => $into,
  69     );
  70
  71     my $exports_ref = @exports ? \@exports : $spec->{default};
  72
  73     foreach my $keyword(@{$exports_ref}){
  74         no strict 'refs';
  75         *{$caller.'::'.$keyword} = $spec->{exports}{$keyword}
  76             or confess(qq{"$keyword" is not exported by the $class module};
  77     }
  78     return;
  79 }
  80
  81 sub do_unimport {
  82     my $caller = caller;
  83
  84     my $stash = do{
  85         no strict 'refs';
  86         \%{$caller . '::'}
  87     };
  88
  89     for my $keyword (@EXPORT) {
  90         my $code;
  91         if(exists $is_removable{$keyword}
  92             && ($code = $caller->can($keyword))
  93             && (Mouse::Util::get_code_info($code))[0] eq __PACKAGE__){
  94
  95             delete $stash->{$keyword};
  96         }
  97     }
  98 }
  99
 100 1;
 101
 102 __END__
 103
 104 =head1 NAME
 105
 106 Mouse - The Mouse Exporter
 107
 108 =head1 SYNOPSIS
 109
 110     package MouseX::Foo;
 111     use Mouse::Exporter;
 112
 113     Mouse::Exporter->setup_import_methods(
 114
 115     );
 116
 117 =head1 DESCRIPTION
 118
 119
 120 =head1 SEE ALSO
 121
 122 L<Moose::Exporter>
 123
 124 =head1 AUTHORS
 125
 126 Goro Fuji (gfx) C<< <gfuji at cpan.org> >>
 127
 128 =cut
 129