lib/metaclass.pm

   1
   2 package metaclass;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Carp         'confess';
   8 use Scalar::Util 'blessed';
   9 use Try::Tiny;
  10
  11 use Class::MOP;
  12
  13 sub import {
  14     my ( $class, @args ) = @_;
  15
  16     unshift @args, "metaclass" if @args % 2 == 1;
  17     my %options = @args;
  18
  19     my $meta_name = exists $options{meta_name} ? $options{meta_name} : 'meta';
  20     my $metaclass = delete $options{metaclass};
  21
  22     unless ( defined $metaclass ) {
  23         $metaclass = "Class::MOP::Class";
  24     } else {
  25         Class::MOP::load_class($metaclass);
  26     }
  27
  28     ($metaclass->isa('Class::MOP::Class'))
  29         || confess "The metaclass ($metaclass) must be derived from Class::MOP::Class";
  30
  31     # make sure the custom metaclasses get loaded
  32     foreach my $key (grep { /_(?:meta)?class$/ } keys %options) {
  33         unless ( ref( my $class = $options{$key} ) ) {
  34             Class::MOP::load_class($class)
  35         }
  36     }
  37
  38     my $package = caller();
  39
  40     # create a meta object so we can install &meta
  41     my $meta = $metaclass->initialize($package => %options);
  42     $meta->_add_meta_method($meta_name)
  43         if defined $meta_name;
  44 }
  45
  46 1;
  47
  48 # ABSTRACT: a pragma for installing and using Class::MOP metaclasses
  49
  50 __END__
  51
  52 =pod
  53
  54 =head1 SYNOPSIS
  55
  56   package MyClass;
  57
  58   # use Class::MOP::Class
  59   use metaclass;
  60
  61   # ... or use a custom metaclass
  62   use metaclass 'MyMetaClass';
  63
  64   # ... or use a custom metaclass
  65   # and custom attribute and method
  66   # metaclasses
  67   use metaclass 'MyMetaClass' => (
  68       'attribute_metaclass' => 'MyAttributeMetaClass',
  69       'method_metaclass'    => 'MyMethodMetaClass',
  70   );
  71
  72   # ... or just specify custom attribute
  73   # and method classes, and Class::MOP::Class
  74   # is the assumed metaclass
  75   use metaclass (
  76       'attribute_metaclass' => 'MyAttributeMetaClass',
  77       'method_metaclass'    => 'MyMethodMetaClass',
  78   );
  79
  80   # if we'd rather not install a 'meta' method, we can do this
  81   use metaclass meta_name => undef;
  82   # or if we'd like it to have a different name,
  83   use metaclass meta_name => 'my_meta';
  84
  85 =head1 DESCRIPTION
  86
  87 This is a pragma to make it easier to use a specific metaclass
  88 and a set of custom attribute and method metaclasses. It also
  89 installs a C<meta> method to your class as well, unless C<undef>
  90 is passed to the C<meta_name> option.
  91
  92 =cut