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
  10 our $VERSION = '0.02';
  11
  12 use Class::MOP;
  13
  14 sub import {
  15     shift;
  16     my $metaclass = shift || 'Class::MOP::Class';
  17     my %options   = @_;
  18     my $package   = caller();
  19
  20     ($metaclass->isa('Class::MOP::Class'))
  21         || confess 'The metaclass must be derived from Class::MOP::Class';
  22
  23     # create a meta object so we can install &meta
  24     my $meta = $metaclass->initialize($package => %options);
  25     $meta->add_method('meta' => sub {
  26         # we must re-initialize so that it
  27         # works as expected in subclasses,
  28         # since metaclass instances are
  29         # singletons, this is not really a
  30         # big deal anyway.
  31         $metaclass->initialize((blessed($_[0]) || $_[0]) => %options)
  32     });
  33 }
  34
  35 1;
  36
  37 __END__
  38
  39 =pod
  40
  41 =head1 NAME
  42
  43 metaclass - a pragma for installing and using Class::MOP metaclasses
  44
  45 =head1 SYNOPSIS
  46
  47   package MyClass;
  48
  49   # use Class::MOP::Class
  50   use metaclass;
  51
  52   # ... or use a custom metaclass
  53   use metaclass 'MyMetaClass';
  54
  55   # ... or use a custom metaclass
  56   # and custom attribute and method
  57   # metaclasses
  58   use metaclass 'MyMetaClass' => (
  59       ':attribute_metaclass' => 'MyAttributeMetaClass',
  60       ':method_metaclass'    => 'MyMethodMetaClass',
  61   );
  62
  63 =head1 DESCRIPTION
  64
  65 This is a pragma to make it easier to use a specific metaclass
  66 and a set of custom attribute and method metaclasses. It also
  67 installs a C<meta> method to your class as well.
  68
  69 =head1 AUTHOR
  70
  71 Stevan Little E<lt>stevan@iinteractive.comE<gt>
  72
  73 =head1 COPYRIGHT AND LICENSE
  74
  75 Copyright 2006 by Infinity Interactive, Inc.
  76
  77 L<http://www.iinteractive.com>
  78
  79 This library is free software; you can redistribute it and/or modify
  80 it under the same terms as Perl itself.
  81
  82 =cut