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 DEPRECATION NOTICE
  48
  49 B<Moose::Policy is deprecated>.
  50
  51 =head1 DESCRIPTION
  52
  53 This module restricts Moose's C<extends> keyword so that you can only assign
  54 a single superclass.
  55
  56 This is mostly an example of how you can restrict behavior with meta-policies
  57 in addition to extending and/or customising them. However, sometimes enforcing
  58 a policy like this can be a good thing.
  59
  60 =head1 BUGS
  61
  62 All complex software has bugs lurking in it, and this module is no
  63 exception. If you find a bug please either email me, or add the bug
  64 to cpan-RT.
  65
  66 =head1 AUTHOR
  67
  68 Stevan Little E<lt>stevan@iinteractive.comE<gt>
  69
  70 =head1 COPYRIGHT AND LICENSE
  71
  72 Copyright 2006-2007 by Infinity Interactive, Inc.
  73
  74 L<http://www.iinteractive.com>
  75
  76 This library is free software; you can redistribute it and/or modify
  77 it under the same terms as Perl itself.
  78
  79 =cut