lib/metaclass.pm

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