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