lib/Moose/Policy/SingleInheritence.pm

   1
   2 package Moose::Policy::SingleInheritence;
   3
   4 use constant metaclass => 'Moose::Policy::SingleInheritence::MetaClass';
   5
   6 package Moose::Policy::SingleInheritence::MetaClass;
   7 use Moose;
   8
   9 extends 'Moose::Meta::Class';
  10
  11 before 'superclasses' => sub {
  12     my ($self, @superclasses) = @_;
  13     confess 'Moose::Policy::SingleInheritence in effect for ' .
  14              $self->name . ', only single inheritence is allowed'
  15          if scalar @superclasses > 1;
  16 };
  17
  18 1;
  19
  20 __END__
  21
  22 =pod
  23
  24 =head1 NAME
  25
  26 Moose::Policy::SingleInheritence - Why would you ever need more than one?
  27
  28 =head1 SYNOPSIS
  29
  30   package Foo;
  31
  32   use Moose::Policy 'Moose::Policy::SingleInheritence';
  33   use Moose;
  34
  35   package Bar;
  36
  37   use Moose::Policy 'Moose::Policy::SingleInheritence';
  38   use Moose;
  39
  40   package Foo::Bar;
  41
  42   use Moose::Policy 'Moose::Policy::SingleInheritence';
  43   use Moose;
  44
  45   extends 'Foo', 'Bar';  # BOOM!!!!
  46
  47 =head1 DESCRIPTION
  48
  49 This module restricts Moose's C<extends> keyword so that you can only assign
  50 a single superclass.
  51
  52 This is mostly an example of how you can restrict behavior with meta-policies
  53 in addition to extending and/or customising them. However, sometimes enforcing
  54 a policy like this can be a good thing.
  55
  56 =head1 BUGS
  57
  58 All complex software has bugs lurking in it, and this module is no
  59 exception. If you find a bug please either email me, or add the bug
  60 to cpan-RT.
  61
  62 =head1 AUTHOR
  63
  64 Stevan Little E<lt>stevan@iinteractive.comE<gt>
  65
  66 =head1 COPYRIGHT AND LICENSE
  67
  68 Copyright 2006-2007 by Infinity Interactive, Inc.
  69
  70 L<http://www.iinteractive.com>
  71
  72 This library is free software; you can redistribute it and/or modify
  73 it under the same terms as Perl itself.
  74
  75 =cut